[英]R Shiny update textInput fields' in DT on changing variable selection
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.我正在构建一个应用程序,用户在其中加载
.RData
数据集(该文件可以从这里下载)并从列表( DT
)中选择变量,将其移动到另一个列表(也是DT
),然后显示可用的因子水平在下面的第三个DT
。 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.第三个
DT
也有一列动态生成的textInput
字段,这些字段与变量的可用因子级别数相匹配,用户可以在其中为现有因子级别添加新值。 The entered values are stored in a reactiveValues
object.输入的值存储在
reactiveValues
对象中。 For now the object is just printed in the R console.现在该对象只是在 R 控制台中打印。 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.但是,如果用户决定从所选变量的
DT
中删除变量,则new.recoding.values$values
反应值立即变为NULL
(如预期),但是当另一个变量添加到所选变量的DT
时,旧的前一个变量的值会立即带回来并且永远不会更新。 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).此外,如果新变量的级别比第一个输入的级别多,则可以更新最后一个,但不能更新以前的
ASBG03
(尝试输入ASBG03
,然后将其替换为ASBG04
以了解我的意思)。
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:到目前为止,我尝试在以下位置将
new.recoding.values$values
显式设置为NULL
:
1.The observer where it is generated, before the shinyValue
function is ran. 1. 在运行
shinyValue
函数之前生成它的观察者。
2.In the observeEvent
where the right arrow button is pressed, ie: 2.在按下右箭头按钮的
observeEvent
中,即:
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
): 3.Following Tonio Liebrand 的建议,我尝试更新文本输入如下(在渲染最后一个
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.每次我删除最初选择的变量时,
new.recoding.values$values
在控制台中打印为NULL
,但随后添加另一个变量new.recoding.values$values
突然恢复了首先输入的第一个值,就像它仍然“记住”第一个输入。
I don't really understand this behavior can someone help to overcome this, ie really update on variable change?我真的不明白这种行为有人可以帮助克服这个问题,即真的更新变量变化吗?
Because the textFields
are created within the datatable
, you need to unbind before you use the table again ( updateTextInput
doesn't work).因为
textFields
是在datatable
中创建的,所以您需要在再次使用该表之前解除绑定( updateTextInput
不起作用)。 Using the code from this answer, I added the JS script with the unbind function and the function is called in the observer for the left arrow.使用此答案中的代码,我添加了带有 unbind 函数的 JS 脚本,并在观察者中为左箭头调用了该函数。 Then you get a working app:
然后你会得到一个可用的应用程序:
library(shiny)
library(DT)
library(data.table)
library(shinyFiles)
ui <- fluidPage(
tags$head(tags$script(
HTML(
"Shiny.addCustomMessageHandler('unbindDT', function(id) {
var $table = $('#'+id).find('table');
if($table.length > 0){
Shiny.unbindAll($table.DataTable().table().node());
}
})")
)),
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])
session$sendCustomMessage("unbindDT", "recodeScheme")
})
# 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)
However, I recommend you to read more about reactivity, eg here .但是,我建议您阅读有关反应性的更多信息,例如这里。 You use a lot of observers, and you nest them.
你使用了很多观察者,然后嵌套它们。 I don't recommend that, because this can lead to strange behaviour.
我不建议这样做,因为这会导致奇怪的行为。 Also, try to use more
reactive
/ reactiveExpression
, because observe
/ observeEvent
can make your app slower.另外,尝试使用更多的
reactive
/ reactiveExpression
,因为observe
/ observeEvent
会使您的应用程序变慢。 Before I found the correct solution, I tried to unnest your code a bit, and it still works!在找到正确的解决方案之前,我尝试将您的代码解开一点,但它仍然有效! That shows that you had complexity in your app you actually don't need:
这表明您的应用程序实际上并不需要复杂性:
library(shiny)
library(DT)
library(data.table)
library(shinyFiles)
# additional functions
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, input) {
unlist(lapply(seq_len(len), function(i) {
input[[paste0(id, i)]]
}))
}
ui <- fluidPage(
tags$head(tags$script(
HTML(
"Shiny.addCustomMessageHandler('unbindDT', function(id) {
var $table = $('#'+id).find('table');
if($table.length > 0){
Shiny.unbindAll($table.DataTable().table().node());
}
})")
)),
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)
# define variables
# 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)
# 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)
recodeAllVars <- reactiveValues(recodeAvailVars = data.table(Variables = as.character(), order_col = as.numeric()),
recodeSelectedVars = data.table(Variables = as.character(), order_col = as.numeric()))
# 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])
session$sendCustomMessage("unbindDT", "recodeScheme")
})
# 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]]))),
input = input)
})
# 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)
})
# end of server
}
shinyApp(ui, server)
There is still some room for improvement, eg you could try to use a reactive
instead of observe
for the following snippet:还有一些改进的空间,例如,您可以尝试使用
reactive
而不是observe
以下代码段:
# 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
}
})
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.