Create and reuse data within R Shiny server - r

I'd like to create data once and reuse it in multiple plots. The example below creates the data in each plot, but how can I create it once (x) and have each plot use x?
ui <- shinyUI(
fluidPage(
sidebarLayout(
sidebarPanel(
numericInput(inputId = "mean", label = "Mean", value = 50)
),
mainPanel(
column(6,plotOutput(outputId = "hist1")
),
column(6,plotOutput(outputId = "hist2")
)
)
)
)
)
server <- function(input,output){
# I'd like to create the data just once here, and then reuse it in each plot
# x <- rnorm(100,input$mean,5)
output$hist1 <- renderPlot({
hist(rnorm(100,input$mean,5))
#hist(x)
})
output$hist2 <- renderPlot({
hist(rnorm(100,input$mean,5))
#hist(x)
})
}
runApp(list(ui = ui, server = server))

You can wrap your rnorm in a reactive expression to create a reactive conductor. Then, use the conductor in your endpoints (output$). See http://shiny.rstudio.com/articles/reactivity-overview.html.
server <- function(input,output){
# I'd like to create the data just once here, and then reuse it in each plot
x <- reactive(rnorm(100, input$mean, 5))
output$hist1 <- renderPlot({
hist(x())
})
output$hist2 <- renderPlot({
hist(x())
})
}

Wrapping the server codes with observe would do the job.
server <- function(input,output){
# I'd like to create the data just once here, and then reuse it in each plot
observe({
data <- rnorm(100,input$mean,5)
output$hist1 <- renderPlot({
hist(data)
#hist(rnorm(100,x,5))
})
output$hist2 <- renderPlot({
hist(data)
#hist(rnorm(100,x,5))
})
})
}

Related

Render multiple plots in shiny ui

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)

Run Shiny Reactive after Another Finishes

I have two outputs, a print and a plot. I would like to execute the print after the run button is pressed (working) and then when the print completes the plot part executes.
The reason for this is the print part does some calculations that take a few minutes and the output from that needs to go to the plot command.
Simple example:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton('run','Run')
),
mainPanel(
verbatimTextOutput("Descriptive"),
plotOutput("plotData",width = "700px", height = "500px")
)
)
)
server <- function(input, output) {
output$Descriptive <- renderPrint({
if(input$run>0){
return(isolate({
cat('Number of rows:', nrow(mtcars))
mpg2 <<- mtcars$mpg+3
cyl2 <<- mtcars$cyl+3
}))
}else{return(invisible())}
})
#### RUN AFTER DESCRIPTIVE COMPLETES ####
output$plotData <- renderPlot({
plot(mpg2,cyl2)
})
}
shinyApp(ui = ui, server = server)
I would suggest you to store the variable as reactiveValues and make the plot dependent on them. By this you can avoid the current global assignment and also make the plot update dependent on a change in its variables.
It could look like this:
global <- reactiveValues(mpg2 = mtcars$mpg, cyl2 = mtcars$cyl, txt = "")
observe({
if(input$run > 0){
Sys.sleep(5) # simulate minutes of calculating
global$txt <- paste('Number of rows:', nrow(mtcars))
global$mpg2 <- mtcars$mpg + 3
global$cyl2 <- mtcars$cyl + 3
}
})
Your app would look like this:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton('run','Run')
),
mainPanel(
verbatimTextOutput("Descriptive"),
plotOutput("plotData",width = "700px", height = "500px")
)
)
)
server <- function(input, output) {
global <- reactiveValues(mpg2 = mtcars$mpg, cyl2 = mtcars$cyl, txt = "")
observe({
if(input$run > 0){
Sys.sleep(5) # simulate minutes of calculating
global$txt <- paste('Number of rows:', nrow(mtcars))
global$mpg2 <- mtcars$mpg + 3
global$cyl2 <- mtcars$cyl + 3
}
})
output$Descriptive <- renderPrint({
if(nchar(global$txt)) return(global$txt)
})
#### RUN AFTER DESCRIPTIVE COMPLETES ####
output$plotData <- renderPlot({
plot(global$mpg2, global$cyl2)
})
}
shinyApp(ui = ui, server = server)

