在Shiny中的reactive()函数中使用DataTable中的编辑值

ddarikpa  于 5个月前  发布在  React
关注(0)|答案(1)|浏览(37)

如何将数据表单元格编辑传递到reactiveVal()中,然后在reactive()函数中使用它进行计算?
当我更改Goals列中的数字时,我希望颜色列发生更改。例如,当前第3行Analyte = Tom的所有颜色列都是“黄色”。如果我将该行的目标更改为较大值(如55),则所有颜色都应更改为“绿色”,因为目标将大于中位数/第95百分位数/最大值。
我在代码中尝试了两种方法(链接如下),颜色仍然没有改变。看起来方法2正是我想要做的-在表中编辑,然后看到基于reactive()计算的另一列中的变化。
Method 1Method 2
我在finished_all()中有print("Running")代码,以查看当我更新表时是否重新运行该React代码。它不会重新打印。似乎start_goal()没有被更新,或者finished_all没有被新的start_goal()值所取代。
我在这里错过了什么?似乎我误解了一些关于闪亮的东西。
下面的代码。注意,颜色将是实际的颜色使用formattable,我把它简单。

library(shiny)
library(shinydashboard)
library(tidyverse)
library(purrr)
library(DT) 

##########################################################################################################*

# Universal ----

initialdata <- tibble(
  Analyte_Short=    c(rep("Flo",2), rep("Pete",2), rep("Tom",2)),
  Result_Num    = c(0.3, 47, 0, 2.5, .9, 5),
  Source=   rep(c("A", "B"),3),
  Method=   c(rep("500a",2), rep("600a",2), rep("700a",2)),
  RESULT_UNIT=  c(rep("MG/L", 6)),
  Analyte_Group=    c(rep("Group1",2), rep("Group2",2), rep("Group3",2)),
  MCL=  c(rep(4,4), rep(as.numeric(NA), 2)),
  SMCL=c(rep(2,2), rep(as.numeric(NA), 4))
) %>%
  mutate(ID= row_number()) 

finaldata <- tibble(
  Analyte_Short =   c("Flo","Pete","Tom"),
  Method =  c("500a","600a","700a"),
  Process = rep("filt",3),
  Removal = c(0.007, 1, .4)
)  %>%
  mutate(ID= row_number()) %>%
  pivot_wider(names_from = Process, values_from = Removal) 

all_mcl <- initialdata %>%
  select(c(Analyte_Group, Analyte_Short, MCL, SMCL, RESULT_UNIT)) %>%
  distinct()

relevantanalytes <-all_mcl$Analyte_Short

###########################################################################################################*

# UI ----

# * Sidebar ----
sidebar <- dashboardSidebar(
  width = 325,
  sidebarMenu(id = "tab", 
              menuItem("Goals", tabName = "goals"),
              menuItem(style = 'float:right, padding: 10px', 
                       "Sources",
                       tabName = "flows",
                       startExpanded = TRUE,
                       div(style = 'float:right',
                           actionButton(inputId = "reset_sliders", label = "Reset Sliders")),
                       br(),
                       sliderInput(inputId = "A", label = "A", min = 0, max = 5, value = 1, step = .1),
                       sliderInput(inputId = "B", label = "B", min = 0, max = 5, value = 3, step = .1)
              ))) 

goals <- tabItem(tabName = "goals", box(width = 8, DT::DTOutput("MCLtable"))) 

ui =
  dashboardPage(
    skin = "green",
    dashboardHeader(title = "Reactive table"),
    sidebar,
    dashboardBody(tabItems(goals))
  )

#########################################################################################################*

# SERVER ----

