inst/doc/Vb_Ring2017.R

## ---- include=FALSE-----------------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = '#>')

## ----clear_memory, eval = TRUE------------------------------------------------
rm(list=ls()) 

## ----runchunks, eval = TRUE---------------------------------------------------
# Set whether or not the following chunks will be executed (run):
execute.vignette <- FALSE

## ----load_packages, eval = execute.vignette-----------------------------------
#  library("httk")
#  library("data.table")

## ----subpop_specs, eval = execute.vignette------------------------------------
#  nsamp<-1000
#  #List subpop names
#  ExpoCast.group<-list("Total",
#                       "Age.6.11",
#                       "Age.12.19",
#                       "Age.20.65",
#                       "Age.GT65",
#                       "BMIgt30",
#                       "BMIle30",
#                       "Females",
#                       "Males",
#                       "ReproAgeFemale",
#                       "Age.20.50.nonobese")
#  #List subpop gender specifications
#  gendernum <- c(rep(list(NULL),7),
#                 list(list(Male=0, Female=1000)),
#                 list(list(Male=1000, Female=0)),
#                 list(list(Male=0, Female=1000)),
#                 list(NULL))
#  #List subpop age limits in years
#  agelim<-c(list(c(0,79),
#                 c(6,11),
#                 c(12,19),
#                 c(20,65),
#                 c(66,79)),
#            rep(list(c(0,79)),4),
#            list(c(16,49)),
#            list(c(20,50)))
#  #List subpop weight categories
#  bmi_category <- c(rep(list(c('Underweight',
#                               'Normal',
#                               'Overweight',
#                               'Obese')),
#                        5),
#                    list('Obese', c('Underweight','Normal', 'Overweight')),
#                    rep(list(c('Underweight',
#                               'Normal',
#                               'Overweight',
#                               'Obese')),
#                        3),
#                    list(c('Underweight', 'Normal', 'Overweight')))

## ----generate_parallel, eval = execute.vignette-------------------------------
#  tmpfun <- function(gendernum, agelim, bmi_category, ExpoCast_grp,
#                     nsamp, method){
#    result <- tryCatch({
#                       pops <- httk::httkpop_generate(
#                    method=method,
#                    nsamp = nsamp,
#                    gendernum = gendernum,
#                    agelim_years = agelim,
#                    weight_category = bmi_category)
#  
#                    filepart <- switch(method,
#                                       'virtual individuals' = 'vi',
#                                       'direct resampling' = 'dr')
#  saveRDS(object=pops,
#            file=paste0(paste('data/httkpop',
#                        filepart, ExpoCast_grp,
#                        sep='_'),
#                        '.Rdata'))
#  return(getwd())
#  }, error = function(err){
#    print(paste('Error occurred:', err))
#    return(1)
#  })
#  }
#  
#  cluster <- parallel::makeCluster(2, # Reduced from 40 to 2 cores
#                         outfile='subpopulations_parallel_out.txt')
#  
#  evalout <- parallel::clusterEvalQ(cl=cluster,
#               {library(data.table)
#                library(httk)})
#  parallel::clusterExport(cl = cluster,
#                varlist = 'tmpfun')
#  #Set seeds on all workers for reproducibility
#  parallel::clusterSetRNGStream(cluster,
#                                TeachingDemos::char2seed("Caroline Ring"))
#  out_vi <- parallel::clusterMap(cl=cluster,
#                    fun = tmpfun,
#                    gendernum=gendernum,
#                    agelim=agelim,
#                    bmi_category=bmi_category,
#                    ExpoCast_grp = ExpoCast.group,
#                    MoreArgs = list(nsamp = nsamp,
#                                    method = 'virtual individuals'))
#  out_dr <- parallel::clusterMap(cl=cluster,
#                    fun = tmpfun,
#                    gendernum=gendernum,
#                    agelim=agelim,
#                    bmi_category=bmi_category,
#                    ExpoCast_grp = ExpoCast.group,
#                    MoreArgs = list(nsamp = nsamp,
#                                    method = 'direct resampling'))
#  parallel::stopCluster(cluster)

Try the httk package in your browser

Any scripts or data that you put into this service are public.

httk documentation built on March 7, 2023, 7:26 p.m.