Question

在我的示例中：

我使用2个日期范围：1用于分析＆amp; 1用于比较
根据所选的日期范围显示2张图表

主题

我想显示我的图表分析我的应用程序第一次运行时（定义了日期范围默认值）
我不想在我的日期范围内提取日期时刷新我的图表，但只有当我点击actionButton时

它正在运作......

对于比较部分

这不起作用......

对于分析部分，当您已经在actionButton上单击一次

不被视为解决方案

在我的所有渲染功能上添加条件：我想避免使用此解决方案，因为如果我有+ 10渲染，它太长了......

我的ui代码：

dashboardPage(
dashboardHeader(title = 'Dashboard '),
dashboardSidebar(width = 243,
    sidebarMenu( id = "sidebar_menu",
        menuItem(text = "Vue globale",tabName = "vue_globale") ,
         uiOutput(outputId = "daterange_analyse_ui"),
         uiOutput(outputId = "daterange_comparaison_ui"),
         actionButton("goButton", "Analyser") ) ),
dashboardBody( 
  highchartOutput(outputId = "distPlot_analysis", height = "245px"),
  highchartOutput(outputId = "distPlot_comparaison", height = "245px")
))

我的服务器.R代码：

 library(shiny)
 library(data.table)
 library(highcharter)  
 library(shinydashboard)

 server <- function(input,  output) {

    table_test <- reactive({
    result <- structure(list(date = c("01/01/2017", "02/01/2017", "03/01/2017", 
        "04/01/2017", "05/01/2017", "06/01/2017", "07/01/2017", "08/01/2017", 
        "09/01/2017", "10/01/2017", "11/01/2017", "12/01/2017", "13/01/2017", 
        "14/01/2017", "15/01/2017", "16/01/2017", "17/01/2017", "18/01/2017", 
        "19/01/2017", "20/01/2017", "21/01/2017", "22/01/2017", "23/01/2017", 
        "24/01/2017", "25/01/2017", "26/01/2017", "27/01/2017", "28/01/2017", 
        "29/01/2017", "30/01/2017", "31/01/2017", "01/02/2017", "02/02/2017", 
        "03/02/2017", "04/02/2017", "05/02/2017", "06/02/2017", "07/02/2017", 
        "08/02/2017", "09/02/2017", "10/02/2017", "11/02/2017"), 
    var = c(1L, 1L, 3L, 3L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    3L, 0L, 1L, 9L, 1L, 5L, 1L, 1L, 1L, 1L, 1L, 6L, 1L, 1L, 1L, 
    1L, 7L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L)), 
    .Names = c("date", "var"), row.names = c(NA, -42L), 
    class = c("data.frame"))
    result$date <- as.Date(result$date, format = "%d/%m/%Y", tz = "GMT")
    result <- as.data.table(result)
    return(result)
     })

    # Calendars
    output$daterange_analyse_ui <- renderUI( 
     dateRangeInput(
             inputId = "daterange_analyse",
             label = "Analysis",
             start = as.Date(min(table_test()$date), format = '%Y-%m-%d'),
             end = as.Date(min(table_test()$date), format = '%Y-%m-%d') + 2,
             min = min(table_test()$date),
             max = max(table_test()$date)
   )
   )

    output$daterange_comparaison_ui <- renderUI(
    dateRangeInput(
              inputId = "daterange_comparaison",
              label = "Comparison",
              start = as.Date(min(table_test()$date), format = '%Y-%m-%d'),
              end = as.Date(min(table_test()$date), format = '%Y-%m-%d') + 5,
              min = min(table_test()$date),
              max = max(table_test()$date)

     ) )


    # Table filtred

    ########## BEGINNING -THIS IS WHERE I PUT MY CONDITIONS ##########
    table_analysis <- eventReactive( if(input$goButton == 0 &
                                  (input$daterange_analyse[2] == as.Date(min(table_test()$date), format = '%Y-%m-%d') + 2) &
                                  (input$daterange_analyse[1] == as.Date(min(table_test()$date), format = '%Y-%m-%d')) ) { { input$goButton; input$daterange_analyse} }
                               else if (input$goButton > 0)  { {input$goButton} },  {
                                 result <- table_test()[date >= input$daterange_analyse[1] & date <= input$daterange_analyse[2], ]
                                 return(as.data.table(result))
                               })


    table_comparaison <- eventReactive(input$goButton, {
    result <- table_test()[date >= input$daterange_comparaison[1] & date <= input$daterange_comparaison[2]]
    return(result)
      })
    ########## END - THIS IS WHERE I PUT MY CONDITIONS ##########


    # Graphics
    output$distPlot_analysis <- renderHighchart({


      calc <- table_analysis()[, .(effectif = sum(var)), by = c("date")]
        x    <- calc$effectif
             highchart() %>%
              hc_xAxis(categories = calc$date) %>%
              hc_add_series(name = "Analyse", data = calc$effectif) %>%
              hc_chart(type = "column")

      })

    output$distPlot_comparaison <- renderHighchart({

      calc <- table_comparaison()[, .(effectif = sum(var)), by = c("date")]
        x    <- calc$effectif

       highchart() %>%
        hc_xAxis(categories = calc$date) %>%
        hc_add_series(name = "Comparaison", data = calc$effectif) %>%
        hc_chart(type = "column")
    })
 }

