I am building an app where the user loads an .RData data set (the file can be downloaded from here) and selects variable from a list (DT), moves it to another list (also DT) and then the available factor levels are displayed in a third DT underneath. This third DT also has a column of dynamically generated textInput fields which match the number of available factor levels for the variable where the user can add new values for the existing factor levels. The entered values are stored in a reactiveValues object. For now the object is just printed in the R console. The app looks like this:
library(shiny)
library(DT)
library(data.table)
library(shinyFiles)
ui <- fluidPage(
shinyFilesButton(id = "recodeChooseSrcFile", label = "Choose data file", title = "Navigate and select a file", multiple = FALSE),
fluidRow(
column(width = 6,
DTOutput(outputId = "recodeAllAvailableVars"),
),
column(width = 1, align = "center",
br(), br(), br(), br(), br(), br(), br(), br(), br(), br(),
uiOutput(outputId = "recodeArrowSelVarsRight"),
br(), br(),
uiOutput(outputId = "recodeArrowSelVarsLeft"),
),
column(width = 5,
DTOutput(outputId = "recodeVarsSelection"),
),
br(), br()
),
br(), br(),
DTOutput(outputId = "recodeScheme")
)
server <- function(input, output, session) {
available.volumes <- getVolumes()()
file.var.recode <- reactiveValues(loaded = NULL, var.levels = NULL)
# Select file and extract the variables.
shinyFileChoose(input, "recodeChooseSrcFile", roots = available.volumes, filetype = list(RData = "RData"))
observeEvent(eventExpr = input$recodeChooseSrcFile, {
if(length(parseFilePaths(available.volumes, input$recodeChooseSrcFile)$datapath) > 0) {
file.var.recode$loaded <- get(load(parseFilePaths(available.volumes, input$recodeChooseSrcFile)$datapath))
file.var.recode$var.levels <- Filter(Negate(is.null), lapply(X = file.var.recode$loaded, FUN = function(i) {
if(is.null(attr(x = i, which = "levels"))) {
NULL
} else {
attr(x = i, which = "levels")
}
}))
file.var.recode$loaded <- data.table(Variables = names(file.var.recode$loaded),
order_col = 1:ncol(file.var.recode$loaded))
}
}, ignoreInit = TRUE)
observe({
var.props.initial.available.vars <- data.table(Variables = as.character(), order_col = as.numeric())
var.props.initial.selected.vars <- data.table(Variables = as.character(), order_col = as.numeric())
recodeAllVars <- reactiveValues(recodeAvailVars = var.props.initial.available.vars, recodeSelectedVars = var.props.initial.selected.vars)
# Observe if the file is loaded, and if yes, update the table of available variables.
observe({
if(!is.null(file.var.recode$loaded)) {
recodeAllVars$recodeAvailVars <- file.var.recode$loaded
}
})
# Render the arrow buttons for selecting the variables.
output$recodeArrowSelVarsRight <- renderUI({
if(is.null(file.var.recode$loaded)) {
return(NULL)
} else {
actionButton(inputId = "recodeArrowSelVarsRight", label = NULL, icon("angle-right"), width = "50px")
}
})
output$recodeArrowSelVarsLeft <- renderUI({
if(is.null(file.var.recode$loaded)) {
return(NULL)
} else {
actionButton(inputId = "recodeArrowSelVarsLeft", label = NULL, icon("angle-left"), width = "50px")
}
})
# Render the data table with the available variables.
output$recodeAllAvailableVars <- renderDT({
if(is.null(file.var.recode$loaded)) {
return(NULL)
} else {
setkeyv(x = recodeAllVars$recodeAvailVars, cols = "order_col")
}
},
caption = "Available variables",
rownames = FALSE,
colnames = c("Names", "sortingcol"),
options = list(
ordering = FALSE,
columnDefs = list(list(visible = FALSE, targets = 1))
))
# Render the table with the selected variables.
output$recodeVarsSelection <- renderDT({
if(is.null(file.var.recode$loaded)) {
return(NULL)
} else {
setkeyv(x = recodeAllVars$recodeSelectedVars, cols = "order_col")
}
},
caption = "Available variables",
rownames = FALSE,
colnames = c("Names", "sortingcol"),
options = list(
ordering = FALSE,
columnDefs = list(list(visible = FALSE, targets = 1))
))
# Observe the events of moving variables from available to selected.
observeEvent(input$recodeArrowSelVarsRight, {
req(input$recodeAllAvailableVars_rows_selected)
recodeAllVars$recodeSelectedVars <- rbind(isolate(recodeAllVars$recodeSelectedVars), recodeAllVars$recodeAvailVars[input$recodeAllAvailableVars_rows_selected, , drop = F])
recodeAllVars$recodeSelectedVars <- recodeAllVars$recodeSelectedVars[complete.cases(recodeAllVars$recodeSelectedVars[ , "Variables"]), , drop = FALSE]
recodeAllVars$recodeAvailVars <- isolate(recodeAllVars$recodeAvailVars[-input$recodeAllAvailableVars_rows_selected, , drop = F])
})
observeEvent(input$recodeArrowSelVarsLeft, {
req(input$recodeVarsSelection_rows_selected)
recodeAllVars$recodeAvailVars <- rbind(isolate(recodeAllVars$recodeAvailVars), recodeAllVars$recodeSelectedVars[input$recodeVarsSelection_rows_selected, , drop = F])
recodeAllVars$recodeAvailVars <- recodeAllVars$recodeAvailVars[complete.cases(recodeAllVars$recodeAvailVars[ , "Variables"]), , drop = FALSE]
recodeAllVars$recodeSelectedVars <- isolate(recodeAllVars$recodeSelectedVars[-input$recodeVarsSelection_rows_selected, , drop = F])
})
# Render the table with the text inputs.
initial.recode.new.values <- reactiveValues(values = NULL)
entered.new.values <- reactiveValues(values = NULL)
new.recoding.values <- reactiveValues(values = NULL)
shinyInput <- function(obj) {
tmp <- unlist(lapply(X = seq_along(obj), FUN = function(i) {
i <- paste0(textInput(inputId = paste0("numinp", i), label = NULL, value = NULL, width = "50px"))
}))
return(tmp)
}
shinyValue <- function(id, len) {
unlist(lapply(seq_len(len), function(i) {
input[[paste0(id, i)]]
}))
}
# Observe the changes in user selection and update the reactive values from above.
observe({
initial.recode.new.values$values <- unlist(unique(file.var.recode$var.levels[recodeAllVars$recodeSelectedVars[ , Variables]]))
entered.new.values$values <- data.table(
V1 = initial.recode.new.values$values,
V2 = initial.recode.new.values$values,
V3 = rep(x = "->", times = length(initial.recode.new.values$values)),
V4 = shinyInput(unlist(unique(file.var.recode$var.levels[recodeAllVars$recodeSelectedVars[ , Variables]])))
)
new.recoding.values$values <- shinyValue(id = "numinp", len = length(unlist(unique(file.var.recode$var.levels[recodeAllVars$recodeSelectedVars[ , Variables]]))))
})
# Render the table with available levels and empty input fields where the user can enter his desired new values.
output$recodeScheme <- renderDT({
if(!is.null(unlist(unique(file.var.recode$var.levels[recodeAllVars$recodeSelectedVars[ , Variables]])))) {
entered.new.values$values
} else {
return(NULL)
}
},
rownames = FALSE,
colnames = c("Available variable values", "Old", "->", "New"),
class = "cell-border stripe;compact cell-border;",
selection="none",
escape = FALSE,
options = list(
pageLength = 1500,
dom = 'BRrt',
rowCallback = JS("function(r,d) {$(r).attr('height', '40px')}"),
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')))
observe({
print(new.recoding.values$values)
})
})
}
shinyApp(ui, server)
It all works fine when the variable is selected, the newly entered values are immediately updated and shown in the console on every key stroke. However, if the user decides to remove the variable from the DT of selected ones, the new.recoding.values$values reactive value becomes immediately NULL (as intended), but when another variable is added to the DT of selected variables, the old values for the previous variable are immediately brought back and never get updated. In addition, if the new variable has more levels than the first entered, then the last is possible to update, but not the previous ones (try entering ASBG03, then replace it with ASBG04 to see what I mean).
I don't really understand why is this happening. What I tried so far is to explicitly set the new.recoding.values$values to NULL in:
1.The observer where it is generated, before the shinyValue function is ran.
2.In the observeEvent where the right arrow button is pressed, i.e.:
observeEvent(input$recodeArrowSelVarsLeft, {
req(input$recodeVarsSelection_rows_selected)
recodeAllVars$recodeAvailVars <- rbind(isolate(recodeAllVars$recodeAvailVars),
recodeAllVars$recodeSelectedVars[input$recodeVarsSelection_rows_selected, , drop = F])
recodeAllVars$recodeAvailVars <- recodeAllVars$recodeAvailVars[complete.cases(recodeAllVars$recodeAvailVars[ , "Variables"]), , drop = FALSE]
recodeAllVars$recodeSelectedVars <- isolate(recodeAllVars$recodeSelectedVars[-input$recodeVarsSelection_rows_selected, , drop = F])
new.recoding.values$values <- NULL
})
UPDATE:
3.Following Tonio Liebrand's advice, I tried to update the text inputs as follow (added just after rendering the last DT):
observe({
if(nrow(entered.new.values$values) == 0) {
lapply(seq_len(length(unlist(unique(file.var.recode$var.levels[recodeAllVars$recodeSelectedVars[ , Variables]])))), function(i) {
updateTextInput(session,
input[[paste0("numinp", i)]],
value = NULL,
label = NULL)
})
}
})
None of these helped. Every time I remove the variable selected at first, the new.recoding.values$values is printed as NULL in the console, but then adding another variable new.recoding.values$values suddenly recovers the first values entered first, like it still "remembers" the first input.
I don't really understand this behavior can someone help to overcome this, i.e. really update on variable change?
