Shiny + mclapply + stochastic simulation in Rcpp (no mrgsolve involvement)

shiny_mc_Rcpp.R

library(shiny)
library(dplyr)
library(parallel)
library(Rcpp)

RNGkind("L'Ecuyer-CMRG")
set.seed(101)
mc.reset.stream()


code <- '
Rcpp::NumericVector foo(int i, int n, double om) {
   Rcpp::NumericVector ans = Rcpp::rnorm(n,0.0,sqrt(om));
   return ans;
}
'

##' @param i replicate number
##' @param n number to simulate
##' @param om variance for rnorm
##' @return NumericVector of random variates
Rcppsim <- cppFunction(code=code)


##' Simulate
##' @param i replicate number
##' @param N number to simulate
##' @param om variance
##' @return data frame with single column (ETA1)
sim <- function(i,N,om) {
  x <- Rcppsim(i,N,om) 
  return(data_frame(ETA1 = x))
}

##' Summarize simulations
##' @param x a data frame with single column (ETA1)
##' @return nETA1 (distinct ETA1), vETA1 (variance of ETA1), sETA1 (sum of ETA1), n (nrow)
smry <- function(x) {
  x %>% summarise(nETA1 = n_distinct(ETA1),
                  vETA1 = var(ETA1),
                  sETA1 = sum(ETA1),
                  n=n())
}


##' UI ###########################################
ui<- fluidPage(
  titlePanel("Shiny MC"),
  
  sidebarLayout(
    sidebarPanel(
      sliderInput("OM1", "OMEGA 1",0,4,1,0.25),
      sliderInput("n", "N rep", 1,100,10,1),
      sliderInput("N", "N subj", 1, 100,10,1),
      sliderInput("mccores", "mc.cores", 1,4,2,1)
    ),
    mainPanel(tableOutput("table")
    )
  )
)


##' SERVER ###########################################
server<-function(input, output) {
  
  output$table <- renderTable({
    
    n <- 1:input$n
    mc.cores <- input$mccores
    N <- input$N
    OM1 <- input$OM1
    
    RNGkind("L'Ecuyer-CMRG")
    set.seed(101)
    mc.reset.stream()
    #message(RNGkind())
    
    mclapply(n,
             mc.cores=mc.cores,
             sim,N,OM1) %>% bind_rows %>% smry
  })
}

##' Run the shiny app
shinyApp(ui = ui, server = server)


##' This works fine / as expected outside of the Shiny app:
mclapply(1:100, mc.cores=4,sim, 100,2) %>% bind_rows %>% smry