I am new to shiny so this might be a very basic question.
I want to write a shiny app where the user inputs 'n' and we get n number of selectInput options and am not able to do it. Basically any form of for loop is not working.
The code I attempted is following
library(shiny)
ui = fluidPage(
sidebarLayout(
sidebarPanel(
textInput(inputId = "number", label = "number of selectInput",value = 5)
),
mainPanel(
uiOutput(outputId = "putselect")
)
)
)
server = function(input,output){
output$putselect = renderUI(
if(input$number != 0 ){
for(i in 1:(input$number)){
selectInput(inputId = "i", label = "just write something", choices = c(2,(3)))
}
}
)
}
shinyApp(ui = ui , server = server)
You either need to store the inputs you create in a list and return that list, or you can simply wrap your statement in lapply instead of for. A working example is given below, hope this helps!
library(shiny)
ui = fluidPage(
sidebarLayout(
sidebarPanel(
textInput(inputId = "number", label = "number of selectInput",value = 5)
),
mainPanel(
uiOutput(outputId = "putselect")
)
)
)
server = function(input,output){
output$putselect = renderUI(
if(input$number != 0 ){
lapply(1:(input$number), function(i){
selectInput(inputId = "i", label = paste0("input ",i), choices = c(2,(3)))
})
}
)
}
shinyApp(ui = ui , server = server)
Related
I am trying to change the color of the slide when updating its values. I have tried different ways without success. The following code does not run, but replicates what I am trying to do:
if (interactive()) {
library("shiny")
library("shinyWidgets")
ui <- fluidPage(
br(),
sliderTextInput(
inputId = "mySlider",
label = "Pick a month :",
choices = month.abb,
selected = "Jan"
),
verbatimTextOutput(outputId = "res"),
radioButtons(
inputId = "up",
label = "Update choices:",
choices = c("Abbreviations", "Full names")
)
)
server <- function(input, output, session) {
output$res <- renderPrint(str(input$mySlider))
observeEvent(input$up, {
choices <- switch(
input$up,
"Abbreviations" = month.abb,
"Full names" = month.name
)
updateSliderTextInput(
session = session,
inputId = "mySlider",
choices = choices,
color = "red" # This is the line I need to add
)
}, ignoreInit = TRUE)
}
shinyApp(ui = ui, server = server)
}
Maybe has someone the answer to this?
I was able to give this some more thought and figured out a way to update the slider color based on an input. shinyWidgets::setSliderColor essentially just injects CSS to overwrite all the classes associated with the sliderInputs. So it needs to be included in the UI instead of the server. (Took a min to realize that).
I set up a blank uiOutput which is then updated by observing input$up with the new or default color.
Demo
ui <- fluidPage(
br(),
mainPanel(class = "temp",
uiOutput('s_color'), # uiOuput
sliderTextInput(
inputId = "mySlider",
label = "Pick a month :",
choices = month.abb,
selected = "Jan"
),
verbatimTextOutput(outputId = "res"),
radioButtons(
inputId = "up",
label = "Update choices:",
choices = c("Abbreviations", "Full names")
)
)
)
server <- function(input, output, session) {
output$res <- renderPrint(str(input$mySlider))
# output$s_color = renderUI({})
observeEvent(input$up, {
choices <- switch(
input$up,
"Abbreviations" = month.abb,
"Full names" = month.name
)
updateSliderTextInput(
session = session,
inputId = "mySlider",
choices = choices
)
output$s_color = renderUI({ # add color
if (input$up == "Full names") {
setSliderColor(c("Red"), c(1))
} else {
setSliderColor(c("#428bca"), c(1))
}
})
}, ignoreInit = TRUE)
}
shinyApp(ui = ui, server = server)
I have the code below in a shiny dashboard where I want to display different things based on what the user have selected from the drop-down menu. However, the if condition always returns FALSE.
What am I missing here?
#ui.r
body <- dashboardBody(
selectInput(
inputId = "feel",
label = "choose level",
choices = c(
"Easy" = "1",
"Advanced" = "2"
),
selected = "1",
multiple = FALSE
)
if(textOutput("feel")=="1") {
}
)
#server.r
function (input,output){
output$feel<-renderText({
input$feel
})
}
You should do all the business logic inside the server.R
library(shiny)
ui <- fluidPage(
column(2,
selectInput(inputId = "feel",label = "choose level", choices = c("Easy"="1", "Advanced"="2"),
selected = "1", multiple = FALSE)
),
column(2,
textOutput("feeloutput")
)
)
server <- function(input, output, session) {
output$feeloutput <- renderText({
if(input$feel == "1"){
"Show something"
}
else{
"Show something else"
}
})
}
shinyApp(ui = ui, server = server)
I'm unable to select/unselect different columns of mtcars dataset using both radioButtons and selectInput function in Shiny.
Can someone please help me out as i'm stuck on it since last 2 days.
I shall be extremely grateful.
Regards
data(mtcars)
#Ui
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
column(width = 10,
radioButtons(inputId="variables", label="Select variables:",
choices = c("All","mpg","cyl","disp"),
selected = "All", inline = TRUE )),
column(width = 10,
selectInput(inputId = "level", label = "Choose Variables to
display", multiple = TRUE, choices = names(mtcars)[4:11]))),
mainPanel (
h2("mtcars Dashboard"),
DT::dataTableOutput("table"))))
#server
server<-function(input, output) {
output$table <- DT::renderDataTable(DT::datatable(filter='top', editable = TRUE, caption = 'mtcars',
{
data <- mtcars
data<-data[,input$variables,drop=FALSE]
column = names(mtcars)
if (!is.null(input$level)) {
column = input$level }
data
})) }
shinyApp(ui = ui, server = server)
library(shiny)
library(DT)
data(mtcars)
#Ui
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
column(width = 10,
radioButtons(inputId="variables", label="Select variables:",
choices = c("All","mpg","cyl","disp"),
selected = "All", inline = TRUE )),
column(width = 10,
selectInput(inputId = "level", label = "Choose Variables to
display", multiple = TRUE, choices = names(mtcars)[4:11]))),
mainPanel (
h2("mtcars Dashboard"),
DT::dataTableOutput("table"))
))
#server
server<-function(input, output, session) {
data <- mtcars
tbl <- reactive({
if(input$variables=='All'){
data
}else{
data[,c(input$variables,input$level),drop=FALSE]
}
})
output$table <- DT::renderDataTable(DT::datatable(filter='top', caption='mtcars', tbl()))
}
shinyApp(ui = ui, server = server)
Here is what I understand from your requirements, I hope it what you are looking for. Always try to avoid calculations inside render*.
I am trying to create a shiny app with multiple tabs. Each tab is to have its own sidebar. I haven't been able to get this to work. Any help on what is wrong would be appreciated.
Below is the code
ui <- fluidPage(
titlePanel("Hi"),
sidebarLayout(position = "left",
sidebarPanel(
conditionalPanel(condition = "input.tabs1==1",
selectizeInput('invar',"Reg in", choices = varnames, multiple = TRUE)),
conditionalPanel(condition = "input.tabs1==2",
selectizeInput('outvar',"Reg out", choices = predictors, multiple = FALSE)),
),
mainPanel(
tabsetPanel(id="tabs1",
tabPanel("input",value=1,plotOutput("Input"),
tabPanel("output",value=2,plotOutput("Output")
))))
))
First of all, check your code again. You made following mistakes:
one tabPanel is nested inside the other one
there's an extra comma at the end of the second conditionalPanel(), so you pass an empty element to sidebarPanel()
If I correct your mistakes and create a mock example, it works perfectly fine as is. So there isn't really a problem here:
ui <- fluidPage(
titlePanel("Hi"),
sidebarLayout(position = "left",
sidebarPanel(
conditionalPanel(condition = "input.tabs1==1",
selectizeInput('invar',"Reg in", choices = letters[1:3], multiple = TRUE)),
conditionalPanel(condition = "input.tabs1==2",
selectizeInput('outvar',"Reg out", choices = letters[4:6], multiple = FALSE))
),
mainPanel(
tabsetPanel(id="tabs1",
tabPanel("input",value=1,plotOutput("Input")),
tabPanel("output",value=2,plotOutput("Output"))
)
)
))
server <- function(input, output, session){
output$Input <- renderPlot(plot(1))
output$Output <- renderPlot(plot(2))
}
shinyApp(ui, server)
You could do this as well by using renderUI:
ui <- fluidPage(
titlePanel("Hi"),
sidebarLayout(position = "left",
sidebarPanel(
uiOutput("mysidebar")
),
mainPanel(
tabsetPanel(id="tabs1",
tabPanel("input",value=1,plotOutput("Input")),
tabPanel("output",value=2,plotOutput("Output")
)))
))
server <- function(input, output, session){
output$mysidebar <- renderUI({
if(input$tabs1 == 1){
selectizeInput('invar',"Reg in", choices = letters[1:3])
} else if(input$tabs1 == 2){
selectizeInput('outvar',"Reg out", choices = letters[4:6])
}
})
}
shinyApp(ui,server)
I do this in a very different but effective way.
shinyApp(
shinyUI(
fluidPage(
uiOutput('mainpage')
)
),
shinyServer(function(input, output, session) {
panel <- reactiveValues(side = NULL)
output$mainpage <- renderUI({
sidebarLayout(position = "left",
sidebarPanel(
uiOutput(panel$side)
),
mainPanel(
tabsetPanel(id="tabs1",
tabPanel("input",value=1,plotOutput("Input")),
tabPanel("output",value=2,plotOutput("Output"))
)
)
})
output$sideinput <- renderUI({
tagList(
selectizeInput('invar',"Reg in", choices = varnames, multiple = TRUE))
)
})
output$sideoutput <- renderUI({
tagList(
selectizeInput('outvar',"Reg out", choices = predictors, multiple =FALSE)
)
})
observeEvent(input$tabs1,{
panel$side <- switch(input$tabs1,
1 = 'sideinput',
2 = 'sideoutput')
})
basically I am using observers as my conditionals and assigning the value of the desired panel to the variable name assigned to that panel position
I'm trying to use the shinyFiles library in my shinyApp, in order to give the user the possibility to select a group of files or a directory.
My idea is to use a uiOutput that changes depending on a checkbox selection.
Here I report the code, that maybe is more explicative than words
UtilityUI <- fluidPage(
titlePanel("page1"),
fluidRow(
column(2,
wellPanel(
tags$p("Check the box below if you want to choose an entire directory"),
checkboxInput(inputId = 'directory_flag', label = 'Directory path?', value = FALSE),
uiOutput("input_selection_ui")
)
),
column(8
#...
)
)
)
UtilityServer <- function(input, output, session) {
output$input_selection_ui <- renderUI({
if(input$directory_flag == TRUE) {
shinyDirButton(id = "infiles", label = "Choose directory", title = "Choose a directory")
} else {
shinyFilesButton(id = "infiles", label = "Choose file(s)", title = "Choose one or more files", multiple = TRUE)
}
})
shinyFileChoose(input, 'infiles', roots=getVolumes(), session=session, restrictions=system.file(package='base'))
shinyDirChoose(input, 'infiles', roots=getVolumes(), session=session, restrictions=system.file(package='base'))
}
shinyApp(UtilityUI, UtilityServer)
The problem borns when the "shinyFiles" button is pressed: the popup window doesn't load the roots, in both cases (shinyDirButton and shinyFilesButton).
If I don't use the uiOutput function everything works well... But in that case I cannot change my UI dinamically...
Thanks a lot for your replies,
Inzirio
It seems I can't get it to work either with renderUI(). Instead I implemented the same behavior using conditionalPanel() to show alternative buttons. This seems to work. Here is the code:
ui <- shinyUI(fluidPage(
checkboxInput(
inputId = 'directory_flag',
label = 'Directory path?',
value = FALSE
),
conditionalPanel(
"input.directory_flag == 0",
shinyFilesButton(
id = "infile",
label = "Choose file(s)",
title = "Choose one or more files",
multiple = TRUE
)
),
conditionalPanel(
"input.directory_flag == 1",
shinyDirButton(id = "indir", label = "Choose directory", title = "Choose a directory")
)
))
server <- shinyServer(function(input, output, session) {
shinyFileChoose(
input,
'infile',
roots = getVolumes(),
session = session,
restrictions = system.file(package = 'base')
)
shinyDirChoose(
input,
'indir',
roots = getVolumes(),
session = session,
restrictions = system.file(package = 'base')
)
})
shinyApp(ui, server)