在闪亮的仪表板中更新响应式对象

问题描述 投票：0回答：1

我想制作一个仪表板来跟踪健身活动。 我使用 googlesheets 作为后端存储。

当应用程序打开时，它会画出今天/昨天的所有活动。 /昨天之前。

应用程序的第一个屏幕显示了今天可用活动的所有开关 根据 googlesheet 数据源，开关已预加载其“当前状态”。

还有另一个切换键可以在今天/昨天之间切换。 /前一天。

目前，当我在不同日期之间交换时，当我切换回当天时，我所做的任何更改（例如今天的活动切换）都不再存在。

感觉我需要一些反应性对象 最初只是原始状态（从 googlesheets 下载） 但我希望每次按下开关时我对开关所做的更改（针对每天的每个活动）都会更新它。

我的目标是仅在点击“上传”按钮后才将更改上传到 googlesheets（但我已经涵盖了）。

enter image description here

library(tidyverse)
library(shiny)
library(shinyWidgets)




timeframes <- 
  tribble(
    ~date_name, ~date,
    "Today", today()
    , "Yesterday", today()-1 
    , "Day before yesterday", today()-2
  )




pre_assignment_vector <- 
  tibble::tribble(
    ~feature, ~date_name, ~value,
    "bike_into_coworking_space", "Day before yesterday",  FALSE,
    "bike_into_coworking_space", "Today",  FALSE,
    "bike_into_coworking_space", "Yesterday",   TRUE,
    
    "yoga", "Day before yesterday",  FALSE,
    "yoga", "Today",  FALSE,
    "yoga", "Yesterday",   TRUE
  ) %>% 
  mutate(value_name = paste0(feature, "_", snakecase::to_snake_case(date_name), "_status"),
         input_id_destination = paste0(feature, "_switch")
  )



assignment_vector <- 
  pre_assignment_vector %>% 
  filter(date_name == "Today")


map2(assignment_vector$value_name, assignment_vector$value, ~assign(.x, .y, envir = .GlobalEnv))


###################################################################

reactive_store_of_values_obj <- reactive(pre_assignment_vector)


###################################################################

# a function for when the date toggle is pressed

update_switches_to_date_selected <- function(reactive_store_of_values_obj, timeframe_selected) {
  
  
  # timeframe_selected <- "Yesterday"
  # reactive_store_of_values_obj <- pre_assignment_vector
  
  
  values_to_update_to <- 
    reactive_store_of_values_obj %>% 
    filter(date_name == timeframe_selected)
  
  status_vals <- values_to_update_to
  
  map2(status_vals$input_id_destination, status_vals$value, ~updateSwitchInput(inputId = .x, value = as.logical(.y)))
  
  
}


###################################################################

# a function to update the persistent "stor of values" object whenever any toggles are pressed.
# using hte date toggle input varable to determine the day

update_the_reactive_store_of_values_obj <- function(reactive_store_of_values_obj
                                                    , timeframe_selected = input$timeframe_selected
                                                    , yoga_switch = input$yoga_switch
                                                    , bike_into_coworking_space_switch = input$bike_into_coworking_space_switch) {
  
  
  # reactive_store_of_values_obj <- pre_assignment_vector
  # timeframe_selected <- "Yesterday"
  # yoga_switch <- yoga_today_status
  # bike_into_coworking_space_switch <- bike_into_coworking_space_today_status
  
  
  new_values_from_inputs <- 
    tibble(yoga_switch = yoga_switch,
           bike_into_coworking_space_switch = bike_into_coworking_space_switch) %>% 
    gather(input_id_destination, new_value) %>% 
    mutate(date_name = timeframe_selected)
  
  
  
  reactive_store_of_values_obj %>% 
    left_join(new_values_from_inputs, by = join_by(date_name, input_id_destination)) %>% 
    mutate(value = coalesce(new_value, value)) %>% 
    select(-new_value)
  
  
}



###################################################################




ui <- fluidPage(
  
  mainPanel(
    
    fluidRow(
      
      h3("Timeframe"),
      
      sliderTextInput(inputId = "timeframe_selected",
                      label = NULL,
                      choices = rev(timeframes$date_name),
                      selected = timeframes$date_name[1])
    ), 
    
    
    fluidRow(
      
      column(width = 2, h4("Yoga")), 
      column(width = 1, prettySwitch(inputId = "yoga_switch", label = NULL, value = as.logical(yoga_today_status))),
      
      
    ), 
    
    
    fluidRow(
      
      column(width = 2, h4("Bike into Coworking Space")), 
      column(width = 1, prettySwitch(inputId = "bike_into_coworking_space_switch", label = NULL, value = as.logical(bike_into_coworking_space_today_status)))
      
    ) 
    
  )
)



server <- function(input, output) {
  
  
  
  observeEvent(ignoreInit = TRUE, input$timeframe_selected, {
    
    # update inputs to the newly selected date's values
    update_switches_to_date_selected(reactive_store_of_values_obj = reactive_store_of_values_obj(), timeframe_selected = input$timeframe_selected)
    
  })
  
  
  
  
  ###################################################################
  all_inputs_watch_list <- reactive(
    list(
      input$yoga_switch
      , input$bike_into_coworking_space_switch
    ))
  
  
  observeEvent(ignoreInit = TRUE, all_inputs_watch_list(), {
    
    print("switch used")
    
    reactive_store_of_values_obj <- reactive(update_the_reactive_store_of_values_obj(reactive_store_of_values_obj()))
    
    
    
    
  })
  
  
  
}





shinyApp(ui = ui, server = server)
r shiny shiny-reactivity
1个回答
0
投票

我得到了一些解决方案的帮助（我还不太完全理解它，但它有效。

在服务器内，我需要像这样启动持久反应对象......

  reactive_object <- reactiveValues(store_of_values = NULL)
  
  observe({reactive_object$store_of_values <- pre_assignment_vector})

然后，所有对“reactive_store_of_values_obj()”的引用都可以替换为“reactive_object$store_of_values”

EG

update_switches_to_date_selected(reactive_store_of_values_obj = reactive_object$store_of_values, timeframe_selected = input$timeframe_selected)

reactive_object$store_of_values <- update_the_reactive_store_of_values_obj(reactive_object$store_of_values, input$timeframe_selected, input)

这是完整的代码，并进行了这些更正

library(tidyverse)
library(shiny)
library(shinyWidgets)



timeframes <- 
  tribble(
    ~date_name, ~date,
    "Today", today()
    , "Yesterday", today()-1 
    , "Day before yesterday", today()-2
  )




pre_assignment_vector <- 
  tibble::tribble(
    ~feature, ~date_name, ~value,
    "bike_into_coworking_space", "Day before yesterday",  FALSE,
    "bike_into_coworking_space", "Today",  FALSE,
    "bike_into_coworking_space", "Yesterday",   TRUE,
    
    "yoga", "Day before yesterday",  FALSE,
    "yoga", "Today",  FALSE,
    "yoga", "Yesterday",   TRUE
  ) %>% 
  mutate(value_name = paste0(feature, "_", snakecase::to_snake_case(date_name), "_status"),
         input_id_destination = paste0(feature, "_switch")
  )



assignment_vector <- 
  pre_assignment_vector %>% 
  filter(date_name == "Today")


map2(assignment_vector$value_name, assignment_vector$value, ~assign(.x, .y, envir = .GlobalEnv))



###################################################################

# a function for when the date toggle is pressed

update_switches_to_date_selected <- function(reactive_store_of_values_obj, timeframe_selected) {
  
  
  # timeframe_selected <- "Yesterday"
  # reactive_store_of_values_obj <- pre_assignment_vector
  
  
  values_to_update_to <- 
    reactive_store_of_values_obj %>% 
    filter(date_name == timeframe_selected)
  
  status_vals <- values_to_update_to
  
  map2(status_vals$input_id_destination, status_vals$value, ~updateSwitchInput(inputId = .x, value = as.logical(.y)))
  
  
}


###################################################################

# a function to update the persistent "stor of values" object whenever any toggles are pressed.
# using hte date toggle input varable to determine the day

update_the_reactive_store_of_values_obj <- function(reactive_store_of_values_obj
                                                    , timeframe_selected
                                                    , input) {
  
  
  
  # timeframe_selected <- "Yesterday"
  # reactive_store_of_values_obj <- pre_assignment_vector
  # 
  # input <- list(
  #   yoga_switch = yoga_today_status,
  #   bike_into_coworking_space_switch = bike_into_coworking_space_today_status
  # )
  
  
  
  new_values_from_inputs <- 
    tibble(yoga_switch = input$yoga_switch,
           bike_into_coworking_space_switch = input$bike_into_coworking_space_switch) %>% 
    gather(input_id_destination, new_value) %>% 
    mutate(date_name = timeframe_selected)
  
  
  
  reactive_store_of_values_obj %>% 
    left_join(new_values_from_inputs, by = join_by(date_name, input_id_destination)) %>% 
    mutate(value = coalesce(new_value, value)) %>% 
    select(-new_value)
  
  
}



###################################################################




ui <- fluidPage(
  
  mainPanel(
    
    fluidRow(
      
      h3("Timeframe"),
      
      sliderTextInput(inputId = "timeframe_selected",
                      label = NULL,
                      choices = rev(timeframes$date_name),
                      selected = timeframes$date_name[1])
    ), 
    
    
    fluidRow(
      
      column(width = 2, h4("Yoga")), 
      column(width = 1, prettySwitch(inputId = "yoga_switch", label = NULL, value = as.logical(yoga_today_status))),
      
      
    ), 
    
    
    fluidRow(
      
      column(width = 2, h4("Bike into Coworking Space")), 
      column(width = 1, prettySwitch(inputId = "bike_into_coworking_space_switch", label = NULL, value = as.logical(bike_into_coworking_space_today_status)))
      
    ) 
    
    
    
    
  )
)






server <- function(input, output) {
  
  
  
  reactive_object <- reactiveValues(store_of_values = NULL)
  
  observe({reactive_object$store_of_values <- pre_assignment_vector})
  
  
  
  
  observeEvent(ignoreInit = TRUE, input$timeframe_selected, {
    
    # update inputs to the newly selected date's values
    update_switches_to_date_selected(reactive_store_of_values_obj = reactive_object$store_of_values, timeframe_selected = input$timeframe_selected)
    
  })
  
  
  
  
  ###################################################################
  all_inputs_watch_list <- reactive(
    list(
      input$yoga_switch
      , input$bike_into_coworking_space_switch
    ))
  
  
  
  
  observeEvent(ignoreInit = TRUE, all_inputs_watch_list(), {
    
    print("switch used")
    
    
    reactive_object$store_of_values <- update_the_reactive_store_of_values_obj(reactive_object$store_of_values, input$timeframe_selected, input)
    
    
  })
  
  
  
}





shinyApp(ui = ui, server = server)
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.