BURN meetup 2017. 07. 18.

HighlightsOfUseR2017.R

#-----------------------------------------------------------------------------#
### Highlights of useR!2017 #################### BURN 2017. 07. 18. ###########
#-----------------------------------------------------------------------------#

##############
#
# Parallel computing tutorial
#
##############
#
# https://rawgit.com/PPgp/useR2017public/master/tutorial.html#package-parallel

install.packages(c("foreach", "doParallel", "doRNG", 
                   "snowFT", "extraDistr", "ggplot2", 
                   "reshape2", "wpp2017"), 
                 dependencies = TRUE)

library(parallel)

#####
# number of cores
#####
detectCores() # counts hyperthreaded cores
P <- detectCores(logical = FALSE) # physical cores
P

#####
# start and stop using multiple cores
#####
cl <- makeCluster(P)
cl
stopCluster(cl)

#####
# using multiple workers
#####

cl <- makeCluster(P)
args(clusterApply)
clusterApply(cl, 1:P, fun = rnorm)
clusterApply(cl, 1:P, fun = rnorm, 
            mean = 10, sd = 2)
res <- clusterApply(cl, rep(100000, 20), 
        fun = function(x){
                rnorm(x, mean = 5)
              })
plot(snow::snow.time(snow::clusterApply(cl, rep(100000, 20), 
        fun = function(x){
                rnorm(x, mean = 5)
              })))

#####
# Load balancing
#####
different_loads <- sample(ceiling(exp(seq(5, 15, length=20))), 20)

plot(snow::snow.time(snow::clusterApply(cl,
                                        different_loads, 
                                        fun = function(x){
                                          rnorm(x, mean = 5)
                                        })))

plot(snow::snow.time(snow::clusterApplyLB(cl,
                                          different_loads, 
                                          fun = function(x){
                                            rnorm(x, mean = 5)
                                          })))


#####
# Initializing worker session
#####

library(extraDistr)
myrdnorm <- function(r, mean = 0, sd = 1) {
    rdnorm(r, mean = mean, sd = sd)
}
res <- clusterApply(cl, rep(100000, 20), 
        fun = myrdnorm)

myrdnorm <- function(r, mean = 0, sd = 1) {
    extraDistr::rdnorm(r, mean = mean, sd = sd)
}
res <- clusterApply(cl, rep(100000, 20), 
        fun = myrdnorm)

myrdnorm <- function(r, mean = 0, sd = 1) {
    library(extraDistr)
    rdnorm(r, mean = mean, sd = sd)
}
res <- clusterApply(cl, rep(100000, 20), 
        fun = myrdnorm)

clusterEvalQ(cl, library(extraDistr))
res <- clusterApply(cl, rep(10000, 1000), 
                fun = myrdnorm, sd = 6)

stopCluster(cl)
cl <- makeCluster(P)

clusterEvalQ(cl, {
  library(extraDistr)
  my_mean <- 5
  my_sd <- 3
  })
res <- clusterApply(cl, rep(10000, 1000), 
                fun = myrdnorm,
                sd=my_sd,
                mean=my_mean)

stopCluster(cl)
cl <- makeCluster(P)

my_mean <- 5
my_sd <- 3
clusterExport(cl, c("my_mean", "my_sd"))
clusterEvalQ(cl, library(extraDistr))
res <- clusterApply(cl, rep(10000, 1000), 
                fun = myrdnorm,
                sd=my_sd,
                mean=my_mean)


#####
# Random numbers
#####
identical({
  set.seed(1)
  clusterApply(cl, rep(5, P), rnorm)},
  {set.seed(1)
  clusterApply(cl, rep(5, P), rnorm)})

identical(
  {set.seed(1)
  clusterApply(cl, rep(5, P),
               function(x){
                 set.seed(1)
                 rnorm(x)
               })},
  {set.seed(1)
  clusterApply(cl, rep(5, P),
               function(x){
                 set.seed(1)
                 rnorm(x)
               })})


clusterEvalQ(cl, RNGkind())
seed <- 1
clusterSetRNGStream(cl, seed)
clusterEvalQ(cl, RNGkind())
do.call(rbind, clusterEvalQ(cl, rnorm(5)))


##############
#
# Creating APIs
#
###############
#
# https://cran.r-project.org/web/packages/jug/vignettes/jug.html
library(magrittr)
library(jug)


hello_world <- function(name){
  paste("Hello", name, "!")
}

jug() %>%
  get("/hello",
      decorate(hello_world)) %>%
  serve_it(port=8081)

#####
# simple model
#####

mpg_model<-
  lm(mpg~gear+hp, data=mtcars)


predict_mpg <- function(gear, hp){
  predict(mpg_model, 
          newdata = data.frame(gear=as.numeric(gear), 
                               hp=as.numeric(hp)))[[1]]
}

predict_mpg(gear = 4, hp = 80)


jug() %>%
  get("/predict-mpg", decorate(predict_mpg)) %>%
  simple_error_handler_json() %>%
  serve_it(port=8082)



##############
#
# Modules
#
##############
#
# https://cran.r-project.org/web/packages/modules/vignettes/modulesInR.html

install.packages("modules")
library(modules)

project_1 <- module({

  db <- data.frame(company_id=1:10,
                   company_name=paste0("company_", 1:10),
                   last_financial_report=as.Date(c("2010-12-31",
                                                   "2016-12-31",
                                                   "2014-12-31",
                                                   "2015-12-31",
                                                   "2016-01-01",
                                                   "2016-12-30",
                                                   "2013-12-31",
                                                   "2014-12-31",
                                                   "2014-12-31",
                                                   "2016-12-31")))
  


  get_live_companies <- function(){
    db[db$last_financial_report > (Sys.Date()-3*365),]
  }

  count_live_companies <- function(){
    nrow(get_live_companies())
  }

  check_if_live <- function(x){
    x %in% get_live_companies()$company_id
  }

  sample_live_companies <- function(n){
    sample(get_live_companies()$company_id, n)
  }
})

project_2 <- module({

  db <- data.frame(company_id=1:10,
                   company_name=paste0("company_", 1:10),
                   last_financial_report=as.Date(c("2010-12-31",
                                                   "2016-12-31",
                                                   "2014-12-31",
                                                   "2015-12-31",
                                                   "2016-01-01",
                                                   "2016-12-30",
                                                   "2013-12-31",
                                                   "2014-12-31",
                                                   "2014-12-31",
                                                   "2016-12-31")))
  


  get_live_companies <- function(){
    db[db$last_financial_report > (Sys.Date()-1*365),]
  }

  count_live_companies <- function(){
    nrow(get_live_companies())
  }

  check_if_live <- function(x){
    x %in% get_live_companies()$company_id
  }

  sample_live_companies <- function(n){
    sample(get_live_companies()$company_id, n)
  }
})


project_1$get_live_companies()
project_2$get_live_companies()


##############
#
# Poissontris
#
##############
devtools::install_github("openanalytics/poissontris")
library(poissontris)
runPoissontris()