I have the shiny app below which by default displays a plot. When I click the actionButton() it hides it but then I want to click the same actionButton() again and display it and so forth.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("hideshow_plot",
"HideShow plot")
),
mainPanel(
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
showPlot <- reactiveVal(TRUE)
observeEvent(input$hideshow_plot, {
showPlot(FALSE)
})
output$car_plot <- renderPlot({
if (showPlot()){
plot(cars)
}
else{
}
})
}
shinyApp(ui = ui, server = server)
You can do
observeEvent(input$hideshow_plot, {
showPlot(!showPlot())
})
to alternate TRUE/FALSE at each click.
Considered to use shinyjs?
library(shiny)
ui <- fluidPage(
shinyjs::useShinyjs(),
sidebarLayout(
sidebarPanel(
actionButton("hideshow_plot",
"HideShow plot")
),
mainPanel(
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
observeEvent(input$hideshow_plot, {
shinyjs::toggle("car_plot")
})
output$car_plot <- renderPlot({
plot(cars)
})
}
shiny::shinyApp(ui, server)
I need to create conditional 3 levels of tabs the first level or tabPanel includes three tabs
"NUTS","SWEETS","DRINKS"
so the
level1<-list(DRINKS,SWEETS,NUTS)
the second level or is conditional on the first level
for example after selecting DRINKS, would be juices, energydrinks, hotdrinks
the third level would be after selecting energy drinks to "powerhorse","redbull"
tried code but not working is this
lists -------------------------------------------------------------------
library(shiny)
library(reshape2)
library(dplyr)
hotdrinks<-list('hotdrinks'=list("tea","green tea"))
juices<-list('juices'=list("orange","mango") )
energydrinks<-list('energydrinks'=list("powerhorse","redbull"))
drinks<-list('drinks'=list(hotdrinks,juices,energydrinks))
biscuits<-list('bisc'=list("loacker","tuc"))
choc<-list('choc'=list("aftereight","lindt") )
gum<-list('gum'=list("trident","clortes") )
sweets<-list('sweets'=list(gum,juices,energydrinks))
almonds<-list('almonds'=list("salted","roasted") )
pistcio<-list('pistcio'=list("flavourd","roasted"))
nuts<-list('nuts'=list(almonds,pistcio))
all_products<-list(sweets,nuts,drinks)
mt<-melt(all_products)
mt2<-mt%>%mutate("Price"=c(23,34,23,23,54,32,45,23,12,56,76,34,62,12,98,43),
"Quantity"=c(10,20,26,22,51,52,45,23,12,56,76,55,62,12,98,43))
t1<-mt2[,c(5,3,1,8,7)]
t1
colnames(t1)<-c("CAT","PN","SP","Quantity","Price")
t2<-list(unique(t1$CAT))
t2
app ---------------------------------------------------------------------
library(shiny)
server <- function(input, output,session) {
observe({print(input$t)})
observe({print(input$u)})
observe({print(input$v)})
t3<-t1%>%filter(t1$CAT==input$t)
print(t3)
t4<-list(unique(t3$PN))
print(t4)
t5<-t3%>%filter(t3$PN==input$r)
print(t5)
t6<-list(unique(t5$SP))
print(t6)
t7<-reactive({
t1%>%filter(t1$CAT==input$t,t1$PN==input$u,t1$SP==inptut$v)
print(t7())
})
output$mytable <- DT::renderDataTable({
t7
})
lapply(1:5, function(j) {
DT::dataTableOutput("mytable")
})
}
ui <- pageWithSidebar(
headerPanel("xxx"),
sidebarPanel(),
mainPanel(
do.call(tabsetPanel, c(id='t',lapply(unlist(t2), function(i) {
tabPanel(
do.call(tabsetPanel, c(id='u',lapply(unlist(t4), function(i) {
tabPanel(
do.call(tabsetPanel, c(id='v',lapply(unlist(t6), function(i) {
tabPanel(DT::dataTableOutput("mytable")
)
})))
)
})))
)
})))
)
)
shinyApp(ui, server)
the manual steps
hotdrinks<-list("tea","green tea")
juices<-list("orange","mango")
energydrinks<-list("powerhorse","redbull")
drinks<-list(hotdrinks,juices,energydrinks)
biscuits<-list("loacker","tuc")
choc<-list("aftereight","lindt")
gum<-list("trident","clortes")
sweets<-list(gum,juices,energydrinks)
almonds<-list("salted","roasted")
pistcio<-list("flavourd","roasted")
nuts<-list(almonds,pistcio)
all_products<-list(sweets,nuts,drinks)
choc<-
tabsetPanel(
tabPanel("aftereight"),
tabPanel("lindt")
)
bisc<-
tabsetPanel(
tabPanel("loacker"),
tabPanel("tuc")
)
gm<-
tabsetPanel(
tabPanel("trident"),
tabPanel("clortes")
)
hdrinks<-
tabsetPanel(
tabPanel("tea"),
tabPanel("green tea")
)
jcs<-
tabsetPanel(
tabPanel("orange"),
tabPanel("mango")
)
ngdrinks<-
tabsetPanel(
tabPanel("powerhorse"),
tabPanel("redbull")
)
al<-
tabsetPanel(
tabPanel("salted"),
tabPanel("roasted")
)
pst<-
tabsetPanel(
tabPanel("flavourd"),
tabPanel("roasted")
)
runApp(list(
ui = shinyUI( fluidPage(
sidebarLayout(
sidebarPanel(width = 2),
mainPanel(tabsetPanel(id='conditioned',
tabPanel("sweets",value=1,
tabsetPanel(
tabPanel("biscuits",
tabsetPanel(bisc)),
tabPanel("choc",
tabsetPanel(choc)),
tabPanel("gum",
tabsetPanel(gm))
)),
tabPanel("nuts",value=2,
tabsetPanel(
tabPanel("almonds",
tabsetPanel(al)),
tabPanel("pistcio",
tabsetPanel(pst))
)),
tabPanel("drinks",value=3,
tabsetPanel(
tabPanel("hotdrinks",
tabsetPanel(hdrinks)),
tabPanel("juices",
tabsetPanel(jcs)),
tabPanel("energydrinks",
tabsetPanel(ngdrinks))
))
))
))),
server = function(input, output, session) {}
))
as you can see this approach is too vulnerable to mistake, thanks in advance.
hotdrinks<-list("tea","green tea")
juices<-list("orange","mango")
energydrinks<-list("powerhorse","redbull")
drinks<-list("hotdrinks"=hotdrinks, "juices"=juices, "energydrinks"=energydrinks)
lst_drinks <- lapply(seq_along(drinks),
#browser()
#create 2nd level, tab name with the corresponding 3rd level list
function(x) tabPanel(names(drinks[x]),
#create tabsetPanel for hdrinks, jcs, ngdrinks level i.e. 3rd level
do.call("tabsetPanel",
lapply(drinks[[x]], function(y) tabPanel(y))
)
)
)
hdrinks<-
tabsetPanel(
tabPanel("tea"),
tabPanel("green tea")
)
jcs<-
tabsetPanel(
tabPanel("orange"),
tabPanel("mango")
)
ngdrinks<-
tabsetPanel(
tabPanel("powerhorse"),
tabPanel("redbull")
)
runApp(list(
ui = shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(width = 2),
mainPanel(tabsetPanel(id='conditioned',
tabPanel("drinks",value=3,
tabsetPanel(
tabPanel("hotdrinks",
#No need for tabsetPanel as hdrinks already has one, therefore I removed it in lapply
tabsetPanel(hdrinks)),
tabPanel("juices",
tabsetPanel(jcs)),
tabPanel("energydrinks",
tabsetPanel(ngdrinks))
)),
tabPanel("drinks-test",
do.call("tabsetPanel", lst_drinks))
))
))),
server = function(input, output, session) {}
))
The Full solution
hotdrinks<-list("tea","green tea")
juices<-list("orange","mango")
energydrinks<-list("powerhorse","redbull")
drinks<-list("hotdrinks"=hotdrinks,"juices"=juices,"energydrinks"=energydrinks)
biscuits<-list("loacker","tuc")
choc<-list("aftereight","lindt")
gum<-list("trident","clortes")
sweets<-list("gum"=gum,"biscuits"=biscuits,"choc"=choc)
all <- list("drinks"=drinks, "sweets"=sweets)
all_lst <- lapply(seq_along(all), function(z) tabPanel(names(all)[z],
do.call("tabsetPanel",
lapply(seq_along(all[[z]]), function(x) tabPanel(names(all[[z]][x]),
do.call("tabsetPanel",
lapply(all[[z]][[x]], function(y) tabPanel(y, DT::dataTableOutput(y)))
)
)
)
)
)
)
runApp(list(
ui = shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(width = 2),
mainPanel(do.call("tabsetPanel", c(id='conditioned', all_lst)))
))),
server = function(input, output, session) {
observe({
nms = unlist(all)
names(nms) <- sub('\\d', '', names(nms))
for(i in seq_along(nms)){
#browser()
local({
nm = nms[i]
CAT_var = unlist(strsplit(names(nm), '\\.'))[1]
PN_var = unlist(strsplit(names(nm), '\\.'))[2]
SP_var = nm[[1]]
output[[SP_var]] <- DT::renderDataTable({filter(t1, CAT==CAT_var, PN==PN_var, SP==SP_var)})
})
}
})
}
))
I have a small Shiny app that generates some data whenever the New data button is pressed. The Show plot button shows a hidden plot. I would like the plot to be hidden again automatically whenever the New data button is pressed to make a new data set. A bonus would be for the plot to be hidden also as soon as the slider is changed. I am not looking for a toggle action.
I tried adapting this example that uses conditional panel but I could not successfully figure out how to correctly change the values$show between TRUE and FALSE.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "number",
label = "Pick a number",
min = 6,
max = 12,
value = 8),
actionButton("new_data",
"New data"),
actionButton("show_plot",
"Show plot")
),
mainPanel(
tableOutput("char_table"),
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
t <- eventReactive(input$new_data, {
r <- input$number
c <- r - 1
mat <- matrix(sample(0:1,r*c, replace=TRUE),r,c)
})
output$char_table <- renderTable({
t()
})
p <- eventReactive(input$show_plot, {
plot(cars)
})
output$car_plot <- renderPlot({
p()
})
}
shinyApp(ui = ui, server = server)
You can use a reactive value and a if to control the plot.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "number",
label = "Pick a number",
min = 6,
max = 12,
value = 8),
actionButton("new_data",
"New data"),
actionButton("show_plot",
"Show plot")
),
mainPanel(
tableOutput("char_table"),
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
showPlot <- reactiveVal(FALSE)
t <- eventReactive(input$new_data, {
showPlot(FALSE)
r <- input$number
c <- r - 1
mat <- matrix(sample(0:1,r*c, replace=TRUE),r,c)
})
output$char_table <- renderTable({
t()
})
observeEvent(input$number, {
showPlot(FALSE)
})
observeEvent(input$show_plot, {
showPlot(TRUE)
})
output$car_plot <- renderPlot({
if (showPlot())
plot(cars)
})
}
shinyApp(ui = ui, server = server)
Alternate solution using shinyjs which is handy in these situations.
library(shiny)
library(shinyjs)
ui <- fluidPage( shinyjs::useShinyjs(),
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "number",
label = "Pick a number",
min = 6,
max = 12,
value = 8),
actionButton("new_data",
"New data"),
actionButton("show_plot",
"Show plot")
),
mainPanel(
tableOutput("char_table"),
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
t <- eventReactive(input$new_data, {
hide("car_plot")
r <- input$number
c <- r - 1
mat <- matrix(sample(0:1,r*c, replace=TRUE),r,c)
})
output$char_table <- renderTable({
t()
})
observeEvent(input$show_plot, {
show("car_plot")
})
output$car_plot <- renderPlot({
plot(cars)
})
}
shinyApp(ui = ui, server = server)
I have looked at all the solutions on SO using grid.arrange but it doesn't really achieve what I want.
Let's assume I have a list of grobs that are generated within a reactive environment in RShiny.
I would like to create a mainPanel where those graphs are on 2 columns (until that point, it's all feasible with grid.arrange) but where each line corresponds to a fluidRow element.
A barebone example of this would be
ui <- fluidPage(
titlePanel("TEST"),
sidebarPanel(width=3,
actionButton(inputId = 'launchCalcButton',label = 'Launch Calc')
),
mainPanel(
uiOutput("resultsPlotUI")
)
)
server <- function(input,output){
graphsList <- eventReactive(input$launchCalcButton, {
a <- lapply(1:10,function(i){
return(
ggplot(data = data.frame(a=rnorm(10),b=rnorm(10)),aes(x=a,y=b))
+geom_point()
)
})
return(a)
})
output$resultsPlot <- renderPlot({
do.call(grid.arrange,c(graphsList(),ncol=2))
})
output$resultsPlotUI <- renderUI({
fluidRow(
column(12,
plotOutput(
outputId = 'resultsPlot'
)
)
)
})
}
app = shinyApp(ui,server)
runApp(app)
All the graphs end up squeezed into one single line whereas I would want them to be split between lines.
You just need to set up height parameter for the plotOutput:
library(shiny)
library(gridExtra)
ui <- fluidPage(
titlePanel("TEST"),
sidebarPanel(width=3,
actionButton(inputId = 'launchCalcButton',label = 'Launch Calc')
),
mainPanel(
uiOutput("resultsPlotUI")
)
)
server <- function(input,output){
graphsList <- eventReactive(input$launchCalcButton, {
a <- lapply(1:10,function(i){
return(
ggplot(data = data.frame(a=rnorm(10),b=rnorm(10)),aes(x=a,y=b))
+geom_point()
)
})
return(a)
})
output$resultsPlot <- renderPlot({
l <- length(graphsList())/2
print(l)
do.call(grid.arrange,c(graphsList(),ncol=2))
})
output$resultsPlotUI <- renderUI({
fluidRow(
column(12,
plotOutput(
outputId = 'resultsPlot', height = 600
)
)
)
})
}
app = shinyApp(ui,server)
runApp(app)
Exactly in this place:
output$resultsPlotUI <- renderUI({
fluidRow(
column(12,
plotOutput(
outputId = 'resultsPlot', height = 600
)
)
)
})
I have set it up to 600 px (height = 600) but you can choose whatever you want.
how to make 2 selectInput and one checkbox in one line, the display will be like this:
x axis : ----- y axis : ------- -check
and the code is :
UI :
library(shiny)
shinyUI(fluidPage(
titlePanel("Shiny"),
sidebarLayout(
sidebarPanel(
),
mainPanel(
uiOutput("scatcoefgwr")
)
)
))
server :
shinyServer(function(input, output) {
output$scatcoefgwr <- renderUI({
list(
selectInput("axisx", "x axis:",choices = c("1","2","3")),
selectInput("axisy", "y axis:",choices = c("1","2","3")),
checkboxInput("scatterD3_ellipsesgwr", "check", value = FALSE)
)
})
})
Here's one way using columns
#ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("Shiny"),
fluidRow(
column(width=2,uiOutput("one")),
column(width=2,uiOutput("two")),
column(width=2,uiOutput("three"))
)
))
change the widths as you need.
#server.R
shinyServer(function(input, output) {
output$one <- renderUI({
list(
selectInput("axisx", "x axis:",choices = c("1","2","3"))
)
})
output$two <- renderUI({
list(
selectInput("axisy", "y axis:",choices = c("1","2","3"))
)
})
output$three <- renderUI({
list(
checkboxInput("scatterD3_ellipsesgwr", "check", value = FALSE)
)
})
})