for (i in 1:4){
v <- rnorm(50)
plot(v, main=paste("Iteration ", i))
}
I have code that iterates through and produces a plot each time, like the above. How would I allow a user to click to see the next plot in a Shiny application?
Use the slickR package to make a nice slideshow.
library(shiny)
library(slickR)
library(svglite)
plots <- lapply(1:5, function(i){
xmlSVG({plot(rnorm(50), main=paste0("Iteration ", i))}, standalone = TRUE)
})
#make the plot self contained SVG to pass into slickR
plotsAsSVG <- sapply(plots, function(sv){
paste0("data:image/svg+xml;utf8,",as.character(sv))
})
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
####
),
mainPanel(
slickROutput("slickr", width="500px")
)
)
)
server <- function(input, output) {
output$slickr <- renderSlickR({
imgs <- plotsAsSVG
slickR(imgs)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Related
I wonder if someone can explain the behavior of the progressBar().
I have trimmed my shiny app to the bare minimum to reproduce this post.
Now to the problem. When I select "AllRuns", the progress bar pops up and then goes away
before the graphic is displayed. But when I select "scatter", the progress bar nicely waits
until the scatter plot is displayed on the main panel. Is this a normal behavior?
How can I make the progress bar wait until the graphic displays when "AllRuns" is selected?
UPDATE The dataset can be read into R from google docs. it takes about 20 seconds to load into R.
library(shiny)
library(tidyverse)
library(DT)
library(data.table)
final <- fread("https://docs.google.com/spreadsheets/d/170235QwbmgQvr0GWmT-8yBsC7Vk6p_dmvYxrZNfsKqk/pub?output=csv")
runs<- c("AllRuns","scatter")
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(inputId = "run",
label = "Chinook Runs",
choices = runs,
selected = "AllRuns"),
sliderInput(inputId = "Yearslider",
label="Years to plot",
sep="",
min=2000,
max=2014,
value=c(2010,2012))),
mainPanel(
plotOutput("plot")
)))
server <- function(input, output,session) {
session$onSessionEnded(function() {
stopApp()
})
plot_all <- reactive({
final[final$year >= input$Yearslider[1] & final$year <= input$Yearslider[2], ]
})
plotscatter <- reactive({
rnorm(100000)
})
dataInput <- reactive({
if (input$run == "AllRuns") {
plot_all()
}else{
plotscatter()
}
})
# Plot data
create_plots <- reactive({
withProgress(message="Creating graphic....",value = 0, {
n <- 10
for (i in 1:n) {
incProgress(1/n, detail = input$run)
Sys.sleep(0.1)
}
#Make the plots
theme_set(theme_classic())
switch(input$run,
"AllRuns" = ggplot(plot_all(),aes(SampleDate,Count,color = race2)) +
geom_point() + theme_bw() +
labs(x="",y="Number in thousands",title="All Salmon Runs combined"),
"scatter" = plot(plotscatter(),col="lightblue")
)
})#Progress bar closing brackets
})#create_plots closing brackets
output$plot <- renderPlot({
create_plots()
})
}
# Run the application
shinyApp(ui = ui, server = server)
It is simple that the progress bar is updated by the for-loop and the plot code only run after the for-loop. So the progress-bar reach the end, then plot code started. This kind of progress-bar would work if you are process something along with for-loop for example
list_of_files # assume you have a list of data file to read and process
max_progress <- length(list_of_files)
withProgress(message="Creating graphic....",value = 0, {
for (i in 1:max_progress) {
data <- read_csv(list_of_files[i])
... # doing something here
# once the processing code done next line of code will update the progress bar
incProgress(1/n, detail = input$run)
}
})
If you want to display loading one way to do it is using shinycssloaders::withSpinner() on the UI part which would show an animation of loading while UI is updating by server side.
The withProgress would be more useful when you have a list of items to process.
library(shiny)
library(tidyverse)
library(DT)
library(data.table)
library(shinycssloaders)
final <- fread("https://docs.google.com/spreadsheets/d/170235QwbmgQvr0GWmT-8yBsC7Vk6p_dmvYxrZNfsKqk/pub?output=csv")
runs<- c("AllRuns","scatter")
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(inputId = "run",
label = "Chinook Runs",
choices = runs,
selected = "AllRuns"),
sliderInput(inputId = "Yearslider",
label="Years to plot",
sep="",
min=2000,
max=2014,
value=c(2010,2012))),
mainPanel(
withSpinner(plotOutput("plot"))
)))
server <- function(input, output,session) {
session$onSessionEnded(function() {
stopApp()
})
plot_all <- reactive({
final[final$year >= input$Yearslider[1] & final$year <= input$Yearslider[2], ]
})
plotscatter <- reactive({
rnorm(100000)
})
dataInput <- reactive({
if (input$run == "AllRuns") {
plot_all()
}else{
plotscatter()
}
})
# Plot data
create_plots <- reactive({
#Make the plots
theme_set(theme_classic())
switch(input$run,
"AllRuns" = ggplot(plot_all(),aes(SampleDate,Count,color = race2)) +
geom_point() + theme_bw() +
labs(x="",y="Number in thousands",title="All Salmon Runs combined"),
"scatter" = plot(plotscatter(),col="lightblue")
)
})#create_plots closing brackets
output$plot <- renderPlot({
create_plots()
})
}
# Run the application
shinyApp(ui = ui, server = server)
I want to make a shiny app where the user is able to select genes. Then he will see all the plots for those genes.
The selection part works fine (I think)
ui <- fluidPage(
titlePanel("Test"),
sidebarPanel(
selectInput("genes", "Genes:", seurat_genes, multiple = TRUE),
),
mainPanel(
uiOutput('out1')
)
)
Now I want to those selected genes to be plotted next to the sidebarPanel:
server <- function(input, output) {
output$out1 = renderUI({
p = FeaturePlot(sc, features=input$genes, cols=c("lightgrey", param$col), combine=FALSE)
names(p) = input$genes
for(i in names(p)) {
p[[i]] = plot.mystyle(p[[i]], title=i)
renderPlot(
print(p[[i]])
)
}
})
}
seurat_genes is data from the analysis with Seurat, which is a library for single-cell RNA-seq data. So the user specifies which genes he wants to look at and FeaturePlotgenerates those plots.
FeaturePlot is a function from Seurat which "Colors single cells on a dimensional reduction plot according to a 'feature' (i.e. gene expression, PC scores, number of genes detected, etc.)"
I'm fairly new to R and especially Shiny, so feel free to suggest any kind of improvements.
Found a solution that works for me:
library(shiny)
library(Seurat)
# This Data is from my Workspace. I have trouble loading it, so its a workaround and is my next Problem.
seurat_genes = sc.markers[["gene"]]
# Define UI for application that draws a histogram
ui <- fluidPage(
titlePanel("Einzeldarstellungen von Genen"),
sidebarPanel(
selectInput("genes", "Gene:", seurat_genes, multiple = TRUE),
),
mainPanel(
splitLayout(cellWidths = c("50%","50%"),uiOutput('out_umap'), uiOutput('out_ridge'))
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$out_umap = renderUI({
out = list()
if (length(input$genes)==0){return(NULL)}
for (i in 1:length(input$genes)){
out[[i]] <- plotOutput(outputId = paste0("plot_umap",i))
}
return(out)
})
observe({
for (i in 1:length(input$genes)){
local({ #because expressions are evaluated at app init
ii <- i
output[[paste0('plot_umap',ii)]] <- renderPlot({
return(FeaturePlot(sc, features=input$genes[[ii]], cols=c("lightgrey", param$col), combine=FALSE))
})
})
}
})
output$out_ridge = renderUI({
out = list()
if (length(input$genes)==0){return(NULL)}
for (i in 1:length(input$genes)){
out[[i]] <- plotOutput(outputId = paste0("plot",i))
}
return(out)
})
observe({
for (i in 1:length(input$genes)){
local({ #because expressions are evaluated at app init
ii <- i
output[[paste0('plot',ii)]] <- renderPlot({
return(RidgePlot(sc, features=input$genes[[ii]], combine=FALSE))
})
})
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have a function that's arranging a plot in a grid:
plotFunc <- function(a,b)
{
p <- qplot(a,b)
p2 <- xyplot(1~1)
r <- grid::rectGrob(gp=gpar(fill="grey90"))
t <- grid::textGrob("text")
g <- gridExtra::grid.arrange(t, p, p2, r, ncol=2)
return(g)
}
So the return value is:
"gtable" "gTree" "grob" "gDesc"
I want to use a shiny app in order to be able to select a and b values display the resulting plot and also have the option to save it to a file.
Here's my code:
data:
set.seed(1)
vals.df <- data.frame(b=1:6,a=sample(1:2,6,replace=T))
Shiny code:
library(shiny)
library(ggplot2)
library(lattice)
library(SpaDES)
library(devtools)
server <- function(input, output)
{
output$b <- renderUI({
selectInput("b", "B", choices = unique(dplyr::filter(vals.df,a == input$a)$b))
})
my.plot <- reactive({function(){plotFunc(a = input$a,b == input$b)}})
output$plot <- renderPlot({
my.plot()
})
output$save <- downloadHandler(
filename = function() {
paste0(input$a,"_",input$b,".png")
},
content = function(file) {
ggsave(my.plot(),filename=file)
}
)
}
ui <- fluidPage(
# App title ----
titlePanel("Feature Plots"),
# Sidebar layout with a input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# select name
selectInput("a", "A", choices = unique(vals.df$a)),
uiOutput("b"),
downloadButton('save', 'Save to File')
),
# Main panel for displaying outputs ----
mainPanel(
# The plot is called feature.plot and will be created in ShinyServer part
plotOutput("plot")
)
)
)
When I run shinyApp(ui = ui, server = server) and select a and b values from their lists a figure is not displayed to the screen and when I click the Save to File button I get this error:
ERROR: no applicable method for 'grid.draw' applied to an object of class "function"
I tried wrapping the my.plot() calls with grid.draw but I get the same error:
no applicable method for 'grid.draw' applied to an object of class "function"
Any idea?
Note that I can't get it to work even if plotFunc returns the ggplot2 object (i.e., the grid calls are commented out). But solving this for the example above is more general and would also solve it for the ggplot2 more specific case.
You can do like this:
my.plot <- reactive({
if(!is.null(input$a) & !is.null(input$b)){
plotFunc(a = input$a,b = input$b)
}
})
The change i did was to remove the function. I wasnt sure why you need it and i think it caused the error in the download. Moreover, the second input you give over as a logical statement == which will create an error.
Full code would read:
set.seed(1)
vals.df <- data.frame(b=1:6,a=sample(1:2,6,replace=T))
plotFunc <- function(a,b)
{
p <- qplot(a,b)
p2 <- xyplot(1~1)
r <- grid::rectGrob(gp=gpar(fill="grey90"))
t <- grid::textGrob("text")
g <- gridExtra::grid.arrange(t, p, p2, r, ncol=2)
return(g)
}
library(shiny)
library(ggplot2)
library(lattice)
library(SpaDES)
library(devtools)
server <- function(input, output)
{
output$b <- renderUI({
selectInput("b", "B", choices = unique(dplyr::filter(vals.df,a == input$a)$b))
})
my.plot <- reactive({
if(!is.null(input$a) & !is.null(input$b)){
plotFunc(a = input$a,b = input$b)
}
})
output$plot <- renderPlot({
my.plot()
})
output$save <- downloadHandler(
filename = function() {
paste0(input$a,"_",input$b,".png")
},
content = function(file) {
ggsave(my.plot(),filename=file)
}
)
}
ui <- fluidPage(
# App title ----
titlePanel("Feature Plots"),
# Sidebar layout with a input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# select name
selectInput("a", "A", choices = unique(vals.df$a)),
uiOutput("b"),
downloadButton('save', 'Save to File')
),
# Main panel for displaying outputs ----
mainPanel(
# The plot is called feature.plot and will be created in ShinyServer part
plotOutput("plot")
)
)
)
shinyApp(ui = ui, server = server)
I am new to R&shiny. I'd like to make a shiny app that the plot can be interactive with subset I choose, but ggplot cannot work with warning
Error in ouptut$Trendplot <- renderPlot({ : object 'ouptut' not found
It will be really appreciated if you can help to figure it works.
The following is my code:
library(shiny)
library(ggplot2)
# Define UI for application that draws a histogram
ui <- pageWithSidebar(
# Application title
headerPanel("Pre-report situation"),
# Sidebar with a slider input for number of bins
sidebarPanel(selectizeInput("DMS", "DMS:", choices = unique(datass$DMS)
)),
# Show a plot of the generated distribution
mainPanel(
h3(textOutput("caption")),
plotOutput("Trendplot"))
)
datass <- read.csv("C:/Users/yyu6/Documents/PR.csv", sep=",", stringsAsFactors = FALSE)
# Define server logic required to draw a histogram
server <- function(input, output) {
formulaText <- reactive({
input$DMS })
datasetInput <- reactive({
selection <- Input$DMS
subset(datass, DMS == selection)
})
output$caption <- renderText({formulaText()
})
ouptut$Trendplot <- renderPlot({
ggplot(datasetInput(), mapping = aes(x=DMS))+geom_histogram(stat = "count")
})
}
# Run the application
shinyApp(ui = ui, server = server)
I'm creating Shiny app and I want to use checkboxGroupInput in order to print out multiple plots. However, I want to print out plots only for the elements of checkboxGroupInput that were checked. There is a similar example in Shiny gallery to create UI elements in a loop that uses lapply. Here is a simplified version of that example to show what I want to do:
#server.R
library(shiny)
library(ggplot2)
shinyServer(function(input, output, session) {
numberInput <- reactive({
input$checkbox
})
lapply(1:10, function(i) {
output[[paste0('b', i)]] <- renderPlot({
qplot(x = rnorm(100, mean = as.numeric(numberInput()[i]))) +
ggtitle(paste("This plot was plotted with", numberInput()[i], "option"))
})
})
})
#ui.R
library(shiny)
shinyUI(fluidPage(
title = 'lapply example',
sidebarLayout(
sidebarPanel(
checkboxGroupInput("checkbox", "Checkbox",
choices = sample(1:10, 5))
),
mainPanel(
lapply(1:10, function(i) {
plotOutput(paste0('b', i))
})
)
)
))
This works, but obviously when Shiny tries to extract numberInput()[i] where i is bigger than number of currently checked elements, there is nothing to extract and instead of a plot there is an error. Therefore I need to somehow tell lapply to iterate only n number of times where n is length(input$checkbox).
I tried to use length(input$checkbox) directly, tried putting that element in the numberInput() reactive statement and returning it as the list, I tried to use reactiveValues() in a following way:
v <- reactiveValues(n = length(input$checkbox))
lapply(1:isolate(v$n), function(i) {
However, in all of those instances Shiny complains about lack of active reactive context.
So, what am I missing? How can I use length of input in lapply outside of reactive context?
I've generally had more luck using this approach (only because it's easier for me to wrap my head around it), but the idea is to render your plots into a UI on the server and then render the UI in ui.R
#server.R
library(shiny)
library(ggplot2)
server <- shinyServer(function(input, output, session) {
output$checks <- renderText(input$checkbox)
output$plots <- renderUI({
plot_output_list <-
lapply(input$checkbox,
function(i){
plotOutput(paste0("plot", i))
})
do.call(tagList, plot_output_list)
})
observe({
for (i in input$checkbox) {
local({
local_i <- i
output[[paste0("plot", local_i)]] <-
renderPlot({
qplot(x = rnorm(100, mean = as.numeric(local_i))) +
ggtitle(paste("This plot was plotted with", local_i, "option"))
})
})
}
})
})
#ui.R
library(shiny)
ui <- shinyUI(fluidPage(
title = 'lapply example',
sidebarLayout(
sidebarPanel(
checkboxGroupInput("checkbox", "Checkbox",
choices = sample(1:10, 5))
),
mainPanel(
verbatimTextOutput("checks"),
uiOutput('plots')
)
)
))
shinyApp(ui = ui, server = server)