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)
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 am trying to create an app that will show you results depending on a selectInput and the changes are controlled by actionButtons.
When you launch the app, you have to select a choice: Data 1 or Data 2. Once you have selected your choice (e.g. Data 1), you have to click the actionButton "submit type of data". Next, you go to the second tab, choose a column and then click "submit".
The output will be: one table, one text and one plot.
Then, if you go back to the first tab and select "Data 2", everything that you have generated is still there (as it is expected, since you didn't click any button).
However, I would like to remove everything that is in the mainPanel if I change my first selectInput as you could see it when you launch the app for the first time.
The idea is that since you have changed your first choice, you will have to do the same steps again (click everything again).
I would like to preserve and control the updates with actionButtons as I have in my code (since I am working with really long datasets and I don't want to depend on the speed of loading things that I don't want until I click the button). Nevertheless, I cannot think a way to remove everything from mainPanel if I change the choice of the first selectInput.
Does anybody have an idea how I can achieve this?
Thanks in advance
Code:
library(shiny)
library(shinyWidgets)
library(shinyFeedback)
library(DT)
library(datasets)
ui <- fluidPage(
sidebarPanel(
tabsetPanel(id="histogram",
tabPanel("Selection",
useShinyFeedback(),
selectInput(inputId = "type", label = "Select your data",
choices = c("Data 1" = "data1",
"Data 2" = "data2")),
conditionalPanel(
condition = "input.type == 'data2'",
div(style = "position:absolute;right:2.5em;",
actionButton(
inputId = "button_more_info_data2",
label = "More info",
icon = icon("info-circle"))
)
),
actionButton(
inputId = "button",
label = "Submit type of data",
icon = icon("check")
)
),
tabPanel("Pick the column",
br(),
selectizeInput(inputId = "list_columns", label = "Choose the column:", choices=character(0)),
actionButton(
inputId = "button2",
label = "Submit")
))
),
mainPanel(
dataTableOutput("table"),
textOutput("text"),
plotOutput("myplot")
)
)
server <- function(input, output, session) {
observeEvent(input$type,{
feedbackWarning(inputId = "type",
show = ("data2" %in% input$type),
text ="This data is... Please, be careful..."
)
})
mydata <- reactive({
if(input$type == "data1"){
mtcars
}else{
iris
}
}) %>% bindEvent(input$button2)
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$button, {
updateSelectizeInput(
session = session,
inputId = "list_columns",
choices = colnames(trees), options=list(maxOptions = length(colnames(trees))),
server = TRUE
)
})
output$table <- renderDataTable({
req(input$button2)
mydata()
})
output$text <- renderText({
req(input$button2)
input$list_columns
})
output$myplot <- renderPlot({
req(input$button2, input$button)
hist(trees[,input$list_columns])
})
}
if (interactive())
shinyApp(ui, server)
Here is an example using a reset button - using the selectInput you'll end up with a circular reference:
library(shiny)
library(shinyWidgets)
library(shinyFeedback)
library(DT)
library(datasets)
ui <- fluidPage(sidebarPanel(tabsetPanel(
id = "histogram",
tabPanel(
"Selection",
useShinyFeedback(),
selectInput(
inputId = "type",
label = "Select your data",
choices = c("Data 1" = "data1",
"Data 2" = "data2")
),
conditionalPanel(
condition = "input.type == 'data2'",
div(
style = "position:absolute;right:2.5em;",
actionButton(
inputId = "button_more_info_data2",
label = "More info",
icon = icon("info-circle")
)
)
),
actionButton(
inputId = "button",
label = "Submit type of data",
icon = icon("check")
),
actionButton(
inputId = "reset",
label = "Reset",
icon = icon("xmark")
)
),
tabPanel(
"Pick the column",
br(),
selectizeInput(
inputId = "list_columns",
label = "Choose the column:",
choices = character(0)
),
actionButton(inputId = "button2",
label = "Submit")
)
)),
mainPanel(
dataTableOutput("table"),
textOutput("text"),
plotOutput("myplot")
))
server <- function(input, output, session) {
observeEvent(input$type, {
feedbackWarning(
inputId = "type",
show = ("data2" %in% input$type),
text = "This data is... Please, be careful..."
)
})
mydata <- reactiveVal(NULL)
observe({
if (input$type == "data1") {
mydata(mtcars)
} else if (input$type == "data2") {
mydata(iris)
} else {
mydata(data.frame())
}
}) %>% bindEvent(input$button2)
observeEvent(input$reset, {
mydata(data.frame())
})
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$button, {
updateSelectizeInput(
session = session,
inputId = "list_columns",
choices = colnames(trees),
options = list(maxOptions = length(colnames(trees))),
server = TRUE
)
})
output$table <- renderDataTable({
req(input$button2)
mydata()
})
output$text <- renderText({
req(input$button2)
input$list_columns
})
output$myplot <- renderPlot({
req(input$button2, input$button)
hist(trees[, input$list_columns])
})
}
shinyApp(ui, server)
I want to build an app in which the user can add as many as input slots as he wants. I could only build an app that let the user to add only one more input slot. Here is my code:
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput("a", "Something", choices = "blah blah"),
uiOutput("b"),
actionButton(inputId = "rm", label = "-"),
actionButton(inputId = "add", label = "+"),
),
mainPanel(
textOutput("test")
)
)
)
server <- function(input, output) {
observeEvent(input$add ,{
output$b <- renderUI({
selectizeInput("b", "Another thing", choices = "blah blah")
})
})
observeEvent(input$rm ,{
output$b <- renderUI({
NULL
})
})
}
shinyApp(ui = ui, server = server)
I have no idea how I can extend this to let the user add as many as input slots as he wants. Is this even possible?
We can try this approach:
We can access new added inputs with input$a1, input$a2 ... input$ax
Edit: added an observer to see the new inputs generated in the console. The first input created after pressing + button will be called input$a1.
observe({
print(names(input))
print(input$a1)
})
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput("a", "Something", choices = "blah blah"),
actionButton(inputId = "rm", label = "-"),
actionButton(inputId = "add", label = "+"),
),
mainPanel(
textOutput("test")
)
)
)
server <- function(input, output) {
input_counter <- reactiveVal(0)
observeEvent(input$add, {
input_counter(input_counter() + 1)
insertUI(
selector = "#rm", where = "beforeBegin",
ui = div(id = paste0("selectize_div", input_counter()), selectizeInput(paste0("a", input_counter()), label = "Another thing", choices = c("bla", "blabla")))
)
})
observeEvent(input$rm, {
removeUI(
selector = paste0("#selectize_div", input_counter())
)
input_counter(input_counter() - 1)
})
observe({
print(names(input))
print(input$a1)
})
}
shinyApp(ui, server)
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)
I'm trying to create a shiny app that allows users to select multiple things from a checkbox. Based on the inputs, it should return all the relevant text output fields.
To do this, I'm indexing the checkbox and using multiple criteria in the if statements, but something doesn't work when the input1 is selected: if I select both input2 and input1, then it just shows the result for input2; if I just select input1, then the shiny app crashes.
I tried to add more conditions just to check...but no luck.
Code below:
library(shiny)
library(shinydashboard)
ui <- shinyUI(
navbarPage("DBC Comparison",
tabPanel("Stats" ,
sidebarLayout(
sidebarPanel(
checkboxGroupInput("comp_type", "Comparison type", choices = c("input1", "input2", "input3")),
actionButton(
inputId = "submit_loc",
label = "Submit")
, width = 3),
mainPanel(
fluidRow(
column(6, textOutput("selected_var1")),
#DT::dataTableOutput("table")#,
# div(style = 'overflow-x: scroll', tableOutput('table'))
column(6,textOutput("selected_var2"))
), position="left"))
)
))
##
##
server <- shinyServer(function(input, output) {
observeEvent(
eventExpr = input$submit_loc,
handlerExpr =
{
if(input$comp_type[1] == 'input2' || input$comp_type[2] == 'input2' || (input$comp_type[1] == 'input1' & input$comp_type[2] == 'input2'))
{
output$selected_var2 <- renderText({
"2"
})}
else if(input$comp_type[1] == 'input1' ||input$comp_type[2] == 'input1'||input$comp_type[3] == 'input1'|| (input$comp_type[1] == 'input1' & input$comp_type[2] == 'input2')
|| (input$comp_type[2] == 'input1' & input$comp_type[1] == 'input2')
{
output$selected_var1 <- renderText({
"1"
})
}
})
})
##
shinyApp(ui = ui, server = server)
Any ideas?
input$comp_type[2] == 'something' produces NA if you don't have at least 2 items selected. So your if statement return an error.
Also, I try not using render on observe.
I modify your example to use a eventReactive which is easier.
As I didn't get anything about your if conditions, I just wrote some random ones to let you see how I would deal with that.
library(shiny)
library(shinydashboard)
ui <- shinyUI(
navbarPage("DBC Comparison",
tabPanel("Stats" ,
sidebarLayout(
sidebarPanel(
checkboxGroupInput("comp_type", "Comparison type", choices = c("input1", "input2", "input3")),
actionButton(
inputId = "submit_loc",
label = "Submit")
, width = 3),
mainPanel(
fluidRow(
column(6, textOutput("selected_var"))
#DT::dataTableOutput("table")#,
# div(style = 'overflow-x: scroll', tableOutput('table'))
), position="left"))
)
))
##
##
server <- shinyServer(function(input, output) {
toDisplay <- eventReactive(input$submit_loc, {
if (all(c("input1", "input2", "input3") %in% input$comp_type)) {
return("all input selected")
} else if (all(c("input2", "input3") %in% input$comp_type)) {
return("input2 and input3 selected")
} else if ("input1" %in% input$comp_type) {
return("At least input1 is selected")
} else {
return("you are not in a random case I wrote")
}
})
output$selected_var <- renderText({
toDisplay()
})
})
##
shinyApp(ui = ui, server = server)