Слайдер Shiny Range - ошибка при использовании фильтра в ggplot - PullRequest
2 голосов
/ 29 января 2020

Доброе утро, и заранее спасибо за помощь. Я пытался развернуть блестящее приложение, но не могу заставить свой ползунок отфильтровать значения года, у меня есть некоторый код, но я пробовал много способов фильтрации безуспешно. Я включил мой код ниже, и str / head моего dataframe.

str:
 $ date: POSIXct, format: "1985-01-01" "1985-02-01" "1985-03-01" "1985-04-01" ...
 $ temp: num  36.4 41.7 54.9 67.4 75.2 ...
 $ mean: num  32.4 38.5 56.9 71.4 77.4 ...
 $ min : num  16.2 18.8 26.9 36 46.1 ...
 $ max : num  49.6 52.1 62.9 68.5 78.4 ...

head:
   date                 temp  mean   min   max
  <dttm>              <dbl> <dbl> <dbl> <dbl>
1 1985-01-01 00:00:00  36.4  32.4  16.2  49.6
2 1985-02-01 00:00:00  41.7  38.5  18.8  52.1
3 1985-03-01 00:00:00  54.9  56.8  26.9  62.8
4 1985-04-01 00:00:00  67.4  71.4  36.0  68.4
5 1985-05-01 00:00:00  75.2  77.4  46.1  78.4
6 1985-06-01 00:00:00  81.3  81.2  54.9  85.0

> dput(head(AllTempNew1,20))
structure(list(date = structure(c(473385600, 476064000, 478483200, 
481161600, 483753600, 486432000, 489024000, 491702400, 494380800, 
496972800, 499651200, 502243200, 504921600, 507600000, 510019200, 
512697600, 515289600, 517968000, 520560000, 523238400), class = c("POSIXct", 
"POSIXt"), tzone = "UTC"), temp = c(36.43, 41.68, 54.93, 67.42, 
75.16, 81.28, 87.33, 83.84, 74.5, 65.75, 48.79, 39.47, 46.04, 
45.95, 58.59, 65.44, 73.72, 83.16, 86.09, 84.58), mean = c(32.37, 
38.54, 56.85, 71.36, 77.36, 81.22, 87.98, 82.54, 71.19, 64.7, 
44.87, 36.18, 51.59, 47.08, 64.17, 67.4, 74.48, 84.98, 85.5, 
84.02), min = c(16.2, 18.81, 26.94, 35.96, 46.09, 54.93, 59.4, 
57.34, 50.27, 39, 28.13, 16.57, 16.2, 18.81, 26.94, 35.96, 46.09, 
54.93, 59.4, 57.34), max = c(49.64, 52.14, 62.85, 68.45, 78.4, 
85.03, 89.96, 88.36, 81.95, 69.89, 61.16, 48.06, 49.64, 52.14, 
62.85, 68.45, 78.4, 85.03, 89.96, 88.36)), row.names = c(NA, 
-20L), class = c("tbl_df", "tbl", "data.frame"))

Вот мой интерфейс:

shinyUI(fluidPage(
  titlePanel("U.S. Monthly Temperature Highs, Lows, and Averages from 1985-2019"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("year", "Select a Range of Years to Display ", min = 1985, max = 2019,
                  value = c(1985, 2019), sep = ""),
       checkboxInput("Min1","Min Temp", names(c("Min1"))),
       checkboxInput("Max1","Max Temp", names(c("Max1"))),
       checkboxInput("Mean1","Mean Temp", names(c("Mean1")))),
    mainPanel(plotOutput("TempPlot")))))

Вот мой сервер:

shinyServer(function(input, output) {
  sliderValues <- reactive({
     temp <- AllTempNew1$temp
     max <- input$Max1
     min <- input$Min1
     mean <- input$Mean1
     yearrange <- AllTempNew1 %>% filter(variable %in% input$year)})

    output$TempPlot <- renderPlot({
      TempPlot <- ggplot(AllTempNew1, aes(x= yearrange)) + 
        geom_line(aes(y = temp), color = "orange", linetype="solid") 
      TempPlot <- TempPlot + labs(title = "U.S. Monthly Temperature Highs, Lows, and Averages from 1985-2019",
      x = "Year of Recorded Temperature", y = "Temperature Recorded")
      TempPlot

      if(input$Max1 == FALSE & input$Mean1 == FALSE & input$Min1 == FALSE){TempPlot}
      else if(input$Max1 == TRUE){
        TempPlot + geom_line(aes(y = max), color = "red", linetype="dotdash")}
      else if(input$Min1 == TRUE){
        TempPlot + geom_line(aes(y = min), color="blue", linetype="dotdash")}
      else if(input$Mean1 == TRUE){
        TempPlot + geom_line(aes(y = mean), color="green", linetype="twodash")}
      else{TempPlot}})})

1 Ответ

0 голосов
/ 29 января 2020

Я думаю, вы хотите что-то подобное, что возможно с пакетом lubridate.

library(shiny)
library(lubridate)

AllTempNew1 <- structure(list(date = structure(c(473385600, 476064000, 478483200, 481161600, 483753600, 486432000, 489024000, 491702400, 494380800, 
                                                 496972800, 499651200, 502243200, 504921600, 507600000, 510019200,512697600, 515289600, 517968000, 520560000, 523238400), 
                                               class = c("POSIXct", "POSIXt"), tzone = "UTC"), 
                              temp = c(36.43, 41.68, 54.93, 67.42,75.16, 81.28, 87.33, 83.84, 74.5, 65.75, 48.79, 39.47, 46.04, 
                                       45.95, 58.59, 65.44, 73.72, 83.16, 86.09, 84.58), 
                              mean = c(32.37, 38.54, 56.85, 71.36, 77.36, 81.22, 87.98, 82.54, 71.19, 64.7, 
                                       44.87, 36.18, 51.59, 47.08, 64.17, 67.4, 74.48, 84.98, 85.5, 84.02), 
                              min = c(16.2, 18.81, 26.94, 35.96, 46.09, 54.93, 59.4, 57.34, 50.27, 39, 28.13, 
                                      16.57, 16.2, 18.81, 26.94, 35.96, 46.09, 54.93, 59.4, 57.34), 
                              max = c(49.64, 52.14, 62.85, 68.45, 78.4, 85.03, 89.96, 88.36, 81.95, 69.89,
                                      61.16, 48.06, 49.64, 52.14, 62.85, 68.45, 78.4, 85.03, 89.96, 88.36)), 
                         row.names = c(NA, -20L), class = c("tbl_df", "tbl", "data.frame"))


ui <- fluidPage(
  titlePanel("U.S. Monthly Temperature Highs, Lows, and Averages from 1985-2019"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("year", "Select a Range of Years to Display ", min = 1985, max = 2019,
                  value = c(1985, 2019), sep = ""),
      checkboxGroupInput("fun", label = NULL, 
                         choices = list("Min Temp" = 1, 
                                        "Max Temp" = 2, 
                                        "Mean Temp" = 3))
      ),
    mainPanel(plotOutput("TempPlot"))))

server <- function(input, output) {

  minFun <- reactive({
    if (1 %in% input$fun) { 
      geom_line(aes(y = min), color="red", linetype="dotdash")}
  })
  maxFun <- reactive({
    if (2 %in% input$fun) { 
      geom_line(aes(y = max), color="blue", linetype="dotdash")}
  })
  meanFun <- reactive({
    if (3 %in% input$fun) { 
      geom_line(aes(y = mean), color="green", linetype="twodash")}
  })

  output$TempPlot <- renderPlot({
    TempPlot <- ggplot(AllTempNew1 %>% filter(between(as.numeric(year(AllTempNew1$date)), input$year[1], input$year[2])), aes(x= date)) + 
      geom_line(aes(y = temp), color = "orange", linetype="solid") + 
      labs(title = "U.S. Monthly Temperature Highs, Lows, and Averages from 1985-2019",
           x = "Year of Recorded Temperature", 
           y = "Temperature Recorded") + minFun() + maxFun() + meanFun()
    TempPlot
  })
  }

shinyApp(ui, server)

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...