В моем примере :

  • Я использую 2 диапазона дат: 1 для анализа и 1 для сравнения
  • Я показываю 2 графика в зависимости от выбранного диапазона дат

Тема

  • Я хочу отображать анализ моего графика когда мое приложение запускается впервые (с определенными значениями по умолчанию для диапазона дат)
  • Я не хочу, чтобы мои графики обновлялись, когда я выбираю даты в моем диапазоне дат, а только когда я нажимаю кнопку actionButton

Работает ....

  • Для сравнительной части

Не работает ....

  • Что касается аналитической части, когда вы уже один раз щелкнули по кнопке actionButton

Не считается решением

  • Добавить условие для всех моих функций рендеринга: я хочу избежать этого решения, потому что оно слишком длинное, если у меня + 10 рендеров ...

Мой код пользовательского интерфейса:

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")
))

Мой код server.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")
    })
 }
0
Tracy Bsng 14 Фев 2018 в 16:34

1 ответ

Лучший ответ

Вам не нужно снова и снова определять логику сервера для каждого сюжета, если вы используете блестящие модули. Я решил проблему, заключающуюся в том, что второй график не загружался, указав 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)
0
Gregor de Cillia 15 Фев 2018 в 22:50