通过 Date SliderInput 更新 Shiny R 中的 GGPlot2 值

Question

我的 Shiny 应用程序中有一个滑块输入。它在应用程序中看起来很好，但我正在努力将值传递给服务器功能。当有人玩幻灯片时，我无法创建交互性来改变它。谢谢

我的数据是这样的：

Snippet of data frame

R代码如下：

testdfall <- testdf
library(shiny)
library(tidyverse)

testdfall <- data.frame(date = c('2020-03-01', '2020-03-02','2020-03-03', '2020-03-04', '2020-03-05', '2020-03-06', '2020-03-07','2020-03-08', '2020-03-09'), 
                    ptppAll = c('0.2', '4.14', '1.2', '0.2', '0.4', '0', '0.6', '0.6', '7.27'), 
                    mAverage = c('', '', '', '0.962', '10.2', '1.47', '2.06', '2.10', '2.10')) %>% 
  mutate(date = as.Date(date))
ui <- fluidPage(
  
  sidebarPanel(
    selectInput(inputId = "Areas", label="Choose your Areas", choices = c("Barn"="Barn",
                                                                                "Ham"="Ham",
                                                                                "Donc"="Donc",
                                                                                "Field"="Field",
                                                                                "All Areass"="AllAreass"),
                selected = "AllAreass", multiple = TRUE),
    
    
    sliderInput("slider", label = h4("Slider Range"),
                min = as.Date("2020-01-01","%Y-%m-%d"),
                max = as.Date("2020-12-01","%Y-%m-%d"),
                value=as.Date(c("2020-12-01","2020-05-01")),
                timeFormat="%Y-%m-%d")
    
    
  ),
  mainPanel(
 
  plotOutput(outputId="mAveragePlot"),

  )
)

server <- function(input, output) { 
  #Attempt at creating variable for values from user interaction
  date = renderPrint({ input$slider })

  output$mAveragePlot<- renderPlot({
    if ((input$Areas=="AllAreass")){
      ggplot(data=testdfall, aes(x=date)) +
        geom_line(aes(y=mAverage),colour="red") +
        geom_line(aes(y=ptppAll ))+
        ggtitle("Daily Cases with Moving Average") +
        labs(x="Date", y="Positive Tests Per 100,000 Population") +
        scale_x_date(breaks = "2 day")+ #displays every 2 days. If need to change, put "3 day" for label every 3 days or "month" for each month +
        theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
        labs(colour='test Areas Name')
    }else {
      ggplot(data=testdf%>% filter(AreasName == input$Areas), aes(x=date)) + 
        geom_line(aes(y=mAverage, group=AreasName, colour=AreasName),colour="red") +
        geom_line(aes(y=ptpp ,group=AreasName, colour=AreasName),colour="black")+
        ggtitle("Daily Cases Per test Areas") + 
        labs(x="Date", y="Positive Tests Per 100,000 Population") +
        scale_x_date(breaks = "2 day")+ #displays every 2 days. If need to change, put "3 day" for label every 3 days or "month" for each month +
        theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
        labs(colour='test Areas Name')
    }
  })
  
  
}


shinyApp(ui = ui, server = server)

Answer 1

感谢您的澄清。这是一个演示您想要的功能的 MWE。我错过了你问题中的测试数据（抱歉），所以我使用了 tidyverse 中包含的 faithful 数据集的一个变体（是的，我故意误解了其中一列，以便我得到一个合理的日期范围一起玩）。

您的尝试失败的原因是 renderPrint 创建了一个输出对象，该对象旨在出现在 GUI 中，而不是在您的服务器逻辑中使用。它没有出现在 GUI 中的原因是您没有在 ui 函数中定义相应的输出对象。

library(shiny)
library(tidyverse)

data <- faithful %>% mutate(eruptionTime=lubridate::now() + lubridate::dhours(cumsum(waiting)))

ui <- fluidPage(
  sliderInput("slider", label = "Date Range",
              min = min(data$eruptionTime),
              max = max(data$eruptionTime),
              value=c(min(data$eruptionTime),max(data$eruptionTime)),
              timeFormat="%Y-%m-%d"),
  plotOutput("plot")
)

server <- function(input, output) {
  output$plot <- renderPlot({
    data %>% 
      ggplot() +
        geom_point(aes(x=eruptionTime, y=eruptions)) +
        coord_cartesian(xlim=input$slider)
  })
}

shinyApp(ui = ui, server = server)

我建议使用coord_cartesian来改变坐标轴限制，而不是看起来更明显的xlim，（或ylim）因为后者排除[=26] =] 数据在创建图之前，而 coord_cartesian 首先创建图，然后将视口“缩放”到所需区域。区别在这里并不重要，但如果你正在做任何模型拟合或平滑，它就会：使用 xlim 会产生误导性的结果。

通过 Date SliderInput 更新 Shiny R 中的 GGPlot2 值

Updating GGPlot2 values in Shiny R through Date SliderInput

r

ggplot2

shiny

shiny-reactivity