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)
Related
Good days, I am programming in Rstudio, using shiny, and I wanted to generate an alert that is activated only when I want to leave a tabPanel without completing a condition, but not if I do not enter the tabPanel before, this is the way I found. The problem is that every time that I leave the Panel 1 without fulfilling the condition of completing text, alerts are generated that are accumulating (1 alert the first time, two the second, three the third, etc.) I wanted to consult if somebody knows why it is this and how to avoid it.
thank you very much
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(
tabsetPanel(
id = "tabselected",
tabPanel("Tab2",""),
tabPanel("Tab1", textInput("requiredText", "Required Text"))
))
server <- function(input, output, session) {
observe({
req(input$tabselected == "Tab1")
observeEvent(
input$tabselected,
if (input$tabselected != "Tab1" & !isTruthy(input$requiredText)) {
shinyalert(title = "Save your work before changing tab",
type = "warning",
showConfirmButton = TRUE
)
updateTabsetPanel(session, inputId = "tabselected", selected = "Tab1")
}
)
}
)
}
shinyApp(ui = ui, server = server)
Is this the behavior you desire? Your example was recursive so you had reoccurring popup event. We can create a reactiveValues variable to keep track of the events, like so:
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(
tabsetPanel(
id = "tabselected",
tabPanel("Tab2",""),
tabPanel("Tab1", textInput("requiredText", "Required Text"))
))
server <- function(input, output, session) {
v <- reactiveValues(to_alert = FALSE)
observeEvent(input$tabselected,{
if (input$tabselected != "Tab1" & !isTruthy(input$requiredText)) {
v$to_alert <- TRUE
}else{
v$to_alert <- FALSE
}
},ignoreInit = TRUE)
observeEvent(v$to_alert,{
if (v$to_alert){
shinyalert(title = "Save your work before changing tab", type = "warning",showConfirmButton = TRUE)
updateTabsetPanel(session, inputId = "tabselected", selected = "Tab1")
}
})
}
shinyApp(ui = ui, server = server)
When running the code below, you will notice that I have two options below. If you press the Excel option, a fileInput will appear right below the radioButtons. However, I would like to know if it is possible to separate fileInput from radioButtons. I will insert an image to clarify what I want. See that they are separated.
Executable code below:
library(shiny)
library(dplyr)
library(shinyjs)
library(shinythemes)
library(readxl)
ui <- fluidPage(
shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
br(),
tabPanel("PAGE1",
sidebarLayout(
sidebarPanel(
radioButtons("button",
label = h3("Data source"),
choices = list("Excel" = "Excel",
"Database" = "database"),
selected = "File"),
uiOutput('fileInput'),
),
mainPanel(
)))))
server <- function(input, output) {
observe({
if(is.null(input$button)) {
}else if (input$button =="Excel"){
output$fileInput <- renderUI({
fileInput("file",h4("Import file"), multiple = T, accept = ".xlsx")
})
} else if(input$button=="database"){
output$fileInput <- NULL
} else {
output$fileInput <- NULL
}
})
}
shinyApp(ui = ui, server = server)
Example:
I left it in red to specify the space
A possible workaround could be to use fluidRow with two columns to simulating a sidebarPanel with a mainPanel.
Notice that I wrapped the inputs in a div(class = "well well-lg") for the background.
App
library(shiny)
library(dplyr)
library(shinyjs)
library(shinythemes)
library(readxl)
ui <- navbarPage(
theme = shinytheme("flatly"), collapsible = TRUE,
br(),
tabPanel(
"PAGE1",
fluidRow(
column(
width = 6,
fluidRow(div(
class = "well well-lg",
radioButtons("button",
label = h3("Data source"),
choices = list(
"Excel" = "Excel",
"Database" = "database"
),
selected = "File"
)
)),
fluidRow(
uiOutput("fileInput")
)
),
column(
width = 6,
tableOutput("iris")
)
)
)
)
server <- function(input, output) {
output$iris <- renderTable({
iris
})
observe({
if (is.null(input$button)) {
} else if (input$button == "Excel") {
output$fileInput <- renderUI({
div(class = "well well-lg", fileInput("file", h4("Import file"), multiple = T, accept = ".xlsx"))
})
} else if (input$button == "database") {
output$fileInput <- NULL
} else {
output$fileInput <- NULL
}
})
}
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 trying to create the scenario whereby using conditionalpanel, I am able to have an user input of checked boxes to display either 1 or 2 plots, one after another.
My reproducible code can be found below, however, I am unable to display the plots.
Could someone please share with me where did I make a mistake?
library(shiny)
ui = fluidPage(
titlePanel("Plot1 or Plot2?"),
sidebarLayout(
sidebarPanel(
checkboxGroupInput("my_choices", "Plot1 or Plot2",choices = c("Plot1", "Plot2"), selected = "Plot1"),width=2),
mainPanel(
conditionalPanel(
condition = "input.my_choices == 'Plot1'",
plotOutput("plot1")
),
conditionalPanel(
condition = "input.my_choices == 'Plot2'",
plotOutput("plot2")
),
conditionalPanel(
condition = "input.my_choices.includes('Plot1', 'Plot2')",
plotOutput("plot1"),
plotOutput("plot2")
)
)
)
)
server = function(input, output) {
output$plot1 <- renderPlot({plot(iris)})
output$plot2 <- renderPlot({plot(mtcars)})
}
shinyApp(ui, server)
Update:
I've got what I wanted but without using ConditionalPanel function. Here's the code below:
Would appreciate if someone can share with me the proper way of using ConditionalPanel Function! (:
library(shiny)
#data
df <- iris
#ui
ui <- fluidPage(
sidebarPanel(
checkboxGroupInput(inputId = "Question",
label = "Choose the plots",
choices = c("Plot1", "Plot2", "Plot3"),
selected = "")),
mainPanel(
uiOutput('ui_plot')
)
)
#server
server <- function(input, output)
{
# gen plot containers
output$ui_plot <- renderUI({
out <- list()
if (length(input$Question)==0){return(NULL)}
for (i in 1:length(input$Question)){
out[[i]] <- plotOutput(outputId = paste0("plot",i))
}
return(out)
})
# render plots
observe({
for (i in 1:3){
local({ #because expressions are evaluated at app init
ii <- i
output[[paste0('plot',ii)]] <- renderPlot({
if ( length(input$Question) > ii-1 ){
return(plot(runif(100)))
}
NULL
})
})
}
})
}
shinyApp(ui, server)
I would give you an alternative as you will need to create new plots with different id in order for that to work. The simplest one I can think of is using shinyjs package and its hide and show functions. You can also do this via renderUI but you shouldn't give unnecessary work to your server only if you're showing and hiding the elements
library(shiny)
library(shinyjs)
ui = fluidPage(
useShinyjs(),
titlePanel("Plot1 or Plot2?"),
sidebarLayout(
sidebarPanel(
checkboxGroupInput("my_choices", "Plot1 or Plot2",choices = c("Plot1", "Plot2"), selected = "Plot1"),width=2),
mainPanel(
plotOutput("plot1"),
plotOutput("plot2")
)
)
)
server = function(input, output,session) {
# hide plots on start
hide("plot1");hide("plot2")
output$plot1 <- renderPlot({plot(iris)})
output$plot2 <- renderPlot({plot(mtcars)})
observeEvent(input$my_choices,{
if(is.null(input$my_choices)){
hide("plot1"); hide("plot2")
}
else if(length(input$my_choices) == 1){
if(input$my_choices == "Plot1"){
show("plot1");hide("plot2")
}
if(input$my_choices == "Plot2"){
hide("plot1");show("plot2")
}
}
else{
if(all(c("Plot1","Plot2") %in% input$my_choices)){
show("plot1");show("plot2")
}
}
},ignoreNULL = F)
}
shinyApp(ui, server)
I am trying to take input from a dropdown, and displaying a string depending on the selection
in ui.R:
selectInput(inputId = "engine",
label = h3("Select Search Engine"),
choices = c("Bing", "Google"),
selected = "Bing"))
in server.R:
if ( input$engine == "Bing"){
output$value <- renderText({ input$engine })
}
This works fine when the if statement is set to something trivial like 1 == 1 and outputs the text string, but not when I try to check the actual input (the if statement doesn't trigger). Seems like it should be something easy but I've been stuck on this for a while now....what am I doing wrong?
I don't know why you would want that if statement here but this works:
library(shiny)
server <- function(input, output) {
output$value <- renderText({
if ( input$engine == "Bing") {
ret <- paste0("https://", input$text, "/?pid=", input$engine,"+{adgroupname}+{keyword}+{matchtype}+{adposition}")
} else {
ret <- paste0("https://", input$text, "/?pid=", input$engine,"+{adgroupname}+{keyword}+{matchtype}+{adposition}")
}
ret
})
}
ui <- shinyUI(fluidPage(
fluidRow(
column(3,
selectInput(inputId = "engine",
label = h3("Select Search Engine"),
choices = c("Bing", "Google"),
selected = "Bing")),
column(3,
textInput("text", label = h3("URL"), value = "www.test.com"))),
hr(),
h3("Final Url:"),
fluidRow(column(9, h4(textOutput("value"), style = "color:blue")))
))
shinyApp(ui = ui, server = server)