ConditionalPanel seems not working with shinydashboard
the input variables are working as shown, but I just can't turn off the slideInput under the conditionalPanel chunk.
quite odd to me, please advise.
Here is my top example
library(shiny)
library(shinydashboard)
ui <-
dashboardPage(
dashboardHeader(title = ""),
dashboardSidebar(
checkboxInput("chk", label = "checkBox",value = FALSE ),
conditionalPanel(condition = "input.chk ==TRUE",
sliderInput("slide", label = "test", min = 0, max = 10, value = 5))
),
dashboardBody(
textOutput("result"),
textOutput("checked")
)
)
server <-
function(input, output, session) {
result <- reactive(ifelse(input$slide >5, " greater than 5", "smaller than 5"))
output$result <- renderText(result())
output$checked <- renderText(input$chk)
}
shinyApp(ui, server)
After few hours of searching, the answer turned out to be really straightforeward.
condition = "input.chk ==1"
and solved my question.
Related
Currently by default as drafted in the below MWE, when first invoking the App, and also when clicking the "Base rate" radio button, only "plot1" is rendered. Instead, I would like both "plot1" and "plot2" to be rendered in the main panel (when first invoking the App and when clicking the "Base rate" radio button). Say one beneath the other. I would like a click of the "Spreads" radio button to continue rendering only "plot2", as it currently does.
I have tried modifying, in ui section, conditionalPanel(condition = "input.tab2 == 'Base rate'",plotOutput("plot1")), by adding tagList(plotOutput("plot1"),plotOutput("plot2")) but this and other attempts have not worked.
I've had no problems with multiple plots when running this with fluidPage instead of pageWithSidebar, so I suspect there is some peculiarity with pageWithSidebar and/or conditionalPanel that I don't yet understand.
I have resisted trying renderUI to resolve this, but maybe that's the answer. I've been trying to move away from renderUI for code readability/flow reasons.
MWE code:
rm(list = ls())
library(shiny)
rate1 <- matrix(c(1:20), 20, 1, dimnames = list(NULL,c("Base rate")))
rate2 <- matrix(c(21:40), 20, 1, dimnames = list(NULL,c("Spreads")))
ui <- pageWithSidebar(
headerPanel("Model"),
sidebarPanel(),
mainPanel(
tabsetPanel(
tabPanel("Rates", value=2,
fluidRow(
radioButtons(
inputId = 'tab2',
label = "",
choices = c('Base rate','Spreads'),
selected = 'Base rate',
inline = TRUE
)
),
conditionalPanel(condition = "input.tab2 == 'Base rate'",plotOutput("plot1")),
conditionalPanel(condition = "input.tab2 == 'Spreads'", plotOutput("plot2")),
),
id = "tabselected"
)
)
)
server <- function(input,output,session)({
output$plot1 <-renderPlot({plot(rate1)})
output$plot2 <-renderPlot({plot(rate2)})
}) # close server
shinyApp(ui, server)
Now the above MWE fixed to address the 2 comments by Stéphane Laurent (can't use same plot > 1 time, and pageWithSidebar replaced with fluidPage/sidebarLayout since pageWithSidebar is deprecated:
rm(list = ls())
library(shiny)
rate1 <- matrix(c(1:20), 20, 1, dimnames = list(NULL,c("Base rate")))
rate2 <- matrix(c(21:40), 20, 1, dimnames = list(NULL,c("Spreads")))
ui <- fluidPage(
titlePanel("Model"),
sidebarLayout(
sidebarPanel(),
mainPanel(
tabsetPanel(
tabPanel("Rates", value=2,
fluidRow(
radioButtons(
inputId = 'tab2',
label = "",
choices = c('Base rate','Spreads'),
selected = 'Base rate',
inline = TRUE
)
),
conditionalPanel(condition = "input.tab2 == 'Base rate'",plotOutput("plot1"),plotOutput("plot2")),
conditionalPanel(condition = "input.tab2 == 'Spreads'",plotOutput("plot3")),
),
id = "tabselected"
)
)
)
)
server <- function(input, output) {
output$plot1 <-renderPlot({plot(rate1)})
output$plot2 <-renderPlot({plot(rate2)})
output$plot3 <-renderPlot({plot(rate2)})
}
shinyApp(ui, server)
I came across this issue while trying to user shiny::renderUI to generate a data table output via renderDataTable upon clicking an actionButton. This situation works fine until I try to implement two instances of the same thing in separate tabs. In this case, whichever button is clicked first (be it in tab 1 or tab 2) works correctly; but then the other tab's button doesn't produce the data table. Is there a way to get two buttons, in separate shinydashboard tabs, to render data tables independently?
The following shows reproducible code to demonstrate the issue. A small data frame is populated with random values. Clicking the action button calculates new numbers for the data table--but only for the first data table that is rendered.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Test example"),
dashboardSidebar(
sidebarMenu(
menuItem("Tab 1", tabName = "tab_1"),
menuItem("Tab 2", tabName = "tab_2")
)
),
dashboardBody(
tabItems(
tabItem("tab_1",
h2("Tab 1"),
fluidRow(
actionButton("do_refresh_tab_1", "Refresh data")
),
fluidRow(
uiOutput("tab1")
)
),
tabItem("tab_2",
h2("Tab 2"),
fluidRow(
actionButton("do_refresh_tab_2", "Refresh data")
),
fluidRow(
uiOutput("tab2")
)
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$do_refresh_tab_1, {
df <- data.frame(value = rnorm(3),
Measurement = rnorm(3),
stringsAsFactors = FALSE)
output$tab1 <- renderUI({
output$temp <- renderDataTable(df)
dataTableOutput("temp")
})
})
observeEvent(input$do_refresh_tab_2, {
df <- data.frame(value = rnorm(3),
Measurement = rnorm(3),
stringsAsFactors = FALSE)
output$tab2 <- renderUI({
output$temp <- renderDataTable(df)
dataTableOutput("temp")
})
})
}
shinyApp(ui, server)
Before we go to the solution, a couple of general rules of thumb.
Avoid, in fact, never put a render call inside another render call.
Never put a render call inside an observe call
Never put a render call inside a reactive call
Each observe, reactive and render call should be standalone and must perform 1 task/function.
The reason why only the first click was working and the second click on the other tab was not, was because you were attempting to create multiple output bindings with the same id (temp).
Every output element must have its own unique id.
Also, using uiOutput and dataTableOutput for this use case is kinda redundant here.
Here is the simplified code,
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Test example"),
dashboardSidebar(
sidebarMenu(
menuItem("Tab 1", tabName = "tab_1"),
menuItem("Tab 2", tabName = "tab_2")
)
),
dashboardBody(
tabItems(
tabItem("tab_1",
h2("Tab 1"),
fluidRow(
actionButton("do_refresh_tab_1", "Refresh data")
),
fluidRow(
dataTableOutput("table1")
)
),
tabItem("tab_2",
h2("Tab 2"),
fluidRow(
actionButton("do_refresh_tab_2", "Refresh data")
),
fluidRow(
dataTableOutput("table2")
)
)
)
)
)
server <- function(input, output, session) {
output$table1 <- renderDataTable({
req(input$do_refresh_tab_1)
df <- data.frame(value = rnorm(3),
Measurement = rnorm(3),
stringsAsFactors = FALSE)
return(df)
})
output$table2 <- renderDataTable({
req(input$do_refresh_tab_2)
df <- data.frame(value = rnorm(3),
Measurement = rnorm(3),
stringsAsFactors = FALSE)
return(df)
})
}
shinyApp(ui, server)
I am using sliderTextInput from the shinyWidgets package. I am having trouble making the labels readable.
To begin with, they are too small, which I have fixed using css. However, now the labels overlap so it is hard to read them.
I would like to be able to do one or both of the following:
Angle the text at 45 or 90 degrees so labels don't overlap.
Reduce the number of labels so there is more space between them. I tried doing this in the choices = argument but that then stops those options from being selected. I think this might be to do with this relating to text rather than numbers, so that might make this impossible.
I have tried using sliderInput instead, but that presents different issues. I almost got it working using this answer, but the additional problem is that I have the input server side, fed in as a uiOutput, which is something I can't change because it's important for a different element. This approach doesn't work with the linked solution - I end up with nice enough labels but the breaks are daily rather than monthly.
Here is a pared down example:
Using sliderTextInput (labels overlapping)
library(shinydashboard)
library(shinyWidgets)
library(shiny)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tags$head(tags$style(type = "text/css", ".irs-grid-text {font-size: 12pt !important;")),
fluidRow(
box(uiOutput("month_selection"))
)
)
)
server <- function(input, output) {
output$month_selection <- renderUI({
sliderTextInput(
inputId = "month_select",
label = "",
grid = TRUE,
force_edges = TRUE,
choices = seq(from = as.Date("2017-01-01"), to = as.Date("2019-12-31"),by = 30)
)
})
}
shinyApp(ui, server)
Using sliderInput (doesn't run)
library(shinydashboard)
library(shinyWidgets)
library(shiny)
monthStart <- function(x) {
x <- as.POSIXlt(x)
x$mday <- 1
as.Date(x)
}
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tags$head(tags$style(type = "text/css", ".irs-grid-text {font-size: 12pt !important;")),
fluidRow(
box(uiOutput("month_selection"))
)
)
)
server <- function(input, output) {
output$month_selection <- renderUI({
sliderInput(
inputId = "month_select",
label = "",
min = as.Date("2017-01-01"),
max = as.Date("2019-12-31"),
value = as.Date("2019-12-31"),
timeFormat = "%b %Y",
animate = TRUE
)
})
sliderMonth <- reactiveValues()
observe({
sliderMonth$Month <- as.character(monthStart(input$month_select))
})
}
shinyApp(ui, server)
> Warning: Error in as.POSIXlt.default: do not know how to convert 'x' to class “POSIXlt”
Solution (credits go to Victor Perrier) taken from the shinyWidgets issue created by the asker.
Text can be roteted with nothing more than CSS. The class .irs-grid-text identifies the labels of the sliderTextInput widget. With transform the text can be rotated so that it does not overlap.
library(shinydashboard)
library(shinyWidgets)
library(shiny)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tags$head(tags$style(
type = "text/css",
".irs-grid-text {font-size: 12pt !important; transform: rotate(-90deg) translate(-30px);"
)),
fluidRow(
box(uiOutput("month_selection"), height = "200px")
)
)
)
server <- function(input, output) {
output$month_selection <- renderUI({
sliderTextInput(
inputId = "month_select",
label = "",
grid = TRUE,
force_edges = TRUE,
choices = seq(from = as.Date("2017-01-01"), to = as.Date("2019-12-31"), by = 30)
)
})
}
shinyApp(ui, server)
I'm working on a dashboard where sometimes I need to call the input's choice name and other times it's value, but I only know how to get the latter. Is there a way to call the first one?
Here is a minimum reproducible example:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
selectInput(
"input",
h5("The output should give the choice name instead of it's value"),
choices=c(
"Name 1" = 1,
"Name 2" = 2,
"Name 3" = 3
)
),
textOutput("output")
)
)
server <- function(input, output, session) {
output$output <- renderPrint({paste(input$input)})
}
shinyApp(ui = ui, server = server)
I think it is easiest to create a data.frame with the choices and the corresponding names in advance, and use that to look up the name of the selected input. A working example is given below, hope this helps!
library(shiny)
library(shinydashboard)
choices_df = data.frame(
names = c('Name 1', 'Name 2', 'Name 3'),
id = seq(3)
)
ui <- dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
selectInput(
"input",
h5("The output should give the choice name instead of it's value"),
choices= setNames(choices_df$id,choices_df$names)
),
textOutput("output")
)
)
server <- function(input, output, session) {
output$output <- renderPrint({paste(choices_df$names[choices_df$id==input$input])})
}
shinyApp(ui = ui, server = server)
In a shiny app I wanted to include an animated tabBox, similar to animated sliderInput - after specified time the tab would automatically switch to the next one. This doesn't seem to be an option in tabBox. I tried two solutions, neither worked. First I tried to simply link animation from sliderInput to tabBox:
library("shiny")
library("shinydashboard")
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sliderInput(inputId = "slider", label = "Player", min = 1, max = 4, value = 1,
animate = animationOptions(interval = 1000, loop = TRUE)),
textOutput(outputId = "text")
),
dashboardBody(
tabBox(
id="tabbox",
tabPanel(title = 1),
tabPanel(title = 2),
tabPanel(title = 3),
tabPanel(title = 4)
)
)
)
)
server <- function(input, output, session){
output$text <- renderText({paste0("tabbox: ", input$tabbox, " slider: ",input$slider, " reactive: ", A$a)})
A <- reactiveValues(a = 1)
observeEvent(
input$slider,
A$a <- input$slider
updateTabItems(session = session, inputId = "tabbox", selected = A$a)
)
}
shinyApp(ui=ui, server=server)
However, this code only changes the reactive value A$a, but doesn't change input$tabbox (A$a is there only so I could see which step fails).
The second solution I tried was to run this function on button click, but it also failed:
for(i in 1:4){
Sys.sleep(2)
updateTabItems(session = session, inputId = "tabbox", selected = i)
}
Questions:
Is it possible by just using R? How could it be done?