How do I pass a datatable cell edit into a reactiveVal(), then use it in calculations in a reactive() function?
When I change the number in the Goals Column, I expect the color columns to change. For example, currently all of the color columns are "yellow" for the 3rd row, Analyte = Tom. If I change the goal for that row to something large, like 55, all the colors should change to "green" because the Goal will be larger than the Median/95thpercentile/maximum.
I have found 2 methods (linked below) that I tried in my code, and the colors still don't change. It seems like Method 2 is exactly what I'm trying to do - edit in the table and see a change in another column based on a reactive() calc.
I have the print("Running") code in finished_all() to see if that reactive code is being re-run when I update the table. It does not re-print. It seems that either start_goal() is not being updated or finished_all is not being rerun with the new start_goal() values.
What am I missing here? It seems like I am misunderstanding something about Shiny.
Code below. Sidenote, the colors will be actual colors using formattable, I took it out for simplicity.
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)
Update:
To make the above work, update the observeEvent() to be:
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) })
It seems that I needed to update the variable I was using in my output/UI, MCLtable, not the reactive finished_all() function
Additionally, the order of the list in start_goal() needs to match the original Datatable exactly (ie, the order must be Flow, Pete, Tom, not Pete, Flow, Tom). Otherwise, the wrong row will be updated.