如何将数据表单元格编辑传递到
reactiveVal()reactive()当我更改
Goals我发现了我在代码中尝试过的两种方法（下面链接），并且颜色仍然没有改变。看来方法 2 正是我想要做的 - 在表中进行编辑，并根据
reactive()我在
print("Running")finished_all()start_goal()finished_allstart_goal()我在这里缺少什么？看来我对Shiny有什么误解。
代码如下。旁注，颜色将是使用
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)
更新： 要使上述工作正常进行，请将
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 中使用的变量，
MCLtablefinished_all()此外，
start_goal()