用闪亮的

Question

我有一个反应性数据框x()，基本上根据radioButtons()过滤数据框

x <- reactive({
  if(input$sex=='Both')
    dataSet <- patients
  else dataSet <- patients %>% filter(gender==input$sex)
  dataSet
})

然后我使用以下代码渲染一个基于selectInput()显示直方图的图：

output$histo <- renderPlotly({
  ggplotly(
    ggplot(x(), aes_string(input$varble))+
      geom_histogram(bins=input$bins)+
      geom_vline(aes(xintercept=mean(input$varble)),  col='red',size=1, linetype="dashed")+
      theme(legend.position="top")
  )
})

直方图在ui上呈现时，geom_vline()没有。我收到了这个警告：

Warning in mean.default(input$varble) :
  argument is not numeric or logical: returning NA

对于aes()中的geom_vline()参数，我尝试了x()$input$varble以及将aes更改为aes_。两者似乎都不起作用。我错过了什么？

以下是一些数据：

dput(patients)
structure(list(age = c(25L, 34L, 72L, 66L, 46L, 67L, 46L, 32L, 
27L, 65L), height = c(152, 174, 165, 148, 152, 152, 178, 169, 
179, 166), weight = c(65, 78, 68, 45, 58, 58, 72, 57, 72, 48), 
    gender = structure(c(2L, 2L, 2L, 1L, 1L, 1L, 2L, 2L, 2L, 
    2L), .Label = c("Female", "Male"), class = "factor")), .Names = c("age", 
"height", "weight", "gender"), row.names = c(NA, -10L), class = c("tbl_df", 
"tbl", "data.frame"))

这是selectInput()的代码：

selectInput("varble","Select Variable for Histogram",
                                         choices = c("age","height","weight"))

Answer 1

您可以使用varmean <- mean(x()[[input$variable]])。这是一个完整的例子

数据

patients <- read.table(text = 
                         "
   age height weight gender
1   25    152     65   Male
2   34    174     78   Male
3   72    165     68   Male
4   66    148     45 Female
5   46    152     58 Female
6   67    152     58 Female
7   46    178     72   Male
8   32    169     57   Male
9   27    179     72   Male
10  65    166     48   Male")

应用

library(shiny)
library(plotly)

shinyApp(
  fluidPage(
    selectInput("variable", "Select variable for the histogram",
                choices = names(patients)[1:3]),
    selectInput("sex", "Choose a gender", c(levels(patients$gender), "Both")),
    plotlyOutput("histo")
  ),
  server = function(input, output, session) {
    x <- reactive({
      if(req(input$sex) == 'Both')
        patients
      else 
        patients %>% filter(gender == input$sex)
    })

    output$histo <- renderPlotly({
      x <- req(x())
      varmean <- mean(x[[input$variable]])

      ggplot(x, aes_string(input$variable)) +
        geom_histogram(bins = input$bins) +
        geom_vline(aes(xintercept = varmean), 
                   col = 'red', size = 1, linetype = "dashed") +
        theme(legend.position = "top")
    })
  }
)

或者，您可以使用aes(xintercept = mean(get(input$variable)))