R有光泽:如何将滑块和单选按钮链接到ggplot

时间:2018-05-27 06:04:14

标签: r ggplot2 shiny

我很擅长闪亮并且阅读其他类似帖子但没有成功,包括:R shiny plots based on radio buttons and slider input

我想绘制健康结果(从单选按钮中选择)v自付费用(OOP),基于滑块的年份

这是我的代码到目前为止,情节没有显示

UI:

 library(shiny)
 library(ggplot2)

 data <- read.csv("data.csv", header=TRUE)
 data

 data$OOP <- as.numeric(data$OOP)
 data$OOP

  shinyUI(fluidPage(
    titlePanel(title=h3("Out of pocket expenditure on health")),

    mainPanel(
      h5(textOutput("subheading")),
      plotOutput("view")),

    fluidRow(
        column(5,
           radioButtons("outcome", label=h4("Select Health Outcomes"),
                    choices=list("Mortality rate (per 100,000)", "Premature death risk (age 30-70)"), selected="Mortality rate (per 100,000)"),

           checkboxInput("smooth", "Add trend line")
),
        column(5,
            sliderInput("years", label=h4("Year"),
                   min=min(data$Year), max=max(data$Year), value=(min(data$Year)), step=5, sep="", animate=TRUE)
)
 )
   ))

服务器:

library(dplyr)
library(ggplot2)

shinyServer(
    function(input, output){
    formulaText <- reactive({
        paste("Health outcome:",input$outcome)
            })
        output$subheading <- renderText({formulaText()})

     datareact <- reactive({
        data %>%
        filter(Year == input$years) %>%
        select(Country, OOP, Mortality, Probability)
            })

     output$view <- renderPlot({
        p <- ggplot(datareact(), aes(x=OOP, y=input$outcome))+
           geom_point(aes(fill=Country))

        if(input$smooth)
           p <- p + geom_smooth()  
           })
         })

'reactive'和'renderPlot'行可能有问题。非常感谢任何帮助,谢谢

*编辑: 这就是我的数据(代码片段):

      Country Year     OOP Mortality Probability
1 Afghanistan 2000 No data     934.3        34.2
2 Afghanistan 2005      79     947.7        33.6
3 Afghanistan 2010      79     919.6        32.2
4 Afghanistan 2015    78.4     898.0        31.0
5     Albania 2000    64.6     710.3        20.0
6     Albania 2005    52.5     688.9        19.7

1 个答案:

答案 0 :(得分:1)

始终使用dput发布可重现的数据,并且预期输出很有帮助。但是,这是我的解决方案让我知道是否需要更新。

library(shiny)
library(ggplot2)
library(dplyr)

#No data changed to NA
Input = ("Country Year     OOP Mortality Probability
   1 Afghanistan 2000 NA     934.3        34.2
   2 Afghanistan 2005      79     947.7        33.6
   3 Afghanistan 2010      79     919.6        32.2
   4 Afghanistan 2015    78.4     898.0        31.0
   5     Albania 2000    64.6     710.3        20.0
   6     Albania 2005    52.5     688.9        19.7")

data = read.table(textConnection(Input),header=TRUE)


ui <- shinyUI(fluidPage(
          titlePanel(title=h3("Out of pocket expenditure on health")),

      mainPanel(
        h5(textOutput("subheading")),
        plotOutput("view")),

     fluidRow(
        column(5,
               radioButtons("outcome", label=h4("Select Health Outcomes"),
                    choices=c("Mortality rate", "Premature death risk (age 30-70)"), selected="Mortality rate"),

             checkboxInput("smooth", "Add trend line")
       ),
         column(5,
               sliderInput("years", label=h4("Year"),
                   min=min(data$Year), max=max(data$Year), value=(min(data$Year)), step=1, sep="", animate=TRUE)
       )
     )
 ))


server <- shinyServer(function(input, output, session){
formulaText <- reactive({
  paste("Health outcome:",input$outcome)
})
output$subheading <- renderText({formulaText()})

datareact <- reactive({
  print(input$years)      #to check variable before passing 
  print(input$outcome)
  data <- data %>%
  #change input$outcome from renderPlot to reactive
  filter(Year >= input$years)

if (input$outcome == "Mortality rate") {data$outcome <- data$Mortality} else {
  data$outcome <- data$Probability    #Please note this is not the best solution for large data set 
  }
data
})

observe(print(datareact()))   #to check which data you get

output$view <- renderPlot({

  p <- ggplot(datareact(), aes(x=OOP, y=outcome, color=Country))+
    geom_point()

  if(input$smooth)
    p <- p + geom_smooth()

       p   #Enforce renderPlot to return p 
     })
  })

 shinyApp(ui,server)