Silviculturalist
Reputation: 199
Shiny: Reactive Value to DT:datatable
I'm creating a shiny app where my users can recode variables (kind of) manually. Currently, there are two major issues:
DT::datatable does not like when I pass the intended output to get rendered after the user has pressed 'Execute Recode'. A reactive value v$data stores an output table to be passed between tabPanels. As this is passed to DT::datatable(), v$data causes the error
'data' must be 2-dimensional (e.g. data frame or matrix).I'm fairly sure something may be going wrong when I'm parsing the text inputs to the recoding: i.e. paste0(paste0('input$','recode_call_when',i))
SERVER
shinyServer(function(input, output, session){
v <- reactiveValues(data=NULL)
d <- reactiveValues(print_execute_complete=FALSE)
myData <-reactive({
if(is.null(input$file1)) return(mtcars)
as.data.frame(data.table::rbindlist(lapply(X=input$file1$datapath, FUN=read.csv,
quote=input$quote, sep=input$sep, header=input$header, dec=input$decimal),
use.names = TRUE,fill=TRUE
))
})
output$contents <-
DT::renderDataTable({
return(DT::datatable(myData(), filter='top'))
})
#Count the number of recoding terms to render
counter <- reactiveValues(n = 1)
#Recoding button functionality
observeEvent(input$add_recode, {counter$n <- counter$n + 1})
observeEvent(input$rm_recode, {
if(counter$n > 0) counter$n <- counter$n - 1
})
recoding_i <- reactive({
n <- counter$n
if(n>0){
isolate({
lapply(seq_len(n),function(i){
fluidRow(
column(width=4,
textInput(inputId = paste0('recode_call_variable',i),
label=paste0('Variable_',i))),
column(width=4,
textInput(inputId = paste0('recode_call_when',i),
label=paste0('When_', i))),
column(width=4,
textInput(inputId= paste0('recode_call_then',i),
label=paste0('Then_', i)))
)
}
)
})
}
})
output$recoding <- renderUI({ recoding_i() })
#Observes press of recode button.
observeEvent(input$'execute_recode',{
d$print_execute_complete <- TRUE
})
#Observes press of recode button.
observeEvent(input$'reset_recode',{
d$print_execute_complete <- FALSE
})
#Loop over recoding input boxes.
v$data <- reactive({
if(d$print_execute_complete == TRUE){
if(is.null(v$data)){
lapply(seq_len(n), function(i){
myData() %>% mutate(paste0(paste0('input$','recode_call_variable',i), '=', 'case_when(',paste0('input$','recode_call_when',i), '~', paste0('input$','recode_call_then',i),")"))
})
} else {
lapply(seq_len(n), function(i){
v$data %>% mutate(paste0(paste0('input$','recode_call_variable',i), '=', 'case_when(',paste0('input$','recode_call_when',i), '~', paste0('input$','recode_call_then',i),")"))
})
}
}
})
#Confirmation text
output$execute_complete <- renderText({
req(d$print_execute_complete)
if(d$print_execute_complete == TRUE){
"Recoding Complete."
}
})
#Render recoded data table
output$recoded_dt <- DT::renderDataTable({
req(d$print_execute_complete == TRUE)
if(!is.null(v$data)){
return(DT::datatable(v$data, filter='top'))
} else {
return(DT::datatable(myData(),filter='top'))
}
})
})
UI
shinyUI(fluidPage(
titlePanel("Something's Wrong"),
# Input: Select a file ----
navlistPanel(
tabPanel("Import",
fileInput("file1", "Choose CSV File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
# Horizontal line ----
tags$hr(),
# Input: Checkbox if file has header ----
checkboxInput("header", "Header", TRUE),
# Input: Select separator ----
radioButtons("sep", "Separator",
choices = c(Comma = ",",
Semicolon = ";",
Tab = "\t"),
selected = "\t"),
# Input: Select quotes ----
radioButtons("quote", "Quote",
choices = c(None = "",
"Double Quote" = '"',
"Single Quote" = "'"),
selected = '"'),
# Input: Select decimal ----
radioButtons("decimal","Decimal",
choices = c(Comma = ",",
Dot = "."),
selected=","),
# Horizontal line ----
tags$hr(),
# Main panel for displaying outputs ----
# Output: Data file ----
DT::dataTableOutput("contents")
),
tabPanel("Recoding",
h3("Instruction"),
fluidRow(p("Write a functional call in one of the action boxes below. A call takes the form of one of the following :"
,style="font-family: 'times'; font-si16pt"),
span(em("Old Variable == Value"),strong(" e.g. gear == 4")),
br(),
span(em("Old Variable > Value"),strong("e.g. gear > 4")),
br(),
span(em("Old Variable >= Value"), strong("e.g. gear >= 4")),
br(),
span(em("Old Variable != Value"),strong("e.g. gear != 4, 'is not equal to'")),
br(),
br(),
p("A variable can be inside a span:"),
br(),
span(em("Old Variable > Value & Old Variable < Value2"), strong("e.g. gear > 2 & gear <=4")),
br(),
br(),
p("A variable can be defined if it is one or the other:"),
br(),
span(em("Old Variable < Value | Old Variable == Value2"),strong("e.g. gear <= 2 | gear == 4")),
br(),
br()
),
fluidRow(actionButton('add_recode', 'Add recode term'),
actionButton('rm_recode', 'Remove recode term')),
br(),
br(),
uiOutput('recoding'),
br(),
br(),
fluidRow(actionButton('execute_recode', "Recode",icon = icon('angle-double-right')),
actionButton('reset_recode', "Reset", icon=icon('angle-double-right'))),
textOutput('execute_complete'),
br(),
br(),
br(),
DT::dataTableOutput('recoded_dt')
)
)
)
)
Upvotes: 0
Views: 998
Answers (1)
Silviculturalist
Reputation: 199
Here's how I solved it! Note: There are several v$data.. which I would like to use in order, depending on what my user has already done.
#Count the number of recoding terms to render
counter <- reactiveValues(n = 0)
#Recoding button functionality
observeEvent(input$add_recode, {counter$n <- counter$n + 1})
observeEvent(input$rm_recode, {
if(counter$n > 0) counter$n <- counter$n - 1
})
recoding_i <- reactive({
n <- counter$n
if(n>0){
isolate({
lapply(seq_len(n),function(i){
fluidRow(
column(width=4,
textInput(inputId=paste0('recode_name',i),
label=paste0("Variable Name",i))),
column(width=4,
textInput(inputId = paste0('recode_call',i),
label=paste0('Code',i)))
)
}
)
})
}
})
output$recoding <- renderUI({ recoding_i() })
#Observes press of recode button.
observeEvent(input$'execute_recode',{
v[["print_execute_complete"]] <- TRUE
})
#Observes press of recode button.
observeEvent(input$'reset_recode',{
v[["print_execute_complete"]] <- FALSE
})
#Loop over recoding input boxes.
observeEvent(v$print_execute_complete, {
if(v[["print_execute_complete"]] == TRUE){
n <- counter$n
if(n==0){
if(is.null(v$datafiltered)){
v$datarecoded <- myData()
} else {
v$datarecoded <- v$datafiltered
}
} else {
if(is.null(v$datafiltered)){
v$datarecoded <- myData()
} else {
v$datarecoded <- v$datafiltered
lapply(seq_len(n), function(i){
recode_call_i <- rlang::parse_expr(rlang::eval_tidy(rlang::parse_expr(eval(paste0("input$recode_call",i)))))
var_name_i <- rlang::sym(rlang::eval_tidy(rlang::parse_expr(paste0("input$recode_name",i))))
v$datarecoded <- mutate(v$datarecoded,!!var_name_i := !!recode_call_i)
}
)
}
}
}
}
)
#Confirmation text
output$execute_complete <- renderText({
req(v[["print_execute_complete"]])
if(v[["print_execute_complete"]] == TRUE){
"Recoding Complete."
}
})
#Render recoded data table
output$recoded_dt <- DT::renderDataTable({
req(v[["print_execute_complete"]] == TRUE)
if(!is.null(v[["datarecoded"]])){
return(DT::datatable(v[["datarecoded"]], filter='top'))
} else if(v[["print_filter_complete"]] == TRUE & !is.null(v[["datafiltered"]])) {
return(DT::datatable(v[["datafiltered"]], filter='top'))
} else {
DT::datatable(myData(),filter='top')
}
})
Upvotes: 0
Related Questions
- R Shiny DT - edit values in table with reactive
- DT: Dynamically change column values based on selectinput from another column in R shiny app
- Shiny + DT: how to make datatable reactive?
- DT::datatable display
- Update a dataset after putting a new value in the dt::datatable
- capture output of editable datatable in R shiny app to be used in another table
- How to render Datatable using DT in R shiny
- reactive to data.frame in shiny + DT
- Update shiny input based on datatable settings
- r shiny - apply function to reactive data table