I'm trying to make a Shiny application that display multiple plots on different rows and allow user to select the proper tendencies by using the radioButtons situated beside the graph. The problem is that I'm not able to get the radioButtons located directly beside the plots.
I want:
And I get:
My code:
server.R:
library(shiny)
shinyServer(function(input, output) {
lapply(1:3, function(iter) {
output[[paste0("g",iter)]] <- renderPlot({
set.seed(iter)
xx <- rnorm(10)
yy <- rnorm(10)
plot(xx,yy)
abline(reg=lm(yy~xx), col=2, lwd=ifelse(input[[paste0("radio",iter)]]==1,2,1))
abline(reg=lm(yy~xx+0), col=3, lwd=ifelse(input[[paste0("radio",iter)]]==2,2,1))
})
})
})
ui.R:
library(shiny)
shinyUI(fluidPage(
titlePanel("My loop test"),
fluidRow(
column(6,
lapply(1:3, function(iter) {
plotOutput(paste0("g",iter))
}
)),
column(3,
lapply(1:3, function(iter){
radioButtons(paste0("radio",iter),label = "buttons", choices = list("with intercept"=1,"without intersept"=2),selected = 1)
}
))
)
))
I hope it's clear. I'm new to Shiny (but not R) and I'm still in the steep part of the learning curve!
Thanks
Maybe something like this:
shinyUI(fluidPage(
titlePanel("My loop test"),
lapply(1:3, function(iter) {
fluidRow(
column(
6,
plotOutput( paste0("g",iter) )
),
column(
3,
radioButtons(
paste0("radio", iter),
label = "buttons",
choices = list("with intercept"=1,"without intersept"=2),
selected = 1)
)
)
})
))
This is a good use case for modules. I didn't get the buttons to line up perfectly, but that could be fixed with some CSS:
library(shiny)
myModUI <- function(id) {
ns <- NS(id)
tagList(
fluidRow(
splitLayout(cellWidths=c("75%","25%"),
plotOutput(ns("g")),
radioButtons(ns("radio"),label = "buttons",
choices = list("with intercept"=1,"without intersept"=2),
selected = 1))
)
)
}
myMod <- function(input, output, server, seed) {
output$g <- renderPlot({
set.seed(seed)
xx <- rnorm(10)
yy <- rnorm(10)
plot(xx,yy)
abline(reg=lm(yy~xx), col=2, lwd=ifelse(input$radio==1,2,1))
abline(reg=lm(yy~xx+0), col=3, lwd=ifelse(input$radio==2,2,1))
})
return(reactive(input$radio))
}
server <- shinyServer(function(input, output, server) {
lapply(1:5,function(i) {
callModule(myMod,i,seed=i)
})
})
ui <- shinyUI(fluidPage(
titlePanel("My loop test"),
mainPanel(
lapply(1:5,function(i) {
myModUI(i)
})
)
))
shinyApp(ui=ui,server=server)
Note that fluidRow isn't enough, we have to use splitLayout
Related
I would like to render the bar plots stored in "Plotlist" through the shiny app. I am new to Shiny and request help regarding it. The code:
o<-list()
for(i in 1:10){
Z3<-seq(1+i,10+i,1)
o<-append(o,list(Z3))
}
Plotlist <- vector(mode = "list", 10)
for(i in 1:10){
s<-barplot(o[[i]],names.arg = paste("A",1:10,sep = "_"),main=paste("Plot",i))
Plotlist[[i]]<-recordPlot()
}
library(shiny)
ui<-fluidPage(titlePanel("Plots in a list"),
sidebarPanel(selectInput("plot", "Choose Plot:", choices=paste("Plot",1:10)),hr(),helpText("Trial Plots"),
mainPanel(plotOutput("BARPLOT"))))
server<-function(input, output) {
output$BARPLOT<-renderPlot(for(i in 1:10){Plotlist[[i]]})
}
shinyApp(ui,server)
Found a solution, Thank you Abdessabour Mtk
choices = 1:10
names(choices) <- paste("Plot",1:10)
shinyApp(
ui = fluidPage(
titlePanel("Plots in a list"),
sidebarPanel(
selectInput("plot", "Choose plot:", choices=choices),
hr(),
helpText("Trail plots")),
plotOutput("barplot")
),
server = function(input, output) {
output$barplot<-renderPlot({
i<- as.integer(input$plot)
Plotlist[[i]]
})
}
)
In order to print the specified plot you need access the selected value of selectinput inside the renderplot this is done by adding {i<-input$plot} where plot is the name of the input
choices = 1:10
names(choices) <- paste("Plot",1:10)
shinyApp(
ui = fluidPage(
titlePanel("Plots in a list"),
sidebarPanel(
selectInput("plot", "Choose Plot:", choices=choices),
hr(),
helpText("Trial Plots")),
plotOutput("barplot")
),
server = function(input, output) {
output$barplot<-renderPlot({
i<- as.integer(input$plot)
barplot(o[[i]],names.arg = paste("A",1:10,sep = "_"),main=paste("Plot",i))
}, width=400)
}
)
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 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.
I'm trying to use lapply to create multiple tabs in a tabsetPanel in Shiny based on this example: http://shiny.rstudio.com/gallery/creating-a-ui-from-a-loop.html. Below is my app.R code. When I run it, it doesn't create 5 tabs, nor does it print the name of each tab. What am I doing wrong?
library(shiny)
ui <- pageWithSidebar(
headerPanel("xxx"),
sidebarPanel(),
mainPanel(
tabsetPanel(id='t',
lapply(1:5, function(i) {
tabPanel(
title=paste0('tab', i),
textOutput(paste0('a',i))
)
})
)
)
)
server <- function(input, output) {
observe({
print(input$t)
})
lapply(1:5, function(j) {
output[[paste0('a',j)]] <- renderPrint({
input$t
})
})
}
shinyApp(ui, server)
It's a bit tricky, because tabsetPanel does not accept a list of tabset as an argument. You can use do.call to "unlist" arguments:
mainPanel(
do.call(tabsetPanel, c(id='t',lapply(1:5, function(i) {
tabPanel(
title=paste0('tab', i),
textOutput(paste0('a',i))
)
})))
)
stack.app <- function(n = 5){
library(shiny)
ui <- pageWithSidebar(
headerPanel("xxx"),
sidebarPanel(
verbatimTextOutput("show_selected")
),
mainPanel(
uiOutput('my_tabs')
)
)
server <- function(input, output, session) {
output$my_tabs <- renderUI({
### Had to hicjack this from shiny to get it to work...
shiny:::buildTabset(
id = "t",
lapply(1:n, function(i){
tabPanel(title = sprintf("tt_%s",i),
HTML(sprintf("This is tab %s content", i))
)
}), paste0("nav nav-","tabs")) %>% (function(x){
tags$div(class = "tabbable", x[[1]], x[[2]])
})
})
output$show_selected <- renderPrint({
sprintf("SELECTED TAB IS : %s", input$t)
})
}
shinyApp(ui, server)
}
Which results in:
I am pretty new to Shiny and dealing with the following problem, upon pressing an actionButton in shiny, I want it to do multiple calculations. I use the handler of observeEvent.
An example:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(`
actionButton("calc","calculate stuff")),
mainPanel(
textOutput("result")
)
)
)
server <- function(input,output){
observeEvent(input$calc, {output$result <- renderText({"only this is not enough"}) })
}
shinyApp(ui,server')`
Now what I would want is where the output$result is made in the server-observeEvent, I would like to perform additional tasks, say assign a variable a <- 12, calculate B4 <- input$ID1*inputID2 etc.
This can not be hard I imagine.. but I am just not getting there.
kind regards,
Pieter
You can use isolate, see this example:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput(inputId = 'x', label = 'Select a value for x', value = 1),
actionButton( "calc", "calculate stuff" )
),
mainPanel(
textOutput("result")
)
)
)
server <- function(input, output) {
output$result <- renderText({
input$calc
isolate({
y<- input$x *2
paste("The result is:", y)
})
})
}
shinyApp(ui, server)