繁体   English   中英

在Shiny中绘制geom_vline()

[英]Plotting geom_vline() in Shiny

我有一个反应性数据radioButtons() x() ,它基本上基于radioButtons()过滤数据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

对于geom_vline()aes()参数,我尝试了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"))

您可以使用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)))

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM