How do I update an eval() calculation based on user inputs into a data table in R Shiny?

Question

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 Data
  StaticTableFiltered = 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 Table
  output$StaticTable = renderDataTable({
    if(is.null(input$df1Select)) return(NULL) else {StaticTableFiltered()}},
    options = list(dom = 't'), selection = "none")
  
  ### Render Static Result as Text
  CalculateResultStatic = reactive({
    if(is.null(input$df1Select)) return(NULL) else {
      ### Define algorithm
      CalcEq = paste(input$df1Select)
      ### Make list of input variables
      Variables = as.data.frame(str_extract_all(input$df1Select, "<(.*?)>"))
      colnames(Variables)[1] = "Vars"
      ### Remove < > from algorithm and assumptions
      CalcEq = gsub("<","",gsub(">","",CalcEq))
      Variables$Vars = gsub("<","",gsub(">","",Variables$Vars))
      ### Get values from Assumptions table
      Variables = 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 list
      Variables.List = as.list(Variables$Value)
      names(Variables.List) = Variables$Vars
      ### Evaluate equation on list
      eval(str2lang(CalcEq), envir = Variables.List)}})
  
  output$CalcResultStatic = renderUI(HTML(paste("<b>",CalculateResultStatic(), sep = "")))
  
  
  ### Render Interactive Table
  output$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 Text
  CalculateResultInteractive = reactive({
    if(is.null(input$df1Select)) return(NULL) else {
      ### Define algorithm
      CalcEq = paste(input$df1Select)
      ### Make list of input variables
      Variables = as.data.frame(str_extract_all(input$df1Select, "<(.*?)>"))
      colnames(Variables)[1] = "Vars"
      ### Remove < > from algorithm and assumptions
      CalcEq = gsub("<","",gsub(">","",CalcEq))
      Variables$Vars = gsub("<","",gsub(">","",Variables$Vars))
      ### Get values from Assumptions table
      Variables = 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 list
      Variables.List = as.list(Variables$Value)
      names(Variables.List) = Variables$Vars
      ### Evaluate equation on list
      eval(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!

Rather than using string substitutions and evaluations, you could add a column to `df1` that contains actual R functions and then use `do.call` with a list of arguments, coming from the original data.frame and/or the user's values. — Michael Dewar, Aug 09 '23 at 00:45
@MichaelDewar That sounds interesting... what would that look like? — SIE_Vict0ria, Aug 09 '23 at 11:03

score 1 · Answer 1 · answered Aug 10 '23 at 06:17

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)

Thanks Michael. I ran this and it works and looks nice. The problem is I have more than 8,000 equations sitting in a database. I tried making a column in the dB to define the functions and wrote them in as you have them here, but I am unable to turn text from a database column into a list of functions. If I were able to do that though, it would still require me to manually write more than 8,000 functions into my dB, so not ideal for me in this application unfortunately. Unless you have any thoughts on how I could more easily tackle the functions list! — SIE_Vict0ria, Aug 10 '23 at 13:57
I understand. There are [some SO answers](https://stackoverflow.com/questions/12982528/how-to-create-an-r-function-programmatically) about converting text to a function. Perhaps by parsing the text into functions in advance, your Shiny users won't have to wait so long for the parsing on the fly. Also, it's the only way to verify that all 8000 equations are parseable. — Michael Dewar, Aug 10 '23 at 15:13
Separately, I reiterate my suggestion to not use an editable table. Dynamically create/modify/show the `selectInput`s based on the variables appearing in the user's selected equation. — Michael Dewar, Aug 10 '23 at 15:19

score 0 · Answer 2 · answered Aug 09 '23 at 00:24

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 value
if(!is.null(input$InteractiveTable_cell_edit)) {
   new_data = input$InteractiveTable_cell_edit
   df2[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 Data
  StaticTableFiltered = 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 Table
  output$StaticTable = renderDataTable({
    if(is.null(input$df1Select)) return(NULL) else {StaticTableFiltered()}},
    options = list(dom = 't'), selection = "none")

  ### Render Static Result as Text
  CalculateResultStatic = reactive({
    if(is.null(input$df1Select)) return(NULL) else {
      ### Define algorithm
      CalcEq = paste(input$df1Select)
      ### Make list of input variables
      Variables = as.data.frame(str_extract_all(input$df1Select, "<(.*?)>"))
      colnames(Variables)[1] = "Vars"
      ### Remove < > from algorithm and assumptions
      CalcEq = gsub("<","",gsub(">","",CalcEq))
      Variables$Vars = gsub("<","",gsub(">","",Variables$Vars))
      ### Get values from Assumptions table
      Variables = 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 list
      Variables.List = as.list(Variables$Value)
      names(Variables.List) = Variables$Vars
      ### Evaluate equation on list
      eval(str2lang(CalcEq), envir = Variables.List)}})

  output$CalcResultStatic = renderUI(HTML(paste("<b>",CalculateResultStatic(), sep = "")))


  ### Render Interactive Table
  output$InteractiveTable = renderDataTable({
    if(is.null(input$df1Select)) return(NULL) else {
      data = StaticTableFiltered() %>%
        rename(User_Value = Value)
    }
  },
    selection = "none", escape = FALSE, editable = TRUE, # make dt editable
    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 Text
  CalculateResultInteractive = reactive({
  
    if(is.null(input$df1Select)) return(NULL) else {
      ### Define algorithm
      CalcEq = paste(input$df1Select)
      ### Make list of input variables
      Variables = as.data.frame(str_extract_all(input$df1Select, "<(.*?)>"))
      colnames(Variables)[1] = "Vars"
      ### Remove < > from algorithm and assumptions
      CalcEq = gsub("<","",gsub(">","",CalcEq))
      Variables$Vars = gsub("<","",gsub(">","",Variables$Vars))
      
      # Update the DT with the new user entered value
      if(!is.null(input$InteractiveTable_cell_edit)) {
        new_data = input$InteractiveTable_cell_edit
        df2[new_data$row, new_data$col] = as.integer(new_data$value)
      }
      
      ### Get values from Assumptions table
      Variables = 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 list
      Variables.List = as.list(Variables$Value)
      names(Variables.List) = Variables$Vars
      ### Evaluate equation on list
      eval(str2lang(CalcEq), envir = Variables.List)}})

  output$CalcResultInteractive = renderUI(HTML(paste("<b>",CalculateResultInteractive(), sep = "")))
}

shinyApp(ui = ui, server = server)

Thanks Jamie. This is pretty cool. It's not my preferred method for a few reasons... 1. It's not obvious to a user that the column takes an input since you have to double click on the field... you'd have to know that functionality is available. 2. In the actual app (not the reprex), whether or not the cell allows input is conditional based on a previous column's value. Do you know if there's a way to make that happen in this method? — SIE_Vict0ria, Aug 09 '23 at 11:10
For point 1. Understandable - I agree it's not obvious. However maybe you could add an info box or description explaining that functionality. For point 2, can you give an example of what you mean? — Jamie, Aug 09 '23 at 19:55
In my actual code, the field UserValue is actually defined as `UserValue = ifelse(StaticTableFiltered()$someothercolumn == TRUE, sapply(1:nrow(StaticTableFiltered()), function(i) {sprintf('', i)}),NA),`, so, essentially text inputs are only rendered on certain rows. — SIE_Vict0ria, Aug 10 '23 at 14:01
Additionally, when I played with this method, it seems that the table keeps rendering after every change. So if you edited 1 value, then another, the first value would revert back in the underlying table where the math happens but the UI is showing the overwritten value. — SIE_Vict0ria, Aug 10 '23 at 14:03

How do I update an eval() calculation based on user inputs into a data table in R Shiny?

2 Answers2