Shiny Sliders Dependent on Single Checkbox - r

I have a Shiny App and I am trying to have two sliders appear only if the checkBox is selected. Below is the code I am trying to get to work and am not seeing the UI.
library(shiny)
ui <- fluidPage(
checkboxInput("box_checked", "box_checked", value = FALSE),
uiOutput("test")
)
# Define server logic
server <- function(input, output) {
output$test = renderUI({
if (input$box_checked = 0){
return(NULL)
}
if(input$box_checked = 1){
sliderInput("sliderOne", "Choose your value", min=0, max=100, value=50)
sliderInput("sliderTwo", "Choose your other value", min=0, max=50, value=25)
}
})
}
# Run the application
shinyApp(ui = ui, server = server)

Try this way:
library(shiny)
ui <- fluidPage(checkboxInput("box_checked", "box_checked", value = FALSE),
uiOutput("test"))
# Define server logic
server <- function(input, output) {
output$test = renderUI({
if (input$box_checked == 0) {
return(NULL)
}
if (input$box_checked == 1) {
list(
sliderInput(
"sliderOne",
"Choose your value",
min = 0,
max = 100,
value = 50
),
sliderInput(
"sliderTwo",
"Choose your other value",
min = 0,
max = 50,
value = 25
)
)
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
I fixed if statement, as you used input$box_checked = 1 instead of input$box_checked == 1.
You should use list() to produce multiple UI elements inside renderUI.

Related

observeEvent() function in R

I an super new to R and was exploring different buttons. I came acorss observe event and tried to use it, but it does not print my output. Can someone please help!
library(shiny)
ui <- fluidPage(
sliderInput(inputId = "num",
label = "Choose a number",
value = 25, min = 1, max = 100),
actionButton(inputId = "go", label = "Print Value")
)
server <- function(input, output) {
observeEvent(input$go,{as.numeric(input$num)})
}
shinyApp(ui = ui, server = server)
Note: The function is a part of the shiny library
If you want to print to the console you'll need to call print. If you rather want to print in the UI, you can do this with a reactiveVal:
library(shiny)
ui <- fluidPage(
sliderInput(inputId = "num",
label = "Choose a number",
value = 25, min = 1, max = 100),
actionButton(inputId = "go", label = "Print Value"),
textOutput("myText")
)
server <- function(input, output) {
printData <- reactiveVal()
observeEvent(input$go,{
print(input$num) # print to console
printData(input$num) # pass data to reactiveVal
})
output$myText <- renderText(printData())
}
shinyApp(ui = ui, server = server)

Facing issues to access shiny module dynamic input value

I am facing a issue to access my shiny module's dynamic input value from slider in the main shiny server function.
In the following code from SelectInput when metric2 is selected, I should be able to see a slider with a specific range and a default. That works perfectly. But the value from the slider is expected to be shown as TextOutput in the main shiny server function, which is failing.
main shiny file:
library(shiny)
source("modules/showLowHighSliders.R")
ui <- fluidPage(
fluidRow(
column(
3,
selectizeInput(
inputId = "metricID",
selected = NULL,
multiple = TRUE,
label = "Select a metric",
choices = list(
Type1 = c("metric1", "metric2", "metric3"),
Type2 = c("metric4","metric5")
),
options = list('plugins' = list('remove_button'))
)
),
column(2,
uiOutput(outputId = "lowerThresholdText"),
showLowHighSlidersUI("sliders-metric2")
)
)
)
server <- function(input, output){
ret <- callModule(module = showLowHighSliders,
id = "sliders-metric2",
metrics_selected=reactive(input$metricID))
output$lowerThresholdText <- renderText({
if(!is.null(input$metricID )){
if(input$metricID == 'metric2'){
paste("Lower Value: ", ret() )
}
}
})
}
shinyApp(ui, server)
Shiny module: showLowHighSliders.R
showLowHighSlidersUI <- function(id) {
ns <- NS(id)
fluidPage(
fluidRow(
column(12,
tagList(
# uiOutput(ns("lowerThresholdText")),
uiOutput(ns("lowerThresholdSlider"))
)
)
)
)
}
# Function for module server logic
showLowHighSliders <- function(input, output, session, metrics_selected) {
reactive({input$mySlider})
output$lowerThresholdSlider <- renderUI({
#print(metrics_selected())
if(!is.null(metrics_selected() ) ){
if('metric2' %in% metrics_selected() ){
sliderInput(
inputId = "mySlider",
label = "",
min = 0,
max = 200,
value = 20
)
}
}
})
# output$lowerThresholdText <- renderText({
# #print(metrics_selected)
# if(!is.null(metrics_selected() )){
# if('SMA' %in% metrics_selected()){
# paste("Lower SMA: ", input$mySlider )
# }
# }
#
# })
}
I was also unable to access the dynamic input slider value within the module itself shown in the commented part.
Any help is appreciated.
Try this
# Function for module server logic
showLowHighSliders <- function(input, output, session, metrics_selected) {
# reactive({input$mySlider})
ns <- session$ns
output$lowerThresholdSlider <- renderUI({
#print(metrics_selected())
if(!is.null(metrics_selected() ) ){
if('metric2' %in% metrics_selected() ){
sliderInput(
inputId = ns("mySlider"),
label = "",
min = 0,
max = 200,
value = 20
)
}
}
})
output$lowerThresholdText <- renderText({
#print(metrics_selected)
if(!is.null(metrics_selected() )){
#if('SMA' %in% metrics_selected()){
paste("Lower SMA: ", session$input$mySlider )
#}
}
})
}

Conditional Panel does not work after being modularized

I have a weird issue with conditionalPanel in shiny dashboard.
I modularized my chart UI components as I need to call it multiple times.
The conditional Panel seems to work fine if I call it only once. However, if I attempted to call more than once, it stopped working.
Below is the reproducible code:
library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(shinydashboardPlus)
library(highcharter)
library(lubridate)
chartUI <- function(id) {
ns <- NS(id)
tagList(
verbatimTextOutput(ns("group")),
selectInput(ns("freq"),"Select frequency:",
choices = list("Yearly" = "Y","Half yearly" = "H","Quarterly" = "Q",
"Monthly"="M"), selected = "Yearly", multiple = FALSE),
dateInput(ns("dates"), "Select start date:",format = "yyyy-mm-dd", startview = "month", value = dmy("1/1/2014")),
selectInput(ns("link"),"Select link ratio:",choices = list("All" = "all", "Standard" = "std"),selected = "all"),
conditionalPanel("input.link == 'std'", ns=ns, sliderInput(ns("std.month"),"No of months:",min=1,max=119,value=60))
)
}
ui <- shinyUI(
ui = dashboardPagePlus(skin = "red",
header = dashboardHeaderPlus(
title = "TITLE",
titleWidth = 700
),
dashboardSidebar(),
body = dashboardBody(
# boxPlus(
# width = NULL,title = "CHART",closable = TRUE,enable_sidebar = TRUE,
# sidebar_width = 15,sidebar_start_open = FALSE,sidebar_content = chartUI("chartui1"),
# highchartOutput("")
# ),
boxPlus(
width = NULL,title = "CHART",closable = TRUE,enable_sidebar = TRUE,
sidebar_width = 15,sidebar_start_open = FALSE,sidebar_content = chartUI("chartui2"),
highchartOutput("")
)
),
title = "DashboardPage"
)
)
server <- shinyServer(function(input, output) {
})
shinyApp(ui, server)
If I only call chartui2, conditional panel works fine. But if I call both chartui1 and chartui2, both of them no longer work.
A minimal example with uiOutput / renderUI would be:
library(shiny)
dyn_ui <- function(id) {
ns <- NS(id)
tagList(selectInput(ns("show"), "show or not", choices = c("hide", "show")),
uiOutput(ns("dyn")))
}
dyn_server <- function(input, output, session) {
output$dyn <- renderUI({
ns <- session$ns
if (input$show == "show") {
sliderInput(
inputId = ns("std_month"),
"No of months:",
min = 1,
max = 119,
value = 60
)
}
})
}
ui <- basicPage(dyn_ui("test"))
server <- function(input, output, session) {
callModule(module = dyn_server, id = "test")
}
runApp(list(ui = ui, server = server))
Edit:
In fact, a minimal example works well with conditionalPanel too (see below). So something else about your app is causing a conflict. Not sure what it is, but I would start adding components one by one and see when these minimal examples start misbehaving.
library(shiny)
dyn_ui <- function(id) {
ns <- NS(id)
tagList(
selectInput(ns("show"), "show or not", choices = c("hide", "show")),
conditionalPanel(
ns = ns,
condition = "input.show == 'show'",
sliderInput(
inputId = ns("std_month"),
"No of months:",
min = 1,
max = 119,
value = 60
)
)
}
ui <- basicPage(
dyn_ui("test"),
dyn_ui("test2")
)
server <- function(input, output, session) {
}
runApp(list(ui = ui, server = server))

Shiny button needed only once

I want an event to be triggered for the first time only by clicking a button. After that I want it to be reactive to the slider input.
I tried the following:
ui <- fluidPage(
actionButton("go", "Go"),
sliderInput("n", label = "Sample size", min = 1, max = 100, value = 10),
plotOutput('samples')
)
server <- function(input, output, session){
activate = reactive({FALSE})
activate = eventReactive(input$go, {
isolate(TRUE)
})
samples = eventReactive(activate(), {
rnorm(input$n)
})
output$samples <- renderPlot({ hist(samples()) })
}
shinyApp(ui = ui, server = server)
I hoped it would make it reactive to input$n after input$go has been clicked once. But it isn't and still needs input$go to be clicked every time.
There are several ways to achieve that.
One way would be to store the value in a reactiveValues() or just use req(), see below.
The problem with using eventReactive(activate(), ... is that it only triggers the code inside if activate() is executed, which only happens if you click input$go.
Reproducible example with req():
ui <- fluidPage(
actionButton("go", "Go"),
sliderInput("n", label = "Sample size", min = 1, max = 100, value = 10),
plotOutput('samples')
)
server <- function(input, output, session){
output$samples <- renderPlot({
req(input$go > 0)
hist(rnorm(input$n))
})
}
shinyApp(ui = ui, server = server)
Reproducible example with reactiveValues():
ui <- fluidPage(
actionButton("go", "Go"),
sliderInput("n", label = "Sample size", min = 1, max = 100, value = 10),
plotOutput('samples')
)
server <- function(input, output, session){
global <- reactiveValues(showPlot = FALSE)
observeEvent(input$go, {
global$showPlot <- TRUE
})
samples = reactive({
rnorm(input$n)
})
output$samples <- renderPlot({
req(global$showPlot)
hist(samples())
})
}
shinyApp(ui = ui, server = server)

Using a reactive value in an IF-statement in the UI in R Shiny

I am trying to create a conditional UI in Shiny that depends on the input of a user. I specifically want to do the if in the UI part and NOT in the server part.
Here is an example of what I aim to accomplish.
# app.R
library(shiny)
ui <- shiny::fluidPage(
shiny::headerPanel(title = "Basic App"),
shiny::sidebarPanel(
shiny::sliderInput(inputId = "a",
label = "Select an input to display",
min = 0, max = 100, value = 50
)
),
if(output$out < 50){
shinyjs::hide(shiny::mainPanel(h1(textOutput("text"))))
}else{
shiny::mainPanel(h1(textOutput("text")))
}
)
server <- function(input, output) {
output$text <- shiny::renderText({
print(input$a)
})
var <- shiny::reactive(input$a)
output$out <- renderText({ var() })
}
shiny::shinyApp(ui = ui, server = server)
Is there a way that I can use the reactive value in the UI part of the function?
I think conditionalPanel could be a good solution for what you want to do
library(shiny)
ui <- shiny::fluidPage(
shiny::headerPanel(title = "Basic App"),
shiny::sidebarPanel(
shiny::sliderInput(inputId = "a",
label = "Select an input to display",
min = 0, max = 100, value = 50
)
),
shiny::mainPanel(
conditionalPanel(
condition = "input.a > 50",
h1(textOutput("text")))
)
)
server <- function(input, output) {
output$text <- shiny::renderText({
print(input$a)
})
}
shiny::shinyApp(ui = ui, server = server)
Hope this helps!!

Resources