Answer 1

如果使用shiny modules，则无需为每个绘图反复定义服务器逻辑。我通过在ignoreNULL = FALSE中指定eventReactive解决了第二个图未加载的问题。

library(shiny)
library(data.table)
library(highcharter)  
library(shinydashboard)

table_test <- data.table(
  date = as.Date(c(
    "01/01/2017", "02/01/2017", "03/01/2017", 
    "04/01/2017", "05/01/2017", "06/01/2017", "07/01/2017", "08/01/2017", 
    "09/01/2017", "10/01/2017", "11/01/2017", "12/01/2017", "13/01/2017", 
    "14/01/2017", "15/01/2017", "16/01/2017", "17/01/2017", "18/01/2017", 
    "19/01/2017", "20/01/2017", "21/01/2017", "22/01/2017", "23/01/2017", 
    "24/01/2017", "25/01/2017", "26/01/2017", "27/01/2017", "28/01/2017", 
    "29/01/2017", "30/01/2017", "31/01/2017", "01/02/2017", "02/02/2017", 
    "03/02/2017", "04/02/2017", "05/02/2017", "06/02/2017", "07/02/2017", 
    "08/02/2017", "09/02/2017", "10/02/2017", "11/02/2017"),
    format = "%d/%m/%Y", tz = "GMT"
  ), 
  var = c(1L, 1L, 3L, 3L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
          3L, 0L, 1L, 9L, 1L, 5L, 1L, 1L, 1L, 1L, 1L, 6L, 1L, 1L, 1L, 
          1L, 7L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L)
)

## ui for the dateRangeInput
datePicker <- function(id, nx){
  ns <- NS(id)
  date <- table_test$date
  dateRangeInput(
    inputId = ns("daterange"),
    label = "Analysis",
    start = as.Date(min(date), format = '%Y-%m-%d'),
    end = as.Date(min(date), format = '%Y-%m-%d') + nx - 1,
    min = min(date),
    max = max(date)
  )
}

## ui for the plot (highchart) output
myHighChartUI <- function(id){
  ns <- NS(id)
  highchartOutput(ns("plot"),  height = "245px")
}

## server for datePicker and myHighChartUI
myHighChart <- function(input, output, session, goButton, name){

  table <- eventReactive(goButton(), {
    table_test[date >= input$daterange[1] & date <= input$daterange[2]]
  }, ignoreNULL = FALSE)

  output$plot <- renderHighchart({
    calc <- table()[, .(effectif = sum(var)), by = c("date")]
    x    <- calc$effectif

    highchart() %>%
      hc_xAxis(categories = calc$date) %>%
      hc_add_series(name = name, data = calc$effectif) %>%
      hc_chart(type = "column")
  })
}

ui <- dashboardPage(
  dashboardHeader(title = 'Dashboard '),
  dashboardSidebar(width = 243, sidebarMenu( 
    id = "sidebar_menu",
    menuItem(text = "Vue globale", tabName = "vue_globale") ,
    datePicker("analysis", 3),
    datePicker("comparison", 6),
    actionButton("goButton", "Analyser"))),
  dashboardBody( 
    myHighChartUI("analysis"),
    myHighChartUI("comparison")
  ))

server <- function(input,  output) {
  callModule(myHighChart, "analysis", reactive(input$goButton), "analysis")
  callModule(myHighChart, "comparison", reactive(input$goButton), "comparison")
}

shinyApp(ui, server)

Shiny：如何使用actionButton考虑默认值来隔离daterange中的日期选择？

1 个答案: