I am new to shiny apps/R and would require your help to address my below scenario.
ui <- fluidPage(
selectInput(inputId = "para1",label = "parameter1", choices = c("var1","Var2")),
selectInput(inputId = "para2",label = "parameter2", choices = c("cars","trucks"))
)
server <- function(input,output,session){
output$text <- renderText("control parameters")
}
shinyApp(ui,server)
my requirement is to show/hide "parameter2" based on selecting the "parameter1" values.
Let's say if I select parameter1=="var1", then show "parameter2" otherwise hide entire "parameter2".
You could use shinyjs::toggle combined with uiOutput:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
selectInput(inputId = "para1",label = "parameter1", choices = c("var1","var2")),
uiOutput("selectPara2")
)
server <- function(input,output,session){
output$selectPara2 <- renderUI(selectInput(inputId = "para2",label = "parameter2", choices = c("cars","trucks")))
shiny::observeEvent(input$para1, {
shinyjs::toggle("selectPara2", condition = input$para1 == "var1")
})
}
shinyApp(ui,server)
note that useShinyjs() needs to be called in the UI for this to work.
Related
I've created a SelectizeInput() UI using the insertUI() function. Essentially, I have an action button which adds a SelectizeInput() every time it's clicked. The idea is that the user selects columns from their data to put into groups. The creation of the UI works fine. I can also see in the Shiny trace that the selection works fine. However, I'm unsure how to access these variables to use in later plots. This is the code I have:
UI:
actionButton("cr_exp", "Create new biological group")
Server:
observeEvent(input$cr_exp, {
insertUI(
selector = "#cr_exp",
where = "afterEnd",
ui = selectizeInput(inputId = paste0("grp", input$cr_exp), label = "Select samples", choices = colnames(exp_dff()), options = list(create=TRUE), multiple=TRUE))
tags$div(id = paste0("grp", input$cr_exp))
})
In the shiny trace, it shows that the group is created, but I can't figure out how to access the value:
RECV {"method":"update","data":{"grp1":["MV4negControl01","MV4negControl02"]}}
You access the values just like any other input values: by the input element’s
id from the input reactive values:
library(shiny)
ui <- fluidPage(
actionButton("cr_exp", "Create new biological group"),
verbatimTextOutput("choices")
)
server <- function(input, output, session) {
observeEvent(input$cr_exp, {
insertUI(
selector = "#cr_exp",
where = "afterEnd",
ui = selectizeInput(
inputId = paste0("grp", input$cr_exp),
label = "Select samples",
choices = LETTERS,
options = list(create = TRUE),
multiple = TRUE
)
)
tags$div(id = paste0("grp", input$cr_exp))
})
output$choices <- renderPrint({
lapply(seq_len(input$cr_exp), function(i) input[[paste0("grp", i)]])
})
}
shinyApp(ui, server)
Consider the following example application:
library(shiny)
library(shinyWidgets)
module_UI <- function(id){
tagList(
div(
uiOutput(
outputId = NS(id, "selection")
),
shinyWidgets::dropdown(
uiOutput(outputId = NS(id, "new_option")),
style = "unite",
label = "New",
color = "primary",
animate = animateOptions(
enter = animations$fading_entrances$fadeInLeftBig,
exit = animations$fading_exits$fadeOutRightBig
),
up = F,
width = "600px",
inline = T
)
)
)
}
module_server <- function(id){
moduleServer(id, function(input, output, session){
ns <- session$ns
return_values <- reactiveValues(selection=NULL)
output$selection <- renderUI({
selectInput(inputId = ns("selection"), label = "Select:", choices = 1:5)
})
output$new_option <- renderUI({
div(
numericInput(ns("new_option_input"), label = "Add a new option:"),
shinyWidgets::actionBttn(
inputId = ns("submit_new_option"),
label = "Submit",
icon = icon("paper-plane"))
)
})
observeEvent(input$submit_new_option, {
#does not work as intended
updateSelectInput(session = session, inputId = "selection", selected = input$new_option_input)
})
observe({
return_values$selection <- input$selection
})
return(return_values)
})
}
# Define UI for application that draws a histogram
ui <- fluidPage(
title = "Test App",
module_UI("test"),
verbatimTextOutput(outputId = "selection_chosen")
)
# Define server logic required to draw a histogram
server <- function(input, output) {
picker <- module_server("test")
output$selection_chosen <- renderText({
picker$selection
})
}
# Run the application
shinyApp(ui = ui, server = server)
Basically, the module should do two things:
Allow user to select a pre-existing option --> return that value from module
Allow user to create their own, new option --> return that value from module
I have #1 working, but am struggling on #2. Specifically, where I have the "does not work" comment. How can I achieve this functionality? What are/is the best practice(s) for returning server-side created values from a Shiny module? This is an example app; the real one involves reading the selectInput options from a database, as well as saving the newly created options in the database. Appreciate any help on this! A lot of SO answers regarding Shiny modules have the older callModule(...) syntax, which makes researching this topic a bit more confusing.
You just need to provide the default value in numericInput. Perhaps you are looking for this.
library(shiny)
library(shinyWidgets)
module_UI <- function(id){
ns <- NS(id)
tagList(
div(
uiOutput(
outputId = NS(id, "selection")
),
shinyWidgets::dropdown(
uiOutput(outputId = NS(id, "new_option")),
style = "unite",
label = "New",
color = "primary",
animate = animateOptions(
enter = animations$fading_entrances$fadeInLeftBig,
exit = animations$fading_exits$fadeOutRightBig
),
up = F,
width = "600px",
inline = T
),
DTOutput(ns("t1"))
)
)
}
module_server <- function(id){
moduleServer(id, function(input, output, session){
ns <- session$ns
return_values <- reactiveValues(selection=NULL,myiris = iris)
output$selection <- renderUI({
selectInput(inputId = ns("selection"), label = "Select:", choices = 1:5)
})
output$new_option <- renderUI({
tagList(
numericInput(ns("new_option_input"), label = "Add a new option:",10, min = 1, max = 100),
shinyWidgets::actionBttn(
inputId = ns("submit_new_option"),
label = "Submit",
icon = icon("paper-plane"))
)
})
observeEvent(input$submit_new_option, {
return_values$myiris <- iris[1:input$new_option_input,]
#does work as intended
updateSelectInput(session = session, inputId = "selection", choices= c(1:input$new_option_input), selected = input$new_option_input)
})
output$t1 <- renderDT({return_values$myiris})
observe({
return_values$selection <- input$selection
})
return(return_values)
})
}
# Define UI for application that draws a histogram
ui <- fluidPage(
title = "Test App",
module_UI("test"),
verbatimTextOutput(outputId = "selection_chosen"),
DTOutput("t2")
)
# Define server logic required to draw a histogram
server <- function(input, output) {
picker <- module_server("test")
output$selection_chosen <- renderText({
picker$selection
})
output$t2 <- renderDT({picker$myiris[,c(3:5)]})
}
# Run the application
shinyApp(ui = ui, server = server)
I am struggling to print the output of various selectInput options on my 'Example_2' tab. These fields themselves have been created within the server based on prior inputs from 'Example_1' tab.
Please see below:
library(shinythemes)
library(shiny)
rm(list = ls())
ui <- navbarPage('Example',id = "inTabset",
tabPanel(title = "Example_1", value = "Example_1",
fluidPage(
tags$b( h4("Example_1", align = "left")),
theme = shinytheme("paper"),
fluidRow(
column(6,checkboxGroupInput("checkGroup", label ="",
choices = c(1,2,3,4,5,6,7,8),
selected = c(1,4,7)) )
),
br()
),
hr(),
verbatimTextOutput("example1")
),
tabPanel(title = "Example_2", value = "Example_2",
fluidPage(
tags$b( h4("Example_2", align = "left")),
br(),
fluidRow(
column(4, uiOutput("VarsInput")),
fluidRow(verbatimTextOutput("dataInfo")),
br(),
hr())
)
))
server <- function(input, output, session) {
output$example1 = renderPrint(input$checkGroup)
### output$example2 = ????
### i.e what data (a,b,c,d,e or f) has been chosen from the selectInput below?
K <- reactive({
length(input$checkGroup)
})
output$VarsInput <- renderUI({
NoV = K()
C = sapply(1:(ceiling(NoV)), function(i){paste0(input$checkGroup[i])})
output = tagList()
for(i in seq_along(1:ceiling(NoV))){
output[[i]] = tagList()
output[[i]][[1]] = selectInput(C[i], C[i], c("",c("a","b","c","d","e","f")))
}
output
})
}
shinyApp(ui, server)
In ui I added verbatimTextOutput for your example2.
When dynamically creating outputs, I believe you just need output[[i]] in your for loop.
For name of these selectInput widgets, added "item" instead of just having the id be a number.
Then, you can access the selected values for these inputs through input[[paste0("item", i)]] where i is matched to your checkboxes.
Edit (12/27/20) Based on comment, with varying checkboxes and inputs, you will want to store both the input name (or index) and choice. So, you could make a reactive data frame to store these, instead of just storing the value selected. Also, you need to check if the dynamically created input exists (or is.null) before storing the value. Additionally, when you create your new dynamic inputs, you can check with the index to provide an accurate default/selected value. See if this works for you.
library(shinythemes)
library(shiny)
ui <- navbarPage('Example',id = "inTabset",
tabPanel(title = "Example_1", value = "Example_1",
fluidPage(
tags$b( h4("Example_1", align = "left")),
theme = shinytheme("paper"),
fluidRow(
column(6,checkboxGroupInput("checkGroup", label ="",
choices = c(1,2,3,4,5,6,7,8),
selected = c(1,4,7)) )
),
br()
),
hr(),
verbatimTextOutput("example1")
),
tabPanel(title = "Example_2", value = "Example_2",
fluidPage(
tags$b( h4("Example_2", align = "left")),
br(),
fluidRow(
column(4, uiOutput("VarsInput")),
fluidRow(verbatimTextOutput("dataInfo")),
br(),
hr(),
verbatimTextOutput("example2"))
)
))
server <- function(input, output, session) {
rv <- reactiveValues(df = NULL)
observe({
rv$df <- data.frame(
index = as.numeric(),
choice = as.character()
)
for (i in input$checkGroup) {
the_item <- input[[paste0("item", i)]]
rv$df <- isolate(rbind(rv$df, data.frame(index = i, choice = ifelse(is.null(the_item), "", the_item))))
}
})
output$example1 = renderPrint(input$checkGroup)
output$example2 <- renderPrint(
for (i in input$checkGroup) {
print(input[[paste0("item", i)]])
}
)
K <- reactive({
length(input$checkGroup)
})
output$VarsInput <- renderUI({
NoV = K()
C = sapply(1:(ceiling(NoV)), function(i){paste0(input$checkGroup[i])})
output = tagList()
for(i in seq_along(1:ceiling(NoV))){
output[[i]] = tagList()
output[[i]] = selectInput(paste0("item", C[i]), C[i], c("",c("a","b","c","d","e","f")),
selected = isolate(rv$df$choice[rv$df$index == C[i]]))
}
output
})
}
shinyApp(ui, server)
pickerInput from shinyWidgets package has a placeholder title Nothing selected.
How is it possible to replace it with Pick a choice for example ? I would prefer a solution that uses css or the options of pickerInput, if possible avoid shinyjs.
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
tags$head(
tags$style(HTML("
"))
),
pickerInput(
inputId = "mtcInputIndicateur",
label = "Select values",
choices = paste("choice", 1:10),
options = list(`live-search` = TRUE),
multiple = TRUE
)
)
server <- function(input, output){
}
shinyApp(ui, server)
Any help would be greatly appreciated.
Just found the answer, use the parameter title in options.
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
pickerInput(
inputId = "mtcInputIndicateur",
label = "Select values",
choices = paste("choice", 1:10),
options = list(`live-search` = TRUE, title = "Pick a choice"),
multiple = TRUE
)
)
server <- function(input, output){
}
shinyApp(ui, server)
I want to display selected feature of selected data in R Shiny.
To select data I use select input (with reactivity) , and to choose features of selected dataset use checkboxGroupInput.
I know there is some mistake in my code. Here is my code how can I act it?
Server- Code
Data_to_display <<- reactive({
switch(input$Data,
"dt_1" = Data1,
"dt_2" = Data2)
})
output$DisplayData <- DT::renderDataTable({
DT::datatable(Data_to_display(), filter="top")
})
UI.Code
------
sidebarLayout(
sidebarPanel(
checkboxGroupInput("show_vars", "Gösterilecek özellikler:",
names(Data), selected = names(Data)),
selectInput("Data", "Choose data:", choices = c("dt_1","dt_2"), selected = "dt_1")
),
mainPanel(
DT::dataTableOutput("DisplayData")
)
Looks like you're calling a reactive input (Data) in the ui. To build dynamic UI that reacts to user input, you can create the UI element on the server and then output the element in the ui.
However, I'm not sure of your exact goal. If you'd like to hide/show columns in the datatable there is a DT extension (colvis) for exactly that purpose.
I've added two examples below -- one with dynamically rendered checkboxes and another with the DT extension for hiding/showing columns.
1) Dynamically created checkboxes:
Data1 <- iris
Data2 <- mtcars
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("Data", "Choose data:",
choices = c("dt_1","dt_2"), selected = "dt_1"),
## render dynamic checkboxes
uiOutput("show_vars")
),
mainPanel(
DT::dataTableOutput("DisplayData")
)
)
)
server <- function(input, output) {
Data_to_display <<- reactive({
switch(input$Data,
"dt_1" = Data1,
"dt_2" = Data2)
})
### create dynamic checkboxes
output$show_vars <- renderUI({
checkboxGroupInput("show_vars", "Gösterilecek özellikler:",
choices = names(Data_to_display()),
selected = names(Data_to_display()))
})
output$DisplayData <- DT::renderDataTable({
DT::datatable(Data_to_display(), filter="top")
})
}
shinyApp(ui, server)
2) DT extension colvis:
Data1 <- iris
Data2 <- mtcars
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("Data", "Choose data:",
choices = c("dt_1","dt_2"), selected = "dt_1")),
mainPanel(
DT::dataTableOutput("DisplayData")
)
)
)
server <- function(input, output) {
Data_to_display <<- reactive({
switch(input$Data,
"dt_1" = Data1,
"dt_2" = Data2)
})
### hide/show columns with built-in DT extension
output$DisplayData <- DT::renderDataTable({
DT::datatable(Data_to_display(), filter = "top",
extensions = 'Buttons',
options = list(dom = 'Bfrtip', buttons = I('colvis')))
})
}
shinyApp(ui, server)