Hello everyone,
I am trying to build a R shiny app, with which users can select variable-domain combinations and manually adjust the value (variables are not unique, domains are not unique, but variable-domain combinations are unique). Everything works as intended apart from the fact that I seem to be unable to select a variable that is not unique.
I did check out the following links:
Link 1: But I believe, that I don't have the problem of not being able to update input, because as I change from variable a to c, the domain input choice is updated.
Link 2: But I believe, that I don't have the problem of changes not being saved as I add a position.
Link 3: I took some code from here...
Reproducible code:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = ""),
dashboardSidebar(sidebarMenu(
menuItem("Input", tabName = "input")
)),
dashboardBody(
tabItems(
tabItem(tabName = "input",
box(title = "Define values for positions", width = 12,
uiOutput("add_var"),
tags$p(actionButton("add_btn", "Add position"),
actionButton("rm_btn", "Remove position")
)
)
)
)
)
)
##################server
server <- function(input, output, session) {
data <- data.frame(variable = c("a", "b", "b", "c", "d", "d", "d"),
domain = c("x", "y", "z", "z", "x", "y", "z"),
value = c("text1", "text2", "text3", "text4", "text5", "text6", "text7"))
# Track the number of input boxes to render
counter <- reactiveValues(n = 0)
# Track all user inputs
AllInputs <- reactive({
x <- reactiveValuesToList(input)
})
observeEvent(input$add_btn, {counter$n <- counter$n + 1})
observeEvent(input$rm_btn, {
if (counter$n > 0) counter$n <- counter$n - 1
})
input_pos <- reactive({
n <- counter$n
if (n > 0) {
lapply(seq_len(n), function(i) {
fluidRow(column(3,
selectInput(inputId = paste0("var_name", i),
label = "Select variable",
choices = data$variable,
selected = AllInputs()[[paste0("var_name", i)]])
),
column(3,
selectInput(inputId = paste0("dom_name", i),
label = "Select domain",
choices = data[data$variable==input[[paste0("var_name", i)]],"domain"],
selected = AllInputs()[[paste0("dom_name", i)]])
),
column(3, textInput(inputId = paste0("change", i),
label = "Enter value",
value = AllInputs()[[paste0("change", i)]])
)
)
})
}
})
output$add_var <- renderUI({ input_pos() })
}
shinyApp(ui, server)
Any help is much appreciated!
Thanks
################################################
Update: Now I tried to define the three inputs seperately and I can now select variables with multiple domains. However, my selection of variables and domains only gets saved when the variable has only one domain. If it has multiple domains and I press the add button, the selected inputs get reset, but the entered value remains.
Reproducible example:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = ""),
dashboardSidebar(sidebarMenu(
menuItem("Input", tabName = "input")
)),
dashboardBody(
tabItems(
tabItem(tabName = "input",
box(title = "Define values for positions", width = 12,
fluidRow(column(3, uiOutput("pos_select")), column(3, uiOutput("dom_select")), column(2, uiOutput("change_select"))),
tags$p(actionButton("add_btn", "Add position"),
actionButton("rm_btn", "Remove position")
)
)
)
)
)
)
##################server
server <- function(input, output, session) {
data <- data.frame(variable = c("a", "b", "b", "c", "d", "d", "d"),
domain = c("x", "y", "z", "z", "x", "y", "z"),
value = c("text1", "text2", "text3", "text4", "text5", "text6", "text7"))
# Track the number of input boxes to render
counter <- reactiveValues(n = 0)
# Track all user inputs
AllInputs <- reactive({
x <- reactiveValuesToList(input)
})
observeEvent(input$add_btn, {counter$n <- counter$n + 1})
observeEvent(input$rm_btn, {
if (counter$n > 0) counter$n <- counter$n - 1
})
input_pos <- reactive({
n <- counter$n
if (n > 0) {
isolate({
lapply(seq_len(n), function(i) {
selectInput(inputId = paste0("var_name", i),
label = "Select variable",
choices = data$variable,
selected = AllInputs()[[paste0("var_name", i)]])
})
})
}
})
input_dom <- reactive({
n <- counter$n
if (n > 0) {
lapply(seq_len(n), function(i) {
selectInput(inputId = paste0("dom_name", i),
label = "Select domain",
choices = data[data$variable==input[[paste0("var_name", i)]],"domain"],
selected = AllInputs()[[paste0("dom_name", i)]])
})
}
})
input_change <- reactive({
n <- counter$n
if (n > 0) {
lapply(seq_len(n), function(i) {
textInput(inputId = paste0("change", i),
label = "Enter value",
value = AllInputs()[[paste0("change", i)]])
})
}
})
output$pos_select <- renderUI({ input_pos() })
output$dom_select <- renderUI({ input_dom() })
output$change_select <- renderUI({ input_change() })
}
shinyApp(ui, server)
####################################################
Update 2: I was able to solve it! I am providing the trivial solution in case someone will have the same problem in the future. I had to wrap the choices of the variable input into unique(). Then, the domains will be unique automatically in my case and everything works out!
selectInput(inputId = paste0("var_name", i),
label = "Select variable",
choices = unique(data$variable),
selected = AllInputs()[[paste0("var_name", i)]])