R shiny foreach instead of double for loop - r

Question

I have a fairly large simulation, that I currently run in Shiny using double for loop and it takes very long. I read about possibility of using foreach, but it does not work out, whatever I try, I and up in errors. Maybe some can spot the error and help me correct it?
app.R that runs (albeit very slowly (on real data) here with example data for reprex
require(shiny)
require(tidyverse)
require(foreach)
require(doMC)
registerDoMC()
options(cores = detectCores())
df <- data.frame(a=rnorm(n=26), b=1:26, c=100:125)
calc <- function(let=0.5, var1=0.1, var2=0.5){
df%>%
mutate(p1=ifelse(a<let,var1,0))%>%
mutate(p2=ifelse(a<let, var2,2))%>%
summarise(mean_b=mean(b*p1),
mean_c=mean(c*p2))
}
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Example"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput(inputId="selected_let",
label="LET",
value=0.5,
min=0,
max=1,
step=0.1),
submitButton("CALCULATE")
),
# Show a plot of the generated distribution
mainPanel(
h1(paste0("Table1")),
tableOutput("table_1"),
h1(paste0("Table2")),
tableOutput("table_2")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
data <- reactive({
data <- data.frame()
for (i in seq(0,1,by=0.1)) {
for (j in seq(0,1,by=0.1)) {
tmp <- calc(let = input$selected_let, var1 = i, var2 = j)
tmp_df <- data.frame(var1=i,
var2=j,
mean_b=tmp$mean_b,
mean_c=tmp$mean_c)
data <- rbind(data, tmp_df)
}
}
return(data)
})
output$table_1 <- renderTable({
data()%>%
select(var1,var2,mean_b)%>%
spread(var2, mean_b)
})
output$table_2 <- renderTable({
data()%>%
select(var1,var2,mean_c)%>%
spread(var2, mean_c)
})
}
# Run the application
shinyApp(ui = ui, server = server)
My goal was to change the data <-... part with foreach package and as my PC runs on UNIX I use the doMC.
to be replaced with:
data <- reactive({
foreach(i=rep(seq(0,1,by=0.1),each=11),
j=rep(seq(0,1,by=0.1),times=11),
.combine="rbind") %dopar% {
val <- calc(let=input$selected_let,
var1=i,
var2=j)
data.frame(var1=i,
var2=j,
mean_b=tmp$mean_b,
mean_c=tmp$mean_c)
}
})
But this ends up in permanent errors:
I tried to out require(dplyr) in the the server part, but that did not help either.
Any suggestions for solutions?
As stand alone, the foreach part runs well with let=0.5 as input, given its not in reactive
foreach(i=rep(seq(0,1,by=0.1),each=11),
j=rep(seq(0,1,by=0.1),times=11),
.combine="rbind") %dopar% {
val <- calc(let=0.5,
var1=i,
var2=j)
data.frame(var1=i,
var2=j,
mean_b=tmp$mean_b,
mean_c=tmp$mean_c)
}

Answer 1

Here is a way to avoid the double for-loop using library(data.table):
library(shiny)
library(data.table)
set.seed(0)
DF <- data.frame(a = rnorm(n = 26), b = 1:26, c = 100:125)
setDT(DF)
DT <- setDT(expand.grid(var1 = seq(0, 1, by = 0.1), var2 = seq(0, 1, by = 0.1)))
setorder(DT, var1, var2)
calc <- function(DF, let = 0.5, var1 = 0.1, var2 = 0.5) {
DF[, c("mean_b", "mean_c") := .(b * fifelse(a < let, var1, 0), c * fifelse(a < let, var2, 2))]
as.list(colMeans(DF[, .(mean_b, mean_c)]))
}
ui <- fluidPage(titlePanel("Example"),
sidebarLayout(
sidebarPanel(
sliderInput(
inputId = "selected_let",
label = "LET",
value = 0.5,
min = 0,
max = 1,
step = 0.1
),
submitButton("CALCULATE")
),
mainPanel(
h1(paste0("Table1")),
tableOutput("table_1"),
h1(paste0("Table2")),
tableOutput("table_2")
)
))
server <- function(input, output) {
data <- reactive({
DT[, c("mean_b", "mean_c") := calc(DF, let = input$selected_let, var1 = var1, var2 = var2), by = seq_len(NROW(DT))]
})
output$table_1 <- renderTable({
dcast(data(), var1 ~ var2, value.var = "mean_b")
})
output$table_2 <- renderTable({
dcast(data(), var1 ~ var2, value.var = "mean_c")
})
}
shinyApp(ui = ui, server = server)
Here you can find a benchmark taking into account dplyr and data.table (among others).