attempt to apply non-function

I'm trying to build a simple application that draws a histogram of a selected variable based on a subset filtered by the other input. I get the error in the line hist(dataX()$datasetInput()) which should return dataX$mpg. How can I fix it?
Full code:
library(shiny)
u <- shinyUI(pageWithSidebar(
headerPanel("Staz w bezrobociu"),
sidebarPanel(
selectInput("variable", "Variable:",
list("Milles/gallon",
"Horse power")
),
textInput("nc","Number of cylinders",value = 6)
),
mainPanel(
plotOutput("Plot")
)
))
s <- shinyServer(function(input, output)
{
dataX <- reactive({mtcars[mtcars$cyl==input$nc,,drop = FALSE]})
datasetInput <- reactive({
switch(input$variable,
"Milles/gallon" = mpg,
"Horse power" = hp)
})
output$Plot <- renderPlot({
hist(dataX()$datasetInput())
})
})
shinyApp(u,s)
You complicated the simple app.
You do not need to list all the columns in selectInput. You can just render it from the server side.
Same applies to the cylinders
Shortcuts like u and sare acceptable, but just stick to the naming conventions. It makes your life easy.
Below is a complete working app
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("Staz w bezrobociu"),
sidebarPanel(uiOutput("SelectColname"),
uiOutput("Cylinders")),
mainPanel(plotOutput("Plot"))
))
server <- shinyServer(function(input, output){
# Create a reactive dataset
dataX <- reactive({
mtcars
})
# Output number cylinders as select box
output$Cylinders <- renderUI({
selectInput("cylinders", "cylinders:", unique(dataX()$cyl))
})
# Output column names as selectbox
output$SelectColname <- renderUI({
selectInput("variable", "Variable:", colnames(dataX()[,c(1,4)]))
})
# Based on the selection by user, create an eventreactive plotdata object
plotdata <- eventReactive(input$cylinders, {
plotdata = dataX()[dataX()$cyl == input$cylinders, , drop = FALSE]
})
# Render the plot, the plot changes when new cylinder is selected
output$Plot <- renderPlot({
if (is.null(plotdata()))
return(NULL)
hist(
plotdata()[, input$variable],
xlab = input$variable,
main = paste(
"Histogram of" ,
input$variable
)
)
})
})
shinyApp(ui, server)

R shiny: How to create an output which serves as an input in shiny?

My task is to:
random two independent variables (A and B) from their normal distributions
display their histograms,
random 3rd variable (C) which distribution depends on the value B,
display the histogram of C.
I'd like all three histograms to be sensitive to changes in inputs.
The histograms of A and B are reactive.
What can I do with C? Any help would be appreciated.
Here is my try:
ui:
library(shiny)
fluidPage(
titlePanel("Random"),
sidebarLayout(
sidebarPanel(
sliderInput("obs",
"Number of observations:",
min = 1,
max = 100,
value = 50)
),
mainPanel(
tabsetPanel(type="tabs",
tabPanel("plot 1 and plot 2",plotOutput("plot1"), plotOutput("plot2")),
tabPanel("plot 3",plotOutput("plot3"))
))))
server:
shinyServer(function(input, output) {
output$plot1 <- renderPlot({
{
values_B <-rnorm(input$obs, 25,6)
assign('B_values', round(values_B), envir=.GlobalEnv)
hist(B_values, main="Histogram of B values", xlab="values")}
})
output$plot2 <- renderPlot({
values_A<-rnorm(input$obs,20, 4.5)
assign('A_values', round(values_A), envir=.GlobalEnv)
hist(A_values, main="Histogram of A values", xlab="values")
})
output$plot3 <- renderPlot({
category <- function(x) if ( x <=10) round(rnorm(1,50,10)) else round(rnorm(1,10,2))
assign('C_values', as.numeric(lapply(B_values, category)))
hist(C)
})
})
The reason this isn't working is because you need to create a reactive variable with your B_values as you cannot define a reactive variable within the renderPlot function and use it again therefore your code won't work in plot 3 as you have the dependency on the variable in plot1. You must define this as a reactive value as shown and then call it in your renderPlot.
Note that when calling a reactive variable you must use brackets after the variable name.
I would recommend that you watch the shiny tutorial on the shiny website it is very helpful in understanding how reactivity works.
Here is the server side for your example such that it works.
shinyServer(function(input, output) {
reactiveB <- reactive({
rnorm(input$obs, 25,6)
})
output$plot1 <- renderPlot({
{
values_B <- reactiveB()
assign('B_values', round(values_B), envir=.GlobalEnv)
hist(B_values, main="Histogram of B values", xlab="values")}
})
output$plot2 <- renderPlot({
values_A<-rnorm(input$obs,20, 4.5)
assign('A_values', round(values_A), envir=.GlobalEnv)
hist(A_values, main="Histogram of A values", xlab="values")
})
output$plot3 <- renderPlot({
B_values <- reactiveB()
category <- function(x) if ( x <=10) round(rnorm(1,50,10)) else round(rnorm(1,10,2))
assign('C_values', as.numeric(lapply(B_values, category)))
hist(C_values)
})
})

