Shiny and parallel package - r

I'm writing a shiny app, which runs a function over a set of parameters, so I figured I could use multiple cores.
For some reason it can't feed in the variables to the cluster, I get an error: "var_mean" not found. I've tried isolate but that didn't seem to help.
The code below is a very simple example which reproduces the behaviour.
Thanks for any help.
library(shiny)
library(parallel)
ui <- fluidPage(
# Application title
titlePanel("Test parallel in Shiny app"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
numericInput("n","N",value = 100),
numericInput("mean","Mean",value = 1000),
checkboxInput("parallel","Parallel?",value=FALSE)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output) {
simulate <- reactive({
mean = input$mean
sim = rnorm(input$n,mean=mean,sd = 100)
return(sim)
})
p_simulate<-reactive({
cl = makeCluster(detectCores()-1)
var_mean = input$mean
clusterExport(cl,varlist="var_mean")
sim = parSapply(cl,
1:input$n,
function(x) rnorm(1,mean=var_mean,sd = 100)
)
stopCluster(cl)
sim
})
output$distPlot <- renderPlot({
if(input$parallel){
x = p_simulate()
} else x = simulate()
# draw the histogram with the specified number of bins
hist(x)
})
}
# Run the application
shinyApp(ui = ui, server = server)

Your "clusterExport" command is missing the "envir" flag:
clusterExport(cl,varlist="var_mean", envir = environment())
That got it running for me.

Related

How can I plot a heatmap with the heatmaply package in Shiny?

I am trying to use the heatmaply package in order to plot a heatmap and it works well.
On the other hand, when I try to do the same plot in Shiny it doesn't appear in the interface (when I click "run app"). However, when I close the window suddenly the plot appears in the R viewer. Is it possible that the heatmaply package doesn't work with Shiny?
This is my code, when I plot it in R.
library(heatmaply)
x <- as.matrix(datasets::mtcars)
rc <- colorspace::rainbow_hcl(nrow(x))
heatmaply(
x[, -c(8, 9)],
col_side_colors = rc[1:9],
showticklabels=FALSE,
Rowv = TRUE,
Colv = FALSE
)
This is my code in Shiny.
library(shiny)
library(heatmaply)
ui <- fluidPage(
# Application title
titlePanel("Heatmap"),
sidebarLayout(
sidebarPanel(
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
x <- as.matrix(datasets::mtcars)
rc <- colorspace::rainbow_hcl(nrow(x))
server <- function(input, output) {
output$distPlot <- renderPlot({
heatmaply(
x[, -c(8, 9)],
col_side_colors = rc[1:9],
showticklabels=FALSE,
Rowv = TRUE,
Colv = FALSE
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have tried another packages to have an interactive heatmap but it is the only one that it has what I want, so for that reason I need to ask here if someone knows how to use it in Shiny.
Thanks in advance,
Regards
You can use plotlyOutput and renderPlotly :
library(shiny)
library(heatmaply)
library(plotly)
ui <- fluidPage(
# Application title
titlePanel("Heatmap"),
sidebarLayout(
sidebarPanel(
),
# Show a plot of the generated distribution
mainPanel(
plotlyOutput("distPlot")
)
)
)
x <- as.matrix(datasets::mtcars)
rc <- colorspace::rainbow_hcl(nrow(x))
server <- function(input, output) {
output$distPlot <- renderPlotly({
heatmaply(
x[, -c(8, 9)],
col_side_colors = rc[1:9],
showticklabels=FALSE,
Rowv = TRUE,
Colv = FALSE
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Also there is a package shinyHeatmaply which might be of interest.

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)

shiny - interactive ggplot with subset

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)

R shiny: Display data set in shiny app

I am trying to print dataset values in shiny web app. But I am only able to print data set name using below code. How can I print dataset values?
library(MASS)
library(shinythemes)
library(shiny)
library(ggplot2)
mass.tmp <- data(package = "MASS")[3]
mass.datasets <- as.vector(mass.tmp$results[,3])
ui <- fluidPage(
theme = shinytheme("superhero"),
titlePanel("Linear Regression Modelling"),
sidebarLayout(
sidebarPanel(
selectInput("dsname", "Dataset:",choices = c(mass.datasets))
,
uiOutput("x_axis")
# ,
# textOutput("txt"),
# tableOutput("tab")
),
mainPanel(
tags$br(),
tags$br()
)
)
)
server <- function(input, output) {
num_ds <- function(ds)
{
nums <- sapply(ds,is.numeric)
num_ds <- ds[,nums]
return(num_ds)
}
ds_ext <- reactive({ num_ds(input$dsname) })
output$x_axis <- renderUI({
col_opts <- get(ds_ext())
selectInput("x_axis2", "Independent Variable:", choices = names(col_opts))
})
}
shinyApp(ui = ui, server = server)
Actually I am trying to solve error in above code "Incorrect number of dimensions". I have written function which would return data frame with only numeric variables so that I can analyze. But getting error in line I guess where I am creating object x_axis. pls help.

fix selectInput error on initial shinyr app load

When the shiny app below is run I initially get the error - invalid type/length (symbol/0) in vector allocation. However, as soon as I click "Submit" the app functions as intended.
Is there a way to avoid this launch error and have it work correctly from the start?
plot_and_summary <- function(dat, col){
summary <- dat %>% summarize_(mean = interp(~mean(x), x = as.name(col)),
sd = interp(~sd(x), x = as.name(col)))
plot <- ggplot(dat, aes_string(x = col)) + geom_histogram()
return(list(summary = summary, plot = plot))
}
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
titlePanel(""),
sidebarLayout(
sidebarPanel(
uiOutput("column_select"),
submitButton("Submit")
),
mainPanel(
tableOutput("summary"),
plotOutput("plot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output){
dat <- reactive({iris})
output$column_select <- renderUI({selectInput("col", label = "select column", choices = as.list(names(dat())))})
pas <- reactive({plot_and_summary(dat(), input$col)})
output$plot <- renderPlot({pas()$plot})
output$summary <- renderTable({pas()$summary})
}
shinyApp(ui = ui, server = server)
The req function should solve your problem
http://shiny.rstudio.com/reference/shiny/latest/req.html
pas <- reactive({plot_and_summary(dat(), req(input$col))})

Resources