SelectInput 和 dateRangeinput 函数

Question

我真的需要你的帮助。我是 R shiny 的新手，我必须使用 2 个反应函数。我有一个数据库的 table，其中列 (id_cli, val_cli, date_cli) 示例 (1, 12, 2020-02-01); (1,30,2020-02-02); (2, 80,2020-02-03), etc id_cli 是外键，因此它在这个 table 中不是唯一的。我想 select id_cli 使用函数 selectInput 并从那里 select 使用 dateRangeInput 函数

的日期范围

这是我的代码：

DB <- dbConnect(MySQL(), 
                user='xx', 
                host='xxx.xxx.x.xx')

req22 = dbGetQuery(DB, "select id_cli, val_cli, date_cli from t_client;")

agg22 = setNames(aggregate(req22[,1:2], list(req22$date_cli), mean), c("date_cli", "id_cli","val_cli"))

agg22$date_cli = as.Date(agg22$date_cli)

dates22 <- seq(from = min(agg22$date_cli),
             to = max(agg22$date_cli),
             by="days") 

tweets22 <- data.frame(dateW = dates22, agg22$val_cli, agg22$id_cli)

selectInput(inputId = "id_cli2", label = h3("List of clients"), choices = tweets22$agg22.id_cli)


dateRangeInput(inputId="dateW", label ="Selectionne a Date",
            start = min(tweets22$agg22.date_cli), 
           end = max(tweets22$agg22.date_cli),
          min = min(tweets22$agg22.date_cli),
         max= max(tweets22$agg22.date_cli))

query <- reactive({
 tweets22 %>%
  select(agg22.id_cli, dateW, agg22.val_cli)  %>%
  filter(agg22.id_cli == input$id_cli2) 

})

 newtweets22 <-reactive({
 query()
 filter(tweets22, between(dateW, input$dateW[1], input$dateW[2])) 
})

renderPlot({
  ggplot(newtweets22(), aes(x=dateW, y=agg22.val_cli))+ geom_line(size=1) + xlab ("Date") + ylab("Values") 
})

该代码获取所有数据的日期范围，但不会 select by id_cli 即 input$cli 有人可以帮助我吗？

Answer 1

编辑： 我添加了 filter(id_cli == input$id_cli2) 以响应您的更新。

你想要这样的东西吗？

library(tidyverse)
library(lubridate)
library(shiny)

ui <- fluidPage(
  uiOutput("select_ui"),
  uiOutput("date_ui"),
  plotOutput("plot")
)

server <- function(input, output, session){
  
  req22 <- reactive({
    # Replace this with your database query:
    tibble(id_cli = c(1,1,1,2,2,2),
           val_cli = c(12,30,80,70,50,20),
           date_cli = c(ymd("2020-02-01"), ymd("2020-02-02"), ymd("2020-02-03"),
                        ymd("2020-02-04"), ymd("2020-02-05"), ymd("2020-02-06")))
  })
  
  output$select_ui <- renderUI({
    req(req22())
    clients <- req22() %>% distinct(id_cli) %>% pull %>% sort
    selectInput("id_cli2", "List of clients", choices = clients)
  })
  
  output$date_ui <- renderUI({
    req(req22())
    dates <- req22() %>%
      filter(id_cli == input$id_cli2) %>% 
      summarize(mindate = min(date_cli),
                maxdate = max(date_cli))
    dateRangeInput("dateW", "Select a date",
                   start = dates$mindate,
                   min = dates$mindate,
                   max = dates$maxdate,
                   end = dates$maxdate)
  })
  
  output$plot <- renderPlot({
    req(req22(), input$dateW, input$id_cli2)
    
    req22() %>%
      filter(date_cli >= input$dateW[[1]],
             date_cli <= input$dateW[[2]],
             id_cli == input$id_cli2) %>%
      ggplot(aes(x=date_cli, y = val_cli)) +
      geom_point() +
      geom_line()
  })
}

shinyApp(ui = ui, server = server)

我假设每次用户更改客户端 ID 时，您都希望日期默认为与该客户端相关的最宽范围。如果你想记住用户之前的日期选择，那么你应该使用 observeEvent 将它们存储在 reactiveVal 中，然后在过滤中也使用它。

Answer 2

非常感谢您的回答。是的，我想要这样，但有些东西不对。如果我用这个新数据考虑你的代码：

req22 <- reactive({
        # Replace this with your database query:
        tibble(id_cli = c(1,1,1,2,2,2),
               val_cli = c(12,30,80,70,50,20),
               date_cli = c(ymd("2020-02-01"), ymd("2020-02-02"), ymd("2020-02-03"),
                           c(ymd("2020-02-04"), c(ymd("2020-02-05"), c(ymd("2020-02-06")))
    })

在 List of cients select 1 的用户界面中，在 select 日期范围内，我想自动 2020-02-01 to 2020-02-03 并且当我select 2 我想在 Select a date 中自动看到 2020-02-04 to 2020-02-06 之间的日期剧情没问题，但只有 DateRangeInput 有问题。预先感谢您的帮助:)

SelectInput 和 dateRangeinput 函数

SelectInput and dateRangeinput functions

r

shiny

shinydashboard

reactive

shiny-reactivity