Access data created from reactive function to define reactiveValues in Shiny

I'm exploring the possibilities with interactive ggplot2 in shiny. Inspired by this I created a shiny app that exclude points from a dataset and plots the data where the excluded points are of a different color.
app.R
library(shiny)
library(ggplot2)
server<-function(input, output) {
data <- reactive({
set.seed(10)
df=data.frame(x=rnorm(100),y=rnorm(100))
df
})
vals<-reactiveValues(keeprows=rep(TRUE, 100))
output$plot1 <- renderPlot({
df=data()
keep=df[vals$keeprows, ,drop=FALSE]
exclude=df[!vals$keeprows, ,drop=FALSE]
plot=ggplot(data=keep,aes(x,y))+geom_point()+theme_bw()+
geom_point(data=exclude,fill=NA,col="black",alpha=0.75,shape=21)
plot
})
observeEvent(input$plot1_click,{
df=data()
res <- nearPoints(df, input$plot1_click, allRows = TRUE,threshold=5)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})
}
ui <- fluidPage(
titlePanel("Reactive test"),
mainPanel(
plotOutput("plot1",click="plot1_click")
)
)
shinyApp(ui = ui, server = server)
This works perfectly, but now I want to be able to define vals with:
vals<-reactiveValues(keeprows=rep(TRUE,nrow(CustomDataInput))
In the case of my example, I tried accessing number of rows from the data created in data():
vals<-reactiveValues(keeprows=rep(TRUE,nrow(data()))
This gives me an error because I tried to access a reactive variable in a non-reactive environment. Is there a way to access the data created in a reactive function to define reactiveValues?
Thank you for your time!
The error pretty much addresses the problem. The correct way to do this is as follows.
library(shiny)
library(ggplot2)
server<-function(input, output) {
vals <- reactiveValues()
data <- reactive({
set.seed(10)
df=data.frame(x=rnorm(100),y=rnorm(100))
vals$keeprows = rep(TRUE,nrow(df))
df
})
#vals<-reactiveValues(keeprows=rep(TRUE,100))
output$plot1 <- renderPlot({
df=data()
keep=df[vals$keeprows, ,drop=FALSE]
exclude=df[!vals$keeprows, ,drop=FALSE]
plot=ggplot(data=keep,aes(x,y))+geom_point()+theme_bw()+
geom_point(data=exclude,fill=NA,col="black",alpha=0.75,shape=21)
plot
})
observeEvent(input$plot1_click,{
df=data()
res <- nearPoints(df, input$plot1_click, allRows = TRUE,threshold=5)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})
}
ui <- fluidPage(
titlePanel("Reactive test"),
mainPanel(
plotOutput("plot1",click="plot1_click")
)
)
shinyApp(ui = ui, server = server)
Declare the vals variable before hand and use that in reactive() function to send variables to vals as shown above. You should be fine.

Resources