Updating single cells in a DataTable via action Button in a Shiny App

Question

In my Shiny App the user uploads data (dataframe FileUpload). After selection of one row the user can modify Min an Max values. Then pressing the action button (SetNewValues) the parameter value in the selected row should be replaced by a calcualted value (Max - Min). I see the updated table in the console but not in the rendered table.

########## Shiny
library(shiny)

########## Data wrangling
library(dplyr)
library(tidyr)

########## Tables and graphs
library(DT)

##############################
########## Data
##############################
########## Reference values
ReferenceValues <- tibble("Parameter" = LETTERS[1:10],
                          "ExpectedValue" = 5,
                          "MinValue" = 0,
                          "MaxValue" = 10)

########## Simulate file upload
FileUpload <- tibble("Parameter" = LETTERS[1:10],
                     "ObservedValue" = sample(c(1:10), 10))

########## Save file in temporary folder for upload
TempPath <- paste0(tempdir(), "/FileUpload.csv")
write.table(x = FileUpload, file = TempPath)

##############################
########## Server
##############################
server <- function(input, output, session){

  ##############################
  ########## Display uploaded sheet
  ##############################
  Sheet <- reactive({

    validate(
      need(!is.null(input$uploadedfile) == TRUE, 'Please upload file')
    )

    ##############################
    ########## Check if file is uploaded and supress error if not
    ##############################
    req(input$uploadedfile)

    tryCatch(
      {

        ########## Read sheetnames
        Sheet <- read.table(input$uploadedfile$datapath)

      },
      error = function(e) {

        ########## return a safeError if a parsing error occurs
        stop(safeError(e))
      }
    )

    return(Sheet)

  })

  ##############################
  ########## Render Table
  ##############################
  output$ReactiveTable <- renderDT(server = FALSE,{

    DisplayTable <- Sheet()

    ##############################
    ########## Update Values on button
    ##############################
    observeEvent(input$SetNewValues, {

      isolate({

        DisplayTable$ObservedValue[DisplayTable$Parameter == ValuesSelectedParameter()[["SelectedParameter"]]] <- input$MaxParameterValue - input$MinParameterValue

      })

      print(DisplayTable)

    })    

    datatable(DisplayTable, rownames = FALSE)


  })

  ##############################
  ########## SelectedParameter
  ##############################
  ValuesSelectedParameter <- reactive({

    ########## Selected row  
    SelectedRow <- input$ReactiveTable_rows_selected

    ########## Extract values for one selected row
    if (length(SelectedRow) == 1){

      SelectedParameter <- Sheet() %>% slice(SelectedRow) %>% pull(Parameter)

      SelectedParameterValue <- Sheet() %>% slice(SelectedRow) %>% pull(ObservedValue)
      SelectedParameterValueMin <- ReferenceValues %>% slice(SelectedRow) %>% pull(MinValue)
      SelectedParameterValueMax <- ReferenceValues %>% slice(SelectedRow) %>% pull(MaxValue)

    }else{

      SelectedParameter <- ""
      SelectedParameterValue <- NA
      SelectedParameterValueMin <- NA
      SelectedParameterValueMax <- NA

    }

    return(list("SelectedParameter" = SelectedParameter,
                "SelectedParameterValue" = SelectedParameterValue,
                "SelectedParameterValueMin" = SelectedParameterValueMin,
                "SelectedParameterValueMax" = SelectedParameterValueMax))
  })

  ##############################
  ########## Render Ui elements for min and max values 
  ##############################
  output$MinParameterValue <- renderUI({  

    numericInput(inputId = 'MinParameterValue', 
                 label = paste0("Set minimum Value for ", ValuesSelectedParameter()[["SelectedParameter"]]), 
                 value = ValuesSelectedParameter()[["SelectedParameterValueMin"]], 
                 min = 0,  
                 max = 10)

  })

  output$MaxParameterValue <- renderUI({  

    numericInput(inputId = 'MaxParameterValue', 
                 label = paste0("Set maximum Value for ", ValuesSelectedParameter()[["SelectedParameter"]]), 
                 value = ValuesSelectedParameter()[["SelectedParameterValueMax"]], 
                 min = 0,  
                 max = 10)

  })

}

##############################
########## UI
##############################
ui <- fluidPage(
  titlePanel("Test File"),
  mainPanel(fluidRow(
    column(width = 2,
           ########## Upload file
           fileInput("uploadedfile", "Choose Excel File", multiple = FALSE)
    ),
    column(width = 7,
           h3("Reactive Table"),
           dataTableOutput("ReactiveTable")
    ),
    column(width = 3,
           h3("Parameter Input"),
           uiOutput("MinParameterValue"),
           uiOutput("MaxParameterValue"),
           actionButton(inputId = "SetNewValues", "Set New Values")
    )
  )
  )
)

shinyApp(ui = ui, server = server)

How can the updated values be displayed in the table?

Rodrigo Orellana Rodrigo Orellana · Accepted Answer · 2019-07-29T16:58:57

An approximate solution:

Define input$newvalues

Then,

#SERVER

# Suppose you're storing your base data frame in input$df and showing 
# your base data frame using output$df, then just redefine the output 
# using an observer.

df<-reactiveValues(NULL)
df[[1]]<-input$df ### Store your base data frame

ObserveEvent(input$newvalues,{
output$df<-renderTable({
# a) Code lines replacing newvalues into your base data frame (use df[[1]] 
# and input$newvalues)
# b) Sentence the new data frame
})
})

# UI

outputTable("output$df")

Just complete a) and b).

Updating single cells in a DataTable via action Button in a Shiny App

1 Answers