英文:
How do I update an eval() calculation based on user inputs into a data table in R Shiny?
问题
我有一个应用程序，用户可以从下拉列表中选择一个方程式。该应用程序从表格中提取输入到方程式中的所有变量，将这些变量插入方程式中，并提供结果。然而，我希望用户能够覆盖任何值，并查看计算结果的变化。计算是通过使用eval和变量列表来实现的，因此我怀疑我尝试的是在用户更新表格值时更改环境中变量的值，但我也愿意尝试其他方法！请参见下面提供的屏幕截图和示例。
我能够获得文本框，用户可以在其中输入变量的值。（小小的胜利！）我尝试使用代理表格来实现重新计算，但问题是我没有找到一个同时包含代理表格和动态输入字段的示例。
我找到的许多示例都以mod_df <- shiny::reactiveValues(x = df)（或类似的代码）开头。当我尝试复制代码时，出现以下错误：
You tried to do something that can only be done from inside a reactive consumer.
示例代码：
library(shiny)library(DT)require(stringr)df1 = data.frame("ID" = c(1:3), "Equation" = c("<A> * <B> + <C>", "<A> + <B> + <C>", "<A> - <B> + <C>"))df2 = data.frame("Equation" = c(1, 1, 1, 2, 2, 2, 3, 3, 3),"Variable" = c("A", "B", "C", "A", "B", "C", "A", "B", "C"),"Value" = c(5,3,10,2,4,NA,7,5,NA))df3 = data.frame("Premise" = c("Red", "Yellow", "Green"),"Value" = c(5,4,3))ui <- fluidPage(selectizeInput("df1Select", "Select Equation", choices = df1$Equation, multiple = TRUE, options = list(maxItems = 1)),h3("This is the static table of the variables as defined"),dataTableOutput("StaticTable"),br(),htmlOutput("CalcResultStatic"),h3("Here, I want to be able to manipulate the fields and recalculate the results"),dataTableOutput("InteractiveTable"),br(),htmlOutput("CalcResultInteractive"))server <- function(input, output, session) {### Filter DataStaticTableFiltered = reactive({EqSelect = if(is.null(input$df1Select)) unique(as.vector(df1$ID)) else df1$ID[df1$Equation == input$df1Select]filter(df2, Equation %in% EqSelect)})### Render Static Tableoutput$StaticTable = renderDataTable({if(is.null(input$df1Select)) return(NULL) else {StaticTableFiltered()}},options = list(dom = 't'), selection = "none")### Render Static Result as TextCalculateResultStatic = reactive({if(is.null(input$df1Select)) return(NULL) else {### Define algorithmCalcEq = paste(input$df1Select)### Make list of input variablesVariables = as.data.frame(str_extract_all(input$df1Select, "<(.*?)>"))colnames(Variables)[1] = "Vars"### Remove < > from algorithm and assumptionsCalcEq = gsub("<","",gsub(">","",CalcEq))Variables$Vars = gsub("<","",gsub(">","",Variables$Vars))### Get values from Assumptions tableVariables = merge(Variables, df2[df2$Equation == df1$ID[df1$Equation == input$df1Select],], by.x = "Vars", by.y = "Variable", all.x = TRUE, all.y = FALSE)### Convert variables to listVariables.List = as.list(Variables$Value)names(Variables.List) = Variables$Vars### Evaluate equation on listeval(str2lang(CalcEq), envir = Variables.List)}})output$CalcResultStatic = renderUI(HTML(paste("<b>",CalculateResultStatic(), sep = "")))### Render Interactive Tableoutput$InteractiveTable = renderDataTable({if(is.null(input$df1Select)) return(NULL) else {data = data.frame(StaticTableFiltered(),UserValue = sapply(1:nrow(StaticTableFiltered()), function(i) {sprintf('<input id="text" type="text" class="form-control" value=""/>', i)}))}},selection = "none", escape = FALSE,options =list(preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } '),dom = 't',processing = FALSE))### Render Interactive Result as TextCalculateResultInteractive = reactive({if(is.null(input$df1Select)) return(NULL) else {### Define algorithmCalcEq = paste(input$df1Select)### Make list of input variablesVariables = as.data.frame(str_extract_all(input$df1Select, "<(.*?)>"))colnames(Variables)[1] = "Vars"### Remove < > from algorithm and assumptionsCalcEq = gsub("<","",gsub(">","",CalcEq))Variables$Vars = gsub("<","",gsub(">","",Variables$Vars))### Get values from Assumptions tableVariables = merge(Variables, df2[df2$Equation == df1$ID[df1$Equation == input$df1Select],], by.x = "Vars", by.y = "Variable", all.x = TRUE, all.y = FALSE)### Convert variables to listVariables.List = as.list(Variables$Value)names(Variables.List) = Variables$Vars### Evaluate equation on listeval(str2lang(CalcEq), envir = Variables.List)}})output$CalcResultInteractive = renderUI(HTML(paste("<b>",CalculateResultInteractive(), sep = "")))}shinyApp(ui = ui, server = server)
此外，如果您尝试运行示例代码，您会发现有些方程式需要查找值。我还想创建一个列来实现查找，但我想先从只有文本字段开始，看看那里得到的帮助是否能指导我正确地完成下一步。
非常感谢您的帮助！
英文:
I have an app where a user selects an equation from a drop down list. The app pulls all the variables that get input into the equation from a table, plugs the variables into the equation, and provides the result. However, I want a user to be able to override any of the values and see how the calculation is affected. The calculation is facilitated using eval and a list of variables, so I suspect what I'm trying to do is change the value of the variable in the environment when a user updates a table value, but I'm open to other ideas! See screenshot and reprex provided below.
I am able to get the text box where a user can input their own values for the variables. (Small victory!) I tried using a proxy table to facilitate the recalculation, but the problem is I haven't found an example where there is a proxy table and a dynamic input field in the table.
Many of the examples I found start with mod_df <- shiny::reactiveValues(x = df) (or something similar). When I try to replicate the code, I get the following error:
You tried to do something that can only be done from inside a reactive consumer.
Reprex:
library(shiny)library(DT)require(stringr)df1 = data.frame("ID" = c(1:3), "Equation" = c("<A> * <B> + <C>", "<A> + <B> + <C>", "<A> - <B> + <C>"))df2 = data.frame("Equation" = c(1, 1, 1, 2, 2, 2, 3, 3, 3),"Variable" = c("A", "B", "C", "A", "B", "C", "A", "B", "C"),"Value" = c(5,3,10,2,4,NA,7,5,NA))df3 = data.frame("Premise" = c("Red", "Yellow", "Green"),"Value" = c(5,4,3))ui <- fluidPage(selectizeInput("df1Select", "Select Equation", choices = df1$Equation, multiple = TRUE, options = list(maxItems = 1)),h3("This is the static table of the variables as defined"),dataTableOutput("StaticTable"),br(),htmlOutput("CalcResultStatic"),h3("Here, I want to be able to manipulate the fields and recalculate the results"),dataTableOutput("InteractiveTable"),br(),htmlOutput("CalcResultInteractive"))server <- function(input, output, session) {### Filter DataStaticTableFiltered = reactive({EqSelect = if(is.null(input$df1Select)) unique(as.vector(df1$ID)) else df1$ID[df1$Equation == input$df1Select]filter(df2, Equation %in% EqSelect)})### Render Static Tableoutput$StaticTable = renderDataTable({if(is.null(input$df1Select)) return(NULL) else {StaticTableFiltered()}},options = list(dom = 't'), selection = "none")### Render Static Result as TextCalculateResultStatic = reactive({if(is.null(input$df1Select)) return(NULL) else {### Define algorithmCalcEq = paste(input$df1Select)### Make list of input variablesVariables = as.data.frame(str_extract_all(input$df1Select, "<(.*?)>"))colnames(Variables)[1] = "Vars"### Remove < > from algorithm and assumptionsCalcEq = gsub("<","",gsub(">","",CalcEq))Variables$Vars = gsub("<","",gsub(">","",Variables$Vars))### Get values from Assumptions tableVariables = merge(Variables, df2[df2$Equation == df1$ID[df1$Equation == input$df1Select],], by.x = "Vars", by.y = "Variable", all.x = TRUE, all.y = FALSE)### Convert variables to listVariables.List = as.list(Variables$Value)names(Variables.List) = Variables$Vars### Evaluate equation on listeval(str2lang(CalcEq), envir = Variables.List)}})output$CalcResultStatic = renderUI(HTML(paste("<b>",CalculateResultStatic(), sep = "")))### Render Interactive Tableoutput$InteractiveTable = renderDataTable({if(is.null(input$df1Select)) return(NULL) else {data = data.frame(StaticTableFiltered(),UserValue = sapply(1:nrow(StaticTableFiltered()), function(i) {sprintf('<input id="text" type="text" class="form-control" value=""/>', i)}))}},selection = "none", escape = FALSE,options =list(preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } '),dom = 't',processing = FALSE))### Render Interactive Result as TextCalculateResultInteractive = reactive({if(is.null(input$df1Select)) return(NULL) else {### Define algorithmCalcEq = paste(input$df1Select)### Make list of input variablesVariables = as.data.frame(str_extract_all(input$df1Select, "<(.*?)>"))colnames(Variables)[1] = "Vars"### Remove < > from algorithm and assumptionsCalcEq = gsub("<","",gsub(">","",CalcEq))Variables$Vars = gsub("<","",gsub(">","",Variables$Vars))### Get values from Assumptions tableVariables = merge(Variables, df2[df2$Equation == df1$ID[df1$Equation == input$df1Select],], by.x = "Vars", by.y = "Variable", all.x = TRUE, all.y = FALSE)### Convert variables to listVariables.List = as.list(Variables$Value)names(Variables.List) = Variables$Vars### Evaluate equation on listeval(str2lang(CalcEq), envir = Variables.List)}})output$CalcResultInteractive = renderUI(HTML(paste("<b>",CalculateResultInteractive(), sep = "")))}shinyApp(ui = ui, server = server)
In addition, if you play with the reprex, you'll see some equations require a value to be looked up. I also wanted to create a column to facilitate the lookup, but I thought let's start with just the text field and see if the help I get there guides me in the right direction to do the next piece myself.
Thanks in advance for any help!
答案1
得分: 1
我建议将方程式存储为数据框列中的实际 R 函数。标签应该是一个单独的列。
使用 selectInput 和 choices 参数选择方程式，其中 choices 是一个命名列表。名称是标签，值是实际函数。它们来自我刚提到的数据框。当选择新方程式时，观察者会使用初始值更新 numericInput。
在 Shiny 中，用户可编辑的数据表格（不仅仅是 DT）很麻烦。我建议为所需的每个变量使用 numericInput。在下面的示例中，我在 UI 中硬编码了三个 numericInput，但如果需要的话，你可以动态创建/销毁或显示/隐藏。这在一定程度上取决于你是否需要任意多个或任意命名的变量，或者是否有一小组可重复使用的变量。
下面的服务器函数在变量名称方面基本上是动态的。
library(tidyverse)library(shiny)eqn_df <- tibble(id = 1:3,label = c("<A> * <B> + <C>", "<A> + <B> + <C>", "<A> - <B> + <C>"),func = list(\(A,B,C) A*B+C,\(A,B,C) A+B+C,\(A,B,C) A-B+C))values_df <- tibble(id = c(1, 1, 1, 2, 2, 2, 3, 3, 3),var = c("A", "B", "C", "A", "B", "C", "A", "B", "C"),value = c(5,3,10,2,4,NA,7,5,NA))ui <- fluidPage(selectInput("eqn", "Select Equation", choices = set_names(eqn_df$id, eqn_df$label)),numericInput("var_A", "Choose A", 0),numericInput("var_B", "Choose B", 0),numericInput("var_C", "Choose C", 0),textOutput("result"))server <- function(input, output, session) {observe({values_df |>filter(id == input$eqn) |>transmute(inputId = paste0("var_", var),value) |>pwalk(updateNumericInput)}) |> bindEvent(input$eqn)output$result <- renderText({req(input$var_A, input$var_B, input$var_C)func <- eqn_df |>filter(id == input$eqn) |>pull(func) |>nth(1)helper <- tibble(id = str_subset(names(input), "var_"),var = str_sub(id, 5))args <- map_int(helper$id, ~input[[.x]]) |>set_names(helper$var) |>as.list()do.call(func, args)})}shinyApp(ui, server)
英文:
I suggest storing the equations as actual R functions in a data frame column. The label should be a separate column.
Equations are chosen using a selectInput with choices given by a named list. The names are the labels and the values are the actual functions. They come from the data frame I just mentioned. When a new equation is chosen, an observer updates the numericInputs with the initial values.
User editable data tables (not just DT) are painful in Shiny. I suggest using numericInputs for each of your needed variables. In the example below I have hard-coded three numericInput in the UI, but you could dynamically create/destroy or show/hide if needed. It partly depends on whether you need arbitrarily many or arbitrarily named variables, or if you have a small set of re-used variables.
The server function below is basically dynamic in terms of variable names.
library(tidyverse)library(shiny)eqn_df <- tibble(id = 1:3,label = c("<A> * <B> + <C>", "<A> + <B> + <C>", "<A> - <B> + <C>"),func = list(\(A,B,C) A*B+C,\(A,B,C) A+B+C,\(A,B,C) A-B+C))values_df <- tibble(id = c(1, 1, 1, 2, 2, 2, 3, 3, 3),var = c("A", "B", "C", "A", "B", "C", "A", "B", "C"),value = c(5,3,10,2,4,NA,7,5,NA))ui <- fluidPage(selectInput("eqn", "Select Equation", choices = set_names(eqn_df$id, eqn_df$label)),numericInput("var_A", "Choose A", 0),numericInput("var_B", "Choose B", 0),numericInput("var_C", "Choose C", 0),textOutput("result"))server <- function(input, output, session) {observe({values_df |>filter(id == input$eqn) |>transmute(inputId = paste0("var_", var),value) |>pwalk(updateNumericInput)}) |> bindEvent(input$eqn)output$result <- renderText({req(input$var_A, input$var_B, input$var_C)func <- eqn_df |>filter(id == input$eqn) |>pull(func) |>nth(1)helper <- tibble(id = str_subset(names(input), "var_"),var = str_sub(id, 5))args <- map_int(helper$id, ~input[[.x]]) |>set_names(helper$var) |>as.list()do.call(func, args)})}shinyApp(ui, server)
答案2
得分: 0
你是否需要将“UserValue”列作为输入？
如果不需要，这是一个快速而简单的方法，可以帮助你开始实现你想要的功能。在不重写太多应用程序的情况下，我将InteractiveTable设置为可编辑。
在下面的示例中，技术上所有单元格都是可编辑的，但你可以将其更改为仅指定“User_Value”列。
双击该列中的单元格后，你可以添加一个新值，该值可以通过input$InteractiveTable_cell_edit检索。然后，你可以使用新值更新表格并进行计算。
这部分代码如下所示：
# Update the DT with the new user entered valueif(!is.null(input$InteractiveTable_cell_edit)) {new_data = input$InteractiveTable_cell_editdf2[new_data$row, new_data$col] = as.integer(new_data$value)}
示例代码如下：
library(shiny)library(DT)library(stringr)library(dplyr)df1 = data.frame("ID" = c(1:3), "Equation" = c("<A> * <B> + <C>", "<A> + <B> + <C>", "<A> - <B> + <C>"))df2 = data.frame("Equation" = c(1, 1, 1, 2, 2, 2, 3, 3, 3),"Variable" = c("A", "B", "C", "A", "B", "C", "A", "B", "C"),"Value" = c(5,3,10,2,4,NA,7,5,NA))df3 = data.frame("Premise" = c("Red", "Yellow", "Green"),"Value" = c(5,4,3))ui <- fluidPage(selectizeInput("df1Select", "Select Equation", choices = df1$Equation, multiple = TRUE, options = list(maxItems = 1)),h3("This is the static table of the variables as defined"),dataTableOutput("StaticTable"),br(),htmlOutput("CalcResultStatic"),h3("Here, I want to be able to manipulate the fields and recalculate the results"),dataTableOutput("InteractiveTable"),br(),htmlOutput("CalcResultInteractive"))server <- function(input, output, session) {### Filter DataStaticTableFiltered = reactive({EqSelect = if(is.null(input$df1Select)) unique(as.vector(df1$ID)) else df1$ID[df1$Equation == input$df1Select]filter(df2, Equation %in% EqSelect)})### Render Static Tableoutput$StaticTable = renderDataTable({if(is.null(input$df1Select)) return(NULL) else {StaticTableFiltered()}},options = list(dom = 't'), selection = "none")### Render Static Result as TextCalculateResultStatic = reactive({if(is.null(input$df1Select)) return(NULL) else {### Define algorithmCalcEq = paste(input$df1Select)### Make list of input variablesVariables = as.data.frame(str_extract_all(input$df1Select, "<(.*?)>"))colnames(Variables)[1] = "Vars"### Remove < > from algorithm and assumptionsCalcEq = gsub("<","",gsub(">","",CalcEq))Variables$Vars = gsub("<","",gsub(">","",Variables$Vars))### Get values from Assumptions tableVariables = merge(Variables, df2[df2$Equation == df1$ID[df1$Equation == input$df1Select],], by.x = "Vars", by.y = "Variable", all.x = TRUE, all.y = FALSE)### Convert variables to listVariables.List = as.list(Variables$Value)names(Variables.List) = Variables$Vars### Evaluate equation on listeval(str2lang(CalcEq), envir = Variables.List)}})output$CalcResultStatic = renderUI(HTML(paste("<b>",CalculateResultStatic(), sep = "")))### Render Interactive Tableoutput$InteractiveTable = renderDataTable({if(is.null(input$df1Select)) return(NULL) else {data = StaticTableFiltered() %>%rename(User_Value = Value)}},selection = "none", escape = FALSE, editable = TRUE, # make dt editableoptions =list(preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } '),dom = 't',processing = FALSE))### Render Interactive Result as TextCalculateResultInteractive = reactive({if(is.null(input$df1Select)) return(NULL) else {### Define algorithmCalcEq = paste(input$df1Select)### Make list of input variablesVariables = as.data.frame(str_extract_all(input$df1Select, "<(.*?)>"))colnames(Variables)[1] = "Vars"### Remove < > from algorithm and assumptionsCalcEq = gsub("<","",gsub(">","",CalcEq))Variables$Vars = gsub("<","",gsub(">","",Variables$Vars))# Update the DT with the new user entered valueif(!is.null(input$InteractiveTable_cell_edit)) {new_data = input$InteractiveTable_cell_editdf2[new_data$row, new_data$col] = as.integer(new_data$value)}### Get values from Assumptions tableVariables = merge(Variables, df2[df2$Equation == df1$ID[df1$Equation == input$df1Select],], by.x = "Vars", by.y = "Variable", all.x = TRUE, all.y = FALSE)### Convert variables to listVariables.List = as.list(Variables$Value)names(Variables.List) = Variables$Vars### Evaluate equation on listeval(str2lang(CalcEq), envir = Variables.List)}})output$CalcResultInteractive = renderUI(HTML(paste("<b>",CalculateResultInteractive(), sep = "")))}shinyApp(ui = ui, server = server)
英文:
Do you require the "UserValue" column to be an input?
If not, here's quick and dirty way to give you a jump start to what you want. Without re-writing too much of the app - I've set the InteractiveTable to be editable.
In the example below, technically all cells are editable but you can change that to only specify the "User_Value" column.
Upon double clicking the cell in that column, you can add a new value which can be retrieved by input$InteractiveTable_cell_edit. Then you can update the table with the new value and perform you calcs.
That portion is performed here:
# Update the DT with the new user entered valueif(!is.null(input$InteractiveTable_cell_edit)) {new_data = input$InteractiveTable_cell_editdf2[new_data$row, new_data$col] = as.integer(new_data$value)}
Ex:
library(shiny)library(DT)library(stringr)library(dplyr)df1 = data.frame("ID" = c(1:3), "Equation" = c("<A> * <B> + <C>", "<A> + <B> + <C>", "<A> - <B> + <C>"))df2 = data.frame("Equation" = c(1, 1, 1, 2, 2, 2, 3, 3, 3),"Variable" = c("A", "B", "C", "A", "B", "C", "A", "B", "C"),"Value" = c(5,3,10,2,4,NA,7,5,NA))df3 = data.frame("Premise" = c("Red", "Yellow", "Green"),"Value" = c(5,4,3))ui <- fluidPage(selectizeInput("df1Select", "Select Equation", choices = df1$Equation, multiple = TRUE, options = list(maxItems = 1)),h3("This is the static table of the variables as defined"),dataTableOutput("StaticTable"),br(),htmlOutput("CalcResultStatic"),h3("Here, I want to be able to manipulate the fields and recalculate the results"),dataTableOutput("InteractiveTable"),br(),htmlOutput("CalcResultInteractive"))server <- function(input, output, session) {### Filter DataStaticTableFiltered = reactive({EqSelect = if(is.null(input$df1Select)) unique(as.vector(df1$ID)) else df1$ID[df1$Equation == input$df1Select]filter(df2, Equation %in% EqSelect)})### Render Static Tableoutput$StaticTable = renderDataTable({if(is.null(input$df1Select)) return(NULL) else {StaticTableFiltered()}},options = list(dom = 't'), selection = "none")### Render Static Result as TextCalculateResultStatic = reactive({if(is.null(input$df1Select)) return(NULL) else {### Define algorithmCalcEq = paste(input$df1Select)### Make list of input variablesVariables = as.data.frame(str_extract_all(input$df1Select, "<(.*?)>"))colnames(Variables)[1] = "Vars"### Remove < > from algorithm and assumptionsCalcEq = gsub("<","",gsub(">","",CalcEq))Variables$Vars = gsub("<","",gsub(">","",Variables$Vars))### Get values from Assumptions tableVariables = merge(Variables, df2[df2$Equation == df1$ID[df1$Equation == input$df1Select],], by.x = "Vars", by.y = "Variable", all.x = TRUE, all.y = FALSE)### Convert variables to listVariables.List = as.list(Variables$Value)names(Variables.List) = Variables$Vars### Evaluate equation on listeval(str2lang(CalcEq), envir = Variables.List)}})output$CalcResultStatic = renderUI(HTML(paste("<b>",CalculateResultStatic(), sep = "")))### Render Interactive Tableoutput$InteractiveTable = renderDataTable({if(is.null(input$df1Select)) return(NULL) else {data = StaticTableFiltered() %>%rename(User_Value = Value)}},selection = "none", escape = FALSE, editable = TRUE, # make dt editableoptions =list(preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } '),dom = 't',processing = FALSE))### Render Interactive Result as TextCalculateResultInteractive = reactive({if(is.null(input$df1Select)) return(NULL) else {### Define algorithmCalcEq = paste(input$df1Select)### Make list of input variablesVariables = as.data.frame(str_extract_all(input$df1Select, "<(.*?)>"))colnames(Variables)[1] = "Vars"### Remove < > from algorithm and assumptionsCalcEq = gsub("<","",gsub(">","",CalcEq))Variables$Vars = gsub("<","",gsub(">","",Variables$Vars))# Update the DT with the new user entered valueif(!is.null(input$InteractiveTable_cell_edit)) {new_data = input$InteractiveTable_cell_editdf2[new_data$row, new_data$col] = as.integer(new_data$value)}### Get values from Assumptions tableVariables = merge(Variables, df2[df2$Equation == df1$ID[df1$Equation == input$df1Select],], by.x = "Vars", by.y = "Variable", all.x = TRUE, all.y = FALSE)### Convert variables to listVariables.List = as.list(Variables$Value)names(Variables.List) = Variables$Vars### Evaluate equation on listeval(str2lang(CalcEq), envir = Variables.List)}})output$CalcResultInteractive = renderUI(HTML(paste("<b>",CalculateResultInteractive(), sep = "")))}shinyApp(ui = ui, server = server)
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论