server = function(input, output, session){

  #* Reset sliders ----
  observeEvent(input$reset_sliders, {
    updateSliderInput(session=session, "A", value = .1)
    updateSliderInput(session=session, "B", value = 0)
  })
  
  #Calculate ratios based on inputs
  b_ratios <- reactive({ 
    
      rate <- c(.1, .7)
      rate <- c(input$A, input$B)
      total <- sum(rate)
      bbratio <- rate / total
      b_table <- tibble(Source = c("A", "B"),
                            Bl = bbratio)
    return(b_table)
  })

  # * finished_all() ----
  finished_all <- reactive({
    print("Running")
    st_goal <-  req(start_goal())
    
    b_summ <- initialdata %>%
      filter(Analyte_Short %in% relevantanalytes) %>%
      full_join(b_ratios(), by = "Source") %>%
      mutate(EachSource_Conc = Result_Num * Bl)  %>%
      group_by(Analyte_Short, RESULT_UNIT, ID)  %>%
      summarise(Blend_Conc = sum(EachSource_Conc), .groups = "drop") %>%
      rename(Raw = Blend_Conc,
             Units = RESULT_UNIT)
    
    finished <- finaldata %>%
      select(Analyte_Short, filt, ID, Method) %>%
      right_join(b_summ, by = c("Analyte_Short", "ID")) %>%
      
      mutate(PostA = Raw * (1-filt)) %>%
      select(-filt) %>%
      pivot_longer(c(Raw, PostA), names_to = "Location", values_to = "Concentration") %>%
      group_by(Analyte_Short) %>%
      summarize(FinishedMedian = median(Concentration, na.rm = TRUE),
                Finished95thP = quantile(Concentration, .95, na.rm = TRUE),
                FinishedMax = max(Concentration, na.rm = TRUE)) %>%
      
      right_join(all_mcl) %>%
      
      mutate(Median = round(FinishedMedian, 1),
             `95th Percentile` = round(Finished95thP, 1),
             Maximum = round(FinishedMax, 1),
             
             # This Goal column gets updated in the table, but doesn't seem to update here 
             # Goal = st_goal[Analyte_Short %>% as.characeter]
             Goal = st_goal[Analyte_Short]) %>%
      
      rename(`Analyte Group` = Analyte_Group,
             Analyte = Analyte_Short,
             Units = RESULT_UNIT) %>%
      select(`Analyte Group`, Analyte, Units, MCL, SMCL, Goal, Median, `95th Percentile`, Maximum) %>%
    
      # Goals here don't seem to be updated becuase the color labels don't change based on Goal column value
      mutate(MedColor = case_when(Median < Goal ~ "green",
                                  Median >= MCL ~ "red",
                                  Median >= SMCL ~ "orange",
                                  TRUE ~ "yellow"),
             P95Color = case_when(`95th Percentile` < Goal ~ "green",
                                  `95th Percentile` >= MCL ~ "red",
                                  `95th Percentile` >= SMCL ~ "orange",
                                  TRUE ~ "yellow"),
             MaxColor = case_when(Maximum < Goal ~ "green",
                                  Maximum  >= MCL ~ "red",
                                  Maximum >= SMCL ~ "orange",
                                  TRUE ~ "yellow"))
    return(finished)
  })

  # goals table ----
  start_goal <- reactiveVal(
    list(
      "Flo" =   2,
      "Pete"    =   4,
      "Tom" =   2   ))
  
  #cell update----

  observeEvent(input$finished_all_cell_edit, {
    
    i = input$finished_all_cell_edit$row
    j = input$finished_all_cell_edit$col+1
    v = input$finished_all_cell_edit$value
    
    temp_goal <- start_goal()
    
    temp_goal[[i]] <- v %>% as.numeric
    
    start_goal(temp_goal)
    
  })
  
  # create a dataframe that reactive values can be added to
  # df_mcltable <- reactiveValues(data=NULL)
  # 
  # # add reactive values to a df
  # observe({
  #   df_mcltable$data <- finished_all()
  # })
  #
  # observeEvent(input$df_mcltable_cell_edit, {
  # 
  #   i = input$df_mcltable_cell_edit$row
  #   j = input$df_mcltable_cell_edit$col  
  #   v = input$df_mcltable_cell_edit$value
  #   
  #   # df_mcltable$data[i, j+1] <- coerceValue(v, df_mcltable$data[i, j+1])
  #   
  #   temp_goal <- start_goal()
  #   
  #   temp_goal[[i]] <- v %>% as.numeric
  #   
  #   start_goal(temp_goal)
  # })
  
  # OUTPUTS----
  
  output$MCLtable <- renderDT( 
    
    # df_mcltable$data,
    finished_all(),
    escape = FALSE, #this needs to stay false due to much HTML in original code
    options = list(scrollY = 600, paging = FALSE),
    rownames = FALSE,
    editable = list(target = "cell", disable = list(columns = c(0:4,6,7))),
    selection = "none"
  )
  
}

shinyApp(ui , server)

字符串

83qze16e

83qze16e1#

更新:要使上述工作,请将observeEvent()更新为:

observeEvent(input$MCLtable_cell_edit, {

i = input$MCLtable_cell_edit$row
j = input$MCLtable_cell_edit$col+1
v = input$MCLtable_cell_edit$value

temp_goal <- start_goal()

temp_goal[[i]] <- v %>% as.numeric

start_goal(temp_goal) })

字符串
看起来我需要更新我在输出/UI中使用的变量MCLtable,而不是响应式finished_all()函数
此外,start_goal()中列表的顺序需要与原始数据表完全匹配(即,顺序必须是Flow,Pete,Tom,而不是Pete,Flow,Tom)。否则,将更新错误的行。

相关问题