datistics

simaerep release 1.0.0

Tue, 04 Nov 2025 00:00:00 +0000

Simulate patient-related events in clinical trials with the goal of detecting over and under-reporting sites.

Monitoring reporting rates of patient-related events such as adverse events (AE) in clinical trials is important for patient safety. We use bootstrap-based simulation to assign over- and under-reporting probabilities to each site in a clinical trial. The method is inspired by the ‘infer’ R package and Allen Downey’s blog article: “There is only one test!”.

Key Risk Indicators

Statistical monitoring of clinical trial sites typical employs several key risk indicators which are operational metrics derived from activities at the clinical trial sites. The ratio of AEs is typically one of them, the ratio of issues occurring when treating and examininig patients according to the study protocol might be another one.

Release v1.0.0

Announcement

We are happy to announce the release of {simaerep} v1.0.0 and {gsm.simarep} v0.2.0 our open source R packages designed to detect clinical trial sites that are under- or over- reporting patient-level clinical events. We have condensed our experience and user feedback from the past 5 years to design a more professional user experience with default settings that reflect our latest recommendations. We have also adapted the algorithm to support the detection of over-reporting of low-incidence terminal events such as patient discontinuations. {gsm.simaerep} provides important data preprocessing functions and a standardized approach to integrate {simaerep} into an end-to-end analysis and reporting pipeline using the good statistical monitoring {gsm} framework.

Release Highlights

New user interface for simaerep() function with defaults reflecting the latest recommendations
Better output structure, over- and under-reporting probability combined into one score
Support for low-incidence terminal events (e.g., patient discontinuations)

Detailed Releas Notes

Demo

{simaerep}

suppressPackageStartupMessages(library(simaerep))
suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(knitr))

set.seed(1)

df_visit <- sim_test_data_study(
  n_pat = 1000, # number of patients in study
  n_sites = 100, # number of sites in study
  ratio_out = 0.02, # ratio of sites with outlier
  factor_event_rate = -0.5, # rate of under-reporting
  # non-constant event rates based on gamma distribution
  event_rates = (dgamma(seq(1, 20, 0.5), shape = 5, rate = 2) * 5) + 0.1,
  max_visit = 20,
  max_visit_sd = 10,
  study_id = "A"
)

df_visit %>%
  select(study_id, site_id, patient_id, visit, n_event) %>%
  head(25) %>%
  knitr::kable()

study_id	site_id	patient_id	visit	n_event
A	S0001	P000001	1	0
A	S0001	P000001	2	2
A	S0001	P000001	3	2
A	S0001	P000001	4	4
A	S0001	P000001	5	6
A	S0001	P000001	6	7
A	S0001	P000001	7	7
A	S0001	P000001	8	7
A	S0001	P000001	9	7
A	S0001	P000001	10	7
A	S0001	P000001	11	7
A	S0001	P000001	12	7
A	S0001	P000001	13	7
A	S0001	P000002	1	3
A	S0001	P000002	2	3
A	S0001	P000002	3	5
A	S0001	P000002	4	8
A	S0001	P000002	5	8
A	S0001	P000002	6	9
A	S0001	P000002	7	9
A	S0001	P000002	8	9
A	S0001	P000002	9	9
A	S0001	P000002	10	9
A	S0001	P000002	11	9
A	S0001	P000002	12	9

evrep <- simaerep(df_visit, mult_corr = TRUE)

plot(evrep, study = "A")

{gsm.simaerep}

library(gsm.simaerep)
library(gsm.kri)

dfInput <- Input_CumCount(
  dfSubjects = clindata::rawplus_dm,
  dfNumerator = clindata::rawplus_ae,
  dfDenominator = clindata::rawplus_visdt %>% dplyr::mutate(visit_dt = lubridate::ymd(visit_dt)),
  strSubjectCol = "subjid",
  strGroupCol = "siteid",
  strGroupLevel = "Site",
  strNumeratorDateCol = "aest_dt",
  strDenominatorDateCol = "visit_dt"
)

dfAnalyzed <- Analyze_Simaerep(dfInput)

dfFlagged <- Flag_Simaerep(dfAnalyzed, vThreshold = c(-0.99, -0.95, 0.95, 0.99))

## ℹ Sorted dfFlagged using custom Flag order: 2.Sorted dfFlagged using custom Flag order: -2.Sorted dfFlagged using custom Flag order: 1.Sorted dfFlagged using custom Flag order: -1.Sorted dfFlagged using custom Flag order: 0.

#> ℹ Sorted dfFlagged using custom Flag order: 2.Sorted dfFlagged using custom Flag order: -2.Sorted dfFlagged using custom Flag order: 1.Sorted dfFlagged using custom Flag order: -1.Sorted dfFlagged using custom Flag order: 0.

gsm.kri::Visualize_Scatter(
  dfFlagged,
  dfBounds = NULL,
  strGroupLabel = "GroupLevel",
  strUnit = "Visits"
)

IMPALA

simaerep has been published as workproduct of the Inter-Company Quality Analytics (IMPALA) consortium. IMPALA aims to engage with Health Authorities inspectors on defining guiding principles for the use of advanced analytics to complement, enhance and accelerate current QA practices. simaerep has initially been developed at Roche but is currently evaluated by other companies across the industry to complement their quality assurance activities (see testimonials).

Ressources

Publications

Koneswarakantha, B., Adyanthaya, R., Emerson, J. et al. An Open-Source R Package for Detection of Adverse Events Under-Reporting in Clinical Trials: Implementation and Validation by the IMPALA (Inter coMPany quALity Analytics) Consortium. Ther Innov Regul Sci (2024). https://doi.org/10.1007/s43441-024-00631-8

Koneswarakantha, B., Barmaz, Y., Ménard, T. et al. Follow-up on the Use of Advanced Analytics for Clinical Quality Assurance: Bootstrap Resampling to Enhance Detection of Adverse Event Under-Reporting. Drug Saf (2020).
https://doi.org/10.1007/s40264-020-01011-5

simaerep release 0.6.0

Mon, 30 Sep 2024 00:00:00 +0000

Simulate patient-related events in clinical trials with the goal of detecting over and under-reporting sites.

Key Risk Indicators

Release 0.6.0

Updated Algorithm

The default {simaerep} default algorithm picks for each site a specific evaluation point called visit_med75 based on the individual progression of the majority of the patients at a given site. Based on this site-level metric patients from the study pool would be sampled. With the most current release v0.6.0 an alternative algorithm which identifies matches on patient-level for bootstrapping has been added. This algorithm has been coded with dbplyr compatible table operations and can be executed within a database-backend. More details about the so called inframe method can be found in the documentation.

Increased Statistical Performance

The latest statistical performance benchmark shows that the inframe method with disabled visit_med75 increases the overall statistical performance of {simaerep}. We can further show that the previously implemented multiplicity correction actually decreases performance of {simaerep}. This observation was already previously made during the validataion of {siamerep} by one of the IMPALA member companies. simaerep() has received a new parameter mult_corr to conveniently disable the multiplicity correction.

Demo

New Recommendation

Recommended Threshold: aerep$dfeval$prob_low_prob_ur: 0.99

suppressPackageStartupMessages(library(simaerep))
suppressPackageStartupMessages(library(tidyverse))
suppressPackageStartupMessages(library(knitr))

set.seed(1)

df_visit <- simaerep::sim_test_data_study(
  n_pat = 1000, # number of patients in study
  n_sites = 100, # number of sites in study
  frac_site_with_ur = 0.05, # fraction of sites under-reporting
  ur_rate = 0.4, # rate of under-reporting
  ae_per_visit_mean = 0.5 # mean AE per patient visit
)

df_visit$study_id <- "A"

df_visit %>%
  select(study_id, site_number, patnum, visit, n_ae) %>%
  head(10) %>%
  knitr::kable()

study_id	site_number	patnum	visit	n_ae
A	S0001	P000001	1	0
A	S0001	P000001	2	1
A	S0001	P000001	3	1
A	S0001	P000001	4	2
A	S0001	P000001	5	3
A	S0001	P000001	6	3
A	S0001	P000001	7	3
A	S0001	P000001	8	3
A	S0001	P000001	9	3
A	S0001	P000001	10	3

aerep <- simaerep::simaerep(
  df_visit,
  inframe = TRUE,
  visit_med75 = FALSE,
  mult_corr = FALSE
  )


plot(aerep, study = "A")

In Database Calculation

We demo in database calculations with duckdb.

We need to provide a in database table that has as many rows as the desired replications in our simulation, instead of providing an integer for the r parameter.

con <- DBI::dbConnect(duckdb::duckdb(), dbdir = ":memory:")
df_r <- tibble(rep = seq(1, 1000))

dplyr::copy_to(con, df_visit, "visit")
dplyr::copy_to(con, df_r, "r")

tbl_visit <- tbl(con, "visit")
tbl_r <- tbl(con, "r")


aerep <- simaerep(
  tbl_visit,
  r = tbl_r,
  inframe = TRUE,
  visit_med75 = FALSE,
  mult_corr = FALSE
)

plot(aerep, df_visit = tbl_visit)

## study = NULL, defaulting to study:A

DBI::dbDisconnect(con)

Upcoming Breaking Changes

In the upcoming release the default settings of siamerep will be changed to the new recommendations and we will remove the AE wording from the package and change input and output column names.

IMPALA

Ressources

Publications

simaerep release 0.5.0

Thu, 11 Apr 2024 00:00:00 +0000

Simulate adverse event reporting in clinical trials with the goal of detecting under-reporting sites.

Monitoring of Adverse Event (AE) reporting in clinical trials is important for patient safety. We use bootstrap-based simulation to assign an AE under-reporting probability to each site in a clinical trial. The method is inspired by the ‘infer’ R package and Allen Downey’s blog article: “There is only one test!”.

Adverse Events

An adverse event (AE) is any untoward medical occurrence in a patient or participating in a clincial trial. These events are not necessarily drug related. It could anything from a headache to a sporting accident to a life-threatening pneunomia. It is important though for the safety of the patients that these events are being reported in a timely manner from the clinical trial site to the sponsor of the trial so that the safety profile of the drug can be updated if necessary and appropriate actions can be taken.

Key Risk Indicators

Release 0.5.0

{simaerep} was originally developed to detect sites that are under-reporting Adverse Events (AE) in clinical trials using a nonparametric bootstrap algorithm. With the release of the most current version v0.5.0 {simaerep} can also be used to detect over-reporting. With this update the algorithm can be used to detect under and over-reporting for all patient-related clinical events at site-level. From a quality perspective under-reporting is of a greater interest than over-reporting of AE. When it comes to other events such as site and subject issues, protocol deviations and data queries over- or high-reporting can be of the same importance as under-reporting. As high reporting can be indicative of site problems when executing the study protocol, low- or under-reporting can be indicative of failure of reporting such issues. A detailed guideline on how to obtain both over and under-reporting probabilities has been added to the package documentation.

Comparison to other KRI flagging methods

The open-source landscape for R packages for clinical study quality monitoring and assurance has lately been extended with the release of the {gsm} R package which provides streamlined reporting for monitoring of key risk indicators that directly connects to various standardized clinical data formats. It also implements a funnel plot outlier flagging method which holds various advantages over percentile-based flagging methods. Nevertheless we could show that the algorithm used by simarep can flag under-reporting sites more reliably mostly because event rates are not constant over-time. This shows that the redistribution/restratification of patients to sites can be used to get more reliable flags than flagging methods that make assumptions about the underlying process distributions.

Demo

suppressPackageStartupMessages(library(simaerep))
suppressPackageStartupMessages(library(tidyverse))
suppressPackageStartupMessages(library(knitr))

set.seed(1)

df_visit <- simaerep::sim_test_data_study(
  n_pat = 1000, # number of patients in study
  n_sites = 100, # number of sites in study
  frac_site_with_ur = 0.05, # fraction of sites under-reporting
  ur_rate = 0.4, # rate of under-reporting
  ae_per_visit_mean = 0.5 # mean AE per patient visit
)

df_visit$study_id <- "A"

df_visit %>%
  select(study_id, site_number, patnum, visit, n_ae) %>%
  head(10) %>%
  knitr::kable()

study_id	site_number	patnum	visit	n_ae
A	S0001	P000001	1	0
A	S0001	P000001	2	1
A	S0001	P000001	3	1
A	S0001	P000001	4	2
A	S0001	P000001	5	3
A	S0001	P000001	6	3
A	S0001	P000001	7	3
A	S0001	P000001	8	3
A	S0001	P000001	9	3
A	S0001	P000001	10	3

aerep <- simaerep::simaerep(df_visit)

plot(aerep, study = "A")

IMPALA

Ressources

Publications

parcats 0.0.3 released

Mon, 18 Oct 2021 00:00:00 +0000

parcats 0.0.3 was released on CRAN. It is an htmlwidget providing bindings to the plotly.js parcats trace, which is not supported by the plotly R package. It also adds marginal histograms for numerical variables.

demogif

Better {shiny} Support

It now integrates better into shiny apps. There is a new function parcats_demo() which let’s you interactively explore all the different parameters of easyalluvial::alluvial_wide() and parcats::parcats(). You can see how the alluvial plot and the derived interactive parcats widget look like with different parameters.

demo

Update {plotly.js}

In order to be 100% compatible with R plotly. plotly.js that is shipped with parcats has been upgraded to v2.5.1

Parcats from Alluvial Plot

suppressPackageStartupMessages(require(tidyverse))
suppressPackageStartupMessages(require(easyalluvial))
suppressPackageStartupMessages(require(parcats))
suppressPackageStartupMessages(require(parsnip))

p = alluvial_wide(mtcars2, max_variables = 5)

parcats(p, marginal_histograms = TRUE, data_input = mtcars2)

Partial Dependence Alluvial Plots

Machine Learning models operate in a multidimensional space and their response is hard to visualise. Model response and partial dependency plots attempt to visualise ML models in a two dimensional space. Using alluvial plots or parallel categories diagrams we can increase the number of dimensions.

Visualise model response with alluvial plots

df <- select(mtcars2, -ids)

m <- parsnip::rand_forest(mode = "regression") %>%
  parsnip::set_engine("randomForest") %>%
  parsnip::fit(disp ~ ., df)

p <- alluvial_model_response_parsnip(m, df, degree = 4, method = "pdp")

## Getting partial dependence plot preditions. This can take a while. See easyalluvial::get_pdp_predictions() `Details` on how to use multiprocessing

parcats(p, marginal_histograms = TRUE, imp = TRUE, data_input = df)

Advanced R - Notes (part2)

Thu, 14 Oct 2021 00:00:00 +0000

Advanced R (Hadley Wickham).

knitr::opts_chunk$set(error = TRUE)

suppressPackageStartupMessages(library(tidyverse))
suppressPackageStartupMessages(library(rlang))
suppressPackageStartupMessages(library(lobstr))
suppressPackageStartupMessages(library(withr))
suppressPackageStartupMessages(library(glue))
# devtools::install_github("openpharma/simaerep@v0.3.1")
suppressPackageStartupMessages(library(simaerep))

Metaprogramming

Basics

We are ignoring environments for now.

Capturing/Quoting an Expression or many expression

ex1 <- rlang::expr(mean(mtcars$disp))
ex1

## mean(mtcars$disp)

ex2 <- quote(mean(mtcars$disp))
ex2

## mean(mtcars$disp)

exs1 <- rlang::exprs(mean(mtcars$disp), median(mtcars$disp))
exs1

## [[1]]
## mean(mtcars$disp)
## 
## [[2]]
## median(mtcars$disp)

exs2 <- alist(mean(mtcars$disp), median(mtcars$disp))
exs2

## [[1]]
## mean(mtcars$disp)
## 
## [[2]]
## median(mtcars$disp)

Evaluating/Unquoting an Expression

eval(ex1)

## [1] 230.7219

lapply(exs1, eval)

## [[1]]
## [1] 230.7219
## 
## [[2]]
## [1] 196.3

Capturing an Expression as a String - Deparsing

str_ex1 <- deparse(ex1)
str_ex1

## [1] "mean(mtcars$disp)"

rlang::expr_text(ex1)

## [1] "mean(mtcars$disp)"

Parsing Strings and Evaluating Code from Strings

parse(text = str_ex1)

## expression(mean(mtcars$disp))

eval(parse(text = str_ex1))

## [1] 230.7219

rlang::parse_expr(str_ex1)

## mean(mtcars$disp)

eval(rlang::parse_expr(str_ex1))

## [1] 230.7219

Converting Strings to Symbols

rlang::sym("foo")

## foo

as.name("foo")

## foo

Symbols to Strings

deparse(rlang::sym("foo"))

## [1] "foo"

rlang::expr_text(as.name("foo"))

## [1] "foo"

Code is a tree

Code can be displayed as an abstract synthax tree (AST) with functions/expressions/symbols as nodes and literals/constants as leaves.

lobstr::ast(f(a, "b"))

## █─f 
## ├─a 
## └─"b"

lobstr::ast(f1(f2(a, b), f3(1, f4(2))))

## █─f1 
## ├─█─f2 
## │ ├─a 
## │ └─b 
## └─█─f3 
##   ├─1 
##   └─█─f4 
##     └─2

lobstr::ast(1 + 2 * 3)

## █─`+` 
## ├─1 
## └─█─`*` 
##   ├─2 
##   └─3

Subsetting and modifiyng Expressions

length(ex1)

## [1] 2

ex1[[1]]

## mean

ex1[[2]]

## mtcars$disp

ex1[[1]] <- quote(median)
ex1[[1]]

## median

ex1

## median(mtcars$disp)

eval(ex1)

## [1] 196.3

Quoting/Unquoting in Functions

here we want to capture the user-supplied expression

capture1 <- function(x) {
  quote(x)
}

capture1(mean(mtcars$disp))

## x

capture2 <- function(x) {
  rlang::enexpr(x)
}

capture2(mean(mtcars$disp))

## mean(mtcars$disp)

capture3 <- function(x) {
  substitute(x)
}

capture3(mean(mtcars$disp))

## mean(mtcars$disp)

substitute() can also be used to alter expressions

substitute(mean(mtcars$disp), list(mean = quote(median), disp = quote(vs)))

## median(mtcars$vs)

bang bang !!

In rlang when constructing expression we can chose to selectively unquote parts of the expression using !! bang bang.

x <- rlang::expr(-1)

rlang::expr(f(!!x, y))

## f(-1, y)

a <- rlang::sym("foo")
b <- 1
rlang::expr(f(!!a, !!b))

## f(foo, 1)

bang bang bang !!!

selectively unquote lists of expressions using !!! bang bang bang.

xs <- rlang::exprs(1, a, -b)
rlang::expr(f(!!!xs, y))

## f(1, a, -b, y)

# Or with names
ys <- rlang::set_names(xs, c("a", "b", "c"))
rlang::expr(f(!!!ys, d = 4))

## f(a = 1, b = a, c = -b, d = 4)

Dynamic Dots …

rlang::list2() allows a function to use !!! and := with its ... argument, which unpacks the list.

f <- function(...) {
  out <- rlang::list2(...)
  rev(out)
}

x <- list(alpha = "first", omega = "last")

f(!!!x)

## $omega
## [1] "last"
## 
## $alpha
## [1] "first"

f(x)

## [[1]]
## [[1]]$alpha
## [1] "first"
## 
## [[1]]$omega
## [1] "last"

nm <- "foo"
f(!!nm := "bar")

## $foo
## [1] "bar"

Provide lists as function arguments

use rlang::exec() which uses dynamic dots

# Directly
exec(mean, x = 1:10, na.rm = TRUE, trim = 0.1)

## [1] 5.5

# Indirectly
args <- list(x = 1:10, na.rm = TRUE, trim = 0.1)
exec(mean, !!!args)

## [1] 5.5

# Mixed
params <- list(na.rm = TRUE, trim = 0.1)
exec(mean, x = 1:10, !!!params)

## [1] 5.5

use do.Call

do.call(mean, list(x = 1:10, na.rm = TRUE, trim = 0.1))

## [1] 5.5

Quosures

When evaluating an expression we can control the environment. Quosures consist of an expression and an environment.

They are similar to formulas in base R

Formulas

we can extract environment and formula expressions using rlang functions and evaluate both.

construct_formula <- function() {
  env_x <- 3
  ~runif(env_x)
}

f <- construct_formula()

f

## ~runif(env_x)
## <environment: 0x7fe60b693388>

eval(rlang::f_rhs(f), envir = rlang::f_env(f))

## [1] 0.4454028 0.3837579 0.3728023

rlang

rlang::quo and rlang::quos match rlang::expr() and rlang::exprs()
rlang::eval_tidy() evaluates quosures

foo <- function(x) enquo(x)
foo(a + b)

## <quosure>
## expr: ^a + b
## env:  global

q1 <- new_quosure(expr(x + y), env(x = 1, y = 10))
eval_tidy(q1)

## [1] 11

Data Masks

Call variables from a data frame using expressions. eval_tidy() excepts a dataframe in addition to the environment in the closure which it unpacks and makes available to the evaluation of the expression.

eval() excepts a dataframe as an environment

with2 <- function(data, expr) {
  expr <- enquo(expr)
  eval_tidy(expr, data = data)
}

df <- data.frame(y = 1:10)
x <- 100

with2(df, x * y)

##  [1]  100  200  300  400  500  600  700  800  900 1000

with3 <- function(data, expr) {
  expr <- substitute(expr)
  eval(expr, envir = data)
}

with3(df, x * y)

##  [1]  100  200  300  400  500  600  700  800  900 1000

for rlang quosures we can solve ambiguity between the dataframe and the environment using .data and .env

df <- data.frame(y = 1:10, x = 11:20)
x <- 100

with2(df, .data$x + .data$y)

##  [1] 12 14 16 18 20 22 24 26 28 30

with2(df, .env$x + .data$y)

##  [1] 101 102 103 104 105 106 107 108 109 110

# does  not work with the base version
with3(df, .data$x)

## NULL

Base Function Using Datamasks

subset

similar to dplyr::filter

subset2 <- function(df, expr) {
  qu <- enquo(expr)
  bool <- eval_tidy(qu, df)
  browser
  stopifnot(is.logical(bool))
  df[bool,]
}

subset2(mtcars, cyl == 6)

##                 mpg cyl  disp  hp drat    wt  qsec vs am gear carb
## Mazda RX4      21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4
## Mazda RX4 Wag  21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4
## Hornet 4 Drive 21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
## Valiant        18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1
## Merc 280       19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4
## Merc 280C      17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4
## Ferrari Dino   19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6

transform

similar to dplyr::mutate

transform2 <- function(df, ...) {
  dots <- enquos(...)
  
  for (i in seq_along(dots)) {
    col <- names(dots)[i]
    df[[col]] <- eval_tidy(dots[[i]], df)
  }
  
  return(df)
}

df <- data.frame(x = 1:10, y = 11: 10)

transform2(df, z = x * y, z0 = z + 1)

##     x  y   z  z0
## 1   1 11  11  12
## 2   2 10  20  21
## 3   3 11  33  34
## 4   4 10  40  41
## 5   5 11  55  56
## 6   6 10  60  61
## 7   7 11  77  78
## 8   8 10  80  81
## 9   9 11  99 100
## 10 10 10 100 101

select

rewrite of dplyr::select()

select2 <- function(data, ...) {
  dots <- enquos(...)
  vars <- as.list(set_names(seq_along(data), names(data)))
  cols <- unlist(map(dots, eval_tidy, vars))

  data[, cols, drop = FALSE]
}

df <- data.frame(a = 1, b = 2, c = 3, d = 4, e = 5)

select2(df, b:d, a)

##   b c d a
## 1 2 3 4 1

Programming with rlang/dplyr

Pass expressions onto functions using expression

We cannot pass them directly. We need to quote and selectively unquote

We can use quosures and bangs

sample_col <- function(df, col, n = 5) {
  qu_col <- enquo(col)
  head(select2(df, !! qu_col), n)
}

sample_col(mtcars, disp)

##                   disp
## Mazda RX4          160
## Mazda RX4 Wag      160
## Datsun 710         108
## Hornet 4 Drive     258
## Hornet Sportabout  360

sample_cols <- function(df, ..., n = 5) {
  qu_cols <- enquos(...)
  head(select2(df, !!! qu_cols), n)
}

sample_cols(mtcars, disp, cyl)

##                   disp cyl
## Mazda RX4          160   6
## Mazda RX4 Wag      160   6
## Datsun 710         108   4
## Hornet 4 Drive     258   6
## Hornet Sportabout  360   8

Or expressions

sample_col <- function(df, col, n = 5) {
  qu_col <- enexpr(col)
  head(select(df, !! qu_col), n)
}

sample_col(mtcars, disp)

##                   disp
## Mazda RX4          160
## Mazda RX4 Wag      160
## Datsun 710         108
## Hornet 4 Drive     258
## Hornet Sportabout  360

sample_cols <- function(df, ..., n = 5) {
  qu_cols <- enexprs(...)
  head(select2(df, !!! qu_cols), n)
}

sample_cols(mtcars, disp, cyl)

##                   disp cyl
## Mazda RX4          160   6
## Mazda RX4 Wag      160   6
## Datsun 710         108   4
## Hornet 4 Drive     258   6
## Hornet Sportabout  360   8

Or Curly Curl

**new standard as of rlang 0.4.0

sample_col <- function(df, col, n = 5) {
  head(select2(df, {{col}}), n)
}

sample_col(mtcars, disp)

##                   disp
## Mazda RX4          160
## Mazda RX4 Wag      160
## Datsun 710         108
## Hornet 4 Drive     258
## Hornet Sportabout  360

sample_cols <- function(df, ..., n = 5) {
  head(select2(df, ...), n)
}

sample_cols(mtcars, disp, cyl)

##                   disp cyl
## Mazda RX4          160   6
## Mazda RX4 Wag      160   6
## Datsun 710         108   4
## Hornet 4 Drive     258   6
## Hornet Sportabout  360   8

Pass strings onto functions using expression

use .data

Applications

Fetching Model Training Data from Global Environment

save the call using match.call()

slope_model <- function(data, form) {
  m <- lm(form, data)
  structure(
    list(
      slope = m$coefficients[[2]],
      intercept = m$coefficients[[1]],
      call = match.call()
    ),
    class = "slope_model"
  )
}

plot.slope_model <- function(m) {
  stopifnot(inherits(m, "slope_model"))
  
  data_expr <- m$call[["data"]]
  stopifnot(exists(deparse(data_expr)))
  cols <- colnames(eval(data_expr))
  
  
  form <- m$call[["form"]]
  y_expr <- rlang::f_lhs(form)
  x_expr <- rlang::f_rhs(form)
  y_str <- deparse(y_expr)
  x_str <- deparse(x_expr)
  stopifnot(c(y_str, y_str) %in% cols)
  
  eval(data_expr) %>%
    select({{y_expr}}, {{x_expr}}) %>%
    ggplot(aes({{x_expr}}, {{y_expr}})) +
      geom_point() +
      geom_abline(slope = m$slope, intercept = m$intercept) +
      theme_minimal()
  
}

m <- slope_model(mtcars, disp ~ hp)
m

## $slope
## [1] 1.42977
## 
## $intercept
## [1] 20.99248
## 
## $call
## slope_model(data = mtcars, form = disp ~ hp)
## 
## attr(,"class")
## [1] "slope_model"

plot(m)

pryr::object_size(m)

## 1,520 B

pryr::object_size({m$data <- mtcars})

## 7,208 B

Correcting Calls for Wrapped Modelling Functions

when we write a wrapper the saved call cannot be used to reconstruct the actual call. And methods relying on it will not work

wr_slope <- function(data, form) {
  slope_model(data, form)
}

m <- wr_slope(mtcars, disp ~ hp)
m

## $slope
## [1] 1.42977
## 
## $intercept
## [1] 20.99248
## 
## $call
## slope_model(data = data, form = form)
## 
## attr(,"class")
## [1] "slope_model"

plot(m)

## Error: `x` must be a formula

we need to reconstruct a new call inside the wrapper and pass it to the modelling function.

wr_slope <- function(data, form) {
  data <- enexpr(data)
  form <- enexpr(form)
  
  new_call <- expr(slope_model(!!data, !!form))
  eval(new_call)
}

m <- wr_slope(mtcars, disp ~ hp)
m

## $slope
## [1] 1.42977
## 
## $intercept
## [1] 20.99248
## 
## $call
## slope_model(data = mtcars, form = disp ~ hp)
## 
## attr(,"class")
## [1] "slope_model"

plot(m)

attaching the call to the model object is risky because if the modeling function is used by do.call or purr::map we risk attaching the entire data to the call.

do.call(slope_model, list(mtcars, disp ~ hp))

## $slope
## [1] 1.42977
## 
## $intercept
## [1] 20.99248
## 
## $call
## (function(data, form) {
##   m <- lm(form, data)
##   structure(
##     list(
##       slope = m$coefficients[[2]],
##       intercept = m$coefficients[[1]],
##       call = match.call()
##     ),
##     class = "slope_model"
##   )
## })(data = list(mpg = c(21, 21, 22.8, 21.4, 18.7, 18.1, 14.3, 
## 24.4, 22.8, 19.2, 17.8, 16.4, 17.3, 15.2, 10.4, 10.4, 14.7, 32.4, 
## 30.4, 33.9, 21.5, 15.5, 15.2, 13.3, 19.2, 27.3, 26, 30.4, 15.8, 
## 19.7, 15, 21.4), cyl = c(6, 6, 4, 6, 8, 6, 8, 4, 4, 6, 6, 8, 
## 8, 8, 8, 8, 8, 4, 4, 4, 4, 8, 8, 8, 8, 4, 4, 4, 8, 6, 8, 4), 
##     disp = c(160, 160, 108, 258, 360, 225, 360, 146.7, 140.8, 
##     167.6, 167.6, 275.8, 275.8, 275.8, 472, 460, 440, 78.7, 75.7, 
##     71.1, 120.1, 318, 304, 350, 400, 79, 120.3, 95.1, 351, 145, 
##     301, 121), hp = c(110, 110, 93, 110, 175, 105, 245, 62, 95, 
##     123, 123, 180, 180, 180, 205, 215, 230, 66, 52, 65, 97, 150, 
##     150, 245, 175, 66, 91, 113, 264, 175, 335, 109), drat = c(3.9, 
##     3.9, 3.85, 3.08, 3.15, 2.76, 3.21, 3.69, 3.92, 3.92, 3.92, 
##     3.07, 3.07, 3.07, 2.93, 3, 3.23, 4.08, 4.93, 4.22, 3.7, 2.76, 
##     3.15, 3.73, 3.08, 4.08, 4.43, 3.77, 4.22, 3.62, 3.54, 4.11
##     ), wt = c(2.62, 2.875, 2.32, 3.215, 3.44, 3.46, 3.57, 3.19, 
##     3.15, 3.44, 3.44, 4.07, 3.73, 3.78, 5.25, 5.424, 5.345, 2.2, 
##     1.615, 1.835, 2.465, 3.52, 3.435, 3.84, 3.845, 1.935, 2.14, 
##     1.513, 3.17, 2.77, 3.57, 2.78), qsec = c(16.46, 17.02, 18.61, 
##     19.44, 17.02, 20.22, 15.84, 20, 22.9, 18.3, 18.9, 17.4, 17.6, 
##     18, 17.98, 17.82, 17.42, 19.47, 18.52, 19.9, 20.01, 16.87, 
##     17.3, 15.41, 17.05, 18.9, 16.7, 16.9, 14.5, 15.5, 14.6, 18.6
##     ), vs = c(0, 0, 1, 1, 0, 1, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 
##     0, 1, 1, 1, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1), am = c(1, 
##     1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 
##     0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1), gear = c(4, 4, 4, 3, 
##     3, 3, 3, 4, 4, 4, 4, 3, 3, 3, 3, 3, 3, 4, 4, 4, 3, 3, 3, 
##     3, 3, 4, 5, 5, 5, 5, 5, 4), carb = c(4, 4, 1, 1, 2, 1, 4, 
##     2, 2, 4, 4, 3, 3, 3, 4, 4, 4, 1, 2, 1, 1, 2, 2, 4, 2, 1, 
##     2, 2, 4, 6, 8, 2)), form = disp ~ hp)
## 
## attr(,"class")
## [1] "slope_model"

do.call(wr_slope, list(mtcars, disp ~ hp))

## $slope
## [1] 1.42977
## 
## $intercept
## [1] 20.99248
## 
## $call
## slope_model(data = list(mpg = c(21, 21, 22.8, 21.4, 18.7, 18.1, 
## 14.3, 24.4, 22.8, 19.2, 17.8, 16.4, 17.3, 15.2, 10.4, 10.4, 14.7, 
## 32.4, 30.4, 33.9, 21.5, 15.5, 15.2, 13.3, 19.2, 27.3, 26, 30.4, 
## 15.8, 19.7, 15, 21.4), cyl = c(6, 6, 4, 6, 8, 6, 8, 4, 4, 6, 
## 6, 8, 8, 8, 8, 8, 8, 4, 4, 4, 4, 8, 8, 8, 8, 4, 4, 4, 8, 6, 8, 
## 4), disp = c(160, 160, 108, 258, 360, 225, 360, 146.7, 140.8, 
## 167.6, 167.6, 275.8, 275.8, 275.8, 472, 460, 440, 78.7, 75.7, 
## 71.1, 120.1, 318, 304, 350, 400, 79, 120.3, 95.1, 351, 145, 301, 
## 121), hp = c(110, 110, 93, 110, 175, 105, 245, 62, 95, 123, 123, 
## 180, 180, 180, 205, 215, 230, 66, 52, 65, 97, 150, 150, 245, 
## 175, 66, 91, 113, 264, 175, 335, 109), drat = c(3.9, 3.9, 3.85, 
## 3.08, 3.15, 2.76, 3.21, 3.69, 3.92, 3.92, 3.92, 3.07, 3.07, 3.07, 
## 2.93, 3, 3.23, 4.08, 4.93, 4.22, 3.7, 2.76, 3.15, 3.73, 3.08, 
## 4.08, 4.43, 3.77, 4.22, 3.62, 3.54, 4.11), wt = c(2.62, 2.875, 
## 2.32, 3.215, 3.44, 3.46, 3.57, 3.19, 3.15, 3.44, 3.44, 4.07, 
## 3.73, 3.78, 5.25, 5.424, 5.345, 2.2, 1.615, 1.835, 2.465, 3.52, 
## 3.435, 3.84, 3.845, 1.935, 2.14, 1.513, 3.17, 2.77, 3.57, 2.78
## ), qsec = c(16.46, 17.02, 18.61, 19.44, 17.02, 20.22, 15.84, 
## 20, 22.9, 18.3, 18.9, 17.4, 17.6, 18, 17.98, 17.82, 17.42, 19.47, 
## 18.52, 19.9, 20.01, 16.87, 17.3, 15.41, 17.05, 18.9, 16.7, 16.9, 
## 14.5, 15.5, 14.6, 18.6), vs = c(0, 0, 1, 1, 0, 1, 0, 1, 1, 1, 
## 1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 
## 1), am = c(1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
## 1, 1, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1), gear = c(4, 4, 
## 4, 3, 3, 3, 3, 4, 4, 4, 4, 3, 3, 3, 3, 3, 3, 4, 4, 4, 3, 3, 3, 
## 3, 3, 4, 5, 5, 5, 5, 5, 4), carb = c(4, 4, 1, 1, 2, 1, 4, 2, 
## 2, 4, 4, 3, 3, 3, 4, 4, 4, 1, 2, 1, 1, 2, 2, 4, 2, 1, 2, 2, 4, 
## 6, 8, 2)), form = disp ~ hp)
## 
## attr(,"class")
## [1] "slope_model"

do.call(lm, list(disp ~ hp, mtcars))

## 
## Call:
## (function (formula, data, subset, weights, na.action, method = "qr", 
##     model = TRUE, x = FALSE, y = FALSE, qr = TRUE, singular.ok = TRUE, 
##     contrasts = NULL, offset, ...) 
## {
##     ret.x <- x
##     ret.y <- y
##     cl <- match.call()
##     mf <- match.call(expand.dots = FALSE)
##     m <- match(c("formula", "data", "subset", "weights", "na.action", 
##         "offset"), names(mf), 0L)
##     mf <- mf[c(1L, m)]
##     mf$drop.unused.levels <- TRUE
##     mf[[1L]] <- quote(stats::model.frame)
##     mf <- eval(mf, parent.frame())
##     if (method == "model.frame") 
##         return(mf)
##     else if (method != "qr") 
##         warning(gettextf("method = '%s' is not supported. Using 'qr'", 
##             method), domain = NA)
##     mt <- attr(mf, "terms")
##     y <- model.response(mf, "numeric")
##     w <- as.vector(model.weights(mf))
##     if (!is.null(w) && !is.numeric(w)) 
##         stop("'weights' must be a numeric vector")
##     offset <- model.offset(mf)
##     mlm <- is.matrix(y)
##     ny <- if (mlm) 
##         nrow(y)
##     else length(y)
##     if (!is.null(offset)) {
##         if (!mlm) 
##             offset <- as.vector(offset)
##         if (NROW(offset) != ny) 
##             stop(gettextf("number of offsets is %d, should equal %d (number of observations)", 
##                 NROW(offset), ny), domain = NA)
##     }
##     if (is.empty.model(mt)) {
##         x <- NULL
##         z <- list(coefficients = if (mlm) matrix(NA_real_, 0, 
##             ncol(y)) else numeric(), residuals = y, fitted.values = 0 * 
##             y, weights = w, rank = 0L, df.residual = if (!is.null(w)) sum(w != 
##             0) else ny)
##         if (!is.null(offset)) {
##             z$fitted.values <- offset
##             z$residuals <- y - offset
##         }
##     }
##     else {
##         x <- model.matrix(mt, mf, contrasts)
##         z <- if (is.null(w)) 
##             lm.fit(x, y, offset = offset, singular.ok = singular.ok, 
##                 ...)
##         else lm.wfit(x, y, w, offset = offset, singular.ok = singular.ok, 
##             ...)
##     }
##     class(z) <- c(if (mlm) "mlm", "lm")
##     z$na.action <- attr(mf, "na.action")
##     z$offset <- offset
##     z$contrasts <- attr(x, "contrasts")
##     z$xlevels <- .getXlevels(mt, mf)
##     z$call <- cl
##     z$terms <- mt
##     if (model) 
##         z$model <- mf
##     if (ret.x) 
##         z$x <- x
##     if (ret.y) 
##         z$y <- y
##     if (!qr) 
##         z$qr <- NULL
##     z
## })(formula = disp ~ hp, data = structure(list(mpg = c(21, 21, 
## 22.8, 21.4, 18.7, 18.1, 14.3, 24.4, 22.8, 19.2, 17.8, 16.4, 17.3, 
## 15.2, 10.4, 10.4, 14.7, 32.4, 30.4, 33.9, 21.5, 15.5, 15.2, 13.3, 
## 19.2, 27.3, 26, 30.4, 15.8, 19.7, 15, 21.4), cyl = c(6, 6, 4, 
## 6, 8, 6, 8, 4, 4, 6, 6, 8, 8, 8, 8, 8, 8, 4, 4, 4, 4, 8, 8, 8, 
## 8, 4, 4, 4, 8, 6, 8, 4), disp = c(160, 160, 108, 258, 360, 225, 
## 360, 146.7, 140.8, 167.6, 167.6, 275.8, 275.8, 275.8, 472, 460, 
## 440, 78.7, 75.7, 71.1, 120.1, 318, 304, 350, 400, 79, 120.3, 
## 95.1, 351, 145, 301, 121), hp = c(110, 110, 93, 110, 175, 105, 
## 245, 62, 95, 123, 123, 180, 180, 180, 205, 215, 230, 66, 52, 
## 65, 97, 150, 150, 245, 175, 66, 91, 113, 264, 175, 335, 109), 
##     drat = c(3.9, 3.9, 3.85, 3.08, 3.15, 2.76, 3.21, 3.69, 3.92, 
##     3.92, 3.92, 3.07, 3.07, 3.07, 2.93, 3, 3.23, 4.08, 4.93, 
##     4.22, 3.7, 2.76, 3.15, 3.73, 3.08, 4.08, 4.43, 3.77, 4.22, 
##     3.62, 3.54, 4.11), wt = c(2.62, 2.875, 2.32, 3.215, 3.44, 
##     3.46, 3.57, 3.19, 3.15, 3.44, 3.44, 4.07, 3.73, 3.78, 5.25, 
##     5.424, 5.345, 2.2, 1.615, 1.835, 2.465, 3.52, 3.435, 3.84, 
##     3.845, 1.935, 2.14, 1.513, 3.17, 2.77, 3.57, 2.78), qsec = c(16.46, 
##     17.02, 18.61, 19.44, 17.02, 20.22, 15.84, 20, 22.9, 18.3, 
##     18.9, 17.4, 17.6, 18, 17.98, 17.82, 17.42, 19.47, 18.52, 
##     19.9, 20.01, 16.87, 17.3, 15.41, 17.05, 18.9, 16.7, 16.9, 
##     14.5, 15.5, 14.6, 18.6), vs = c(0, 0, 1, 1, 0, 1, 0, 1, 1, 
##     1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 1, 0, 1, 
##     0, 0, 0, 1), am = c(1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
##     0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1), 
##     gear = c(4, 4, 4, 3, 3, 3, 3, 4, 4, 4, 4, 3, 3, 3, 3, 3, 
##     3, 4, 4, 4, 3, 3, 3, 3, 3, 4, 5, 5, 5, 5, 5, 4), carb = c(4, 
##     4, 1, 1, 2, 1, 4, 2, 2, 4, 4, 3, 3, 3, 4, 4, 4, 1, 2, 1, 
##     1, 2, 2, 4, 2, 1, 2, 2, 4, 6, 8, 2)), row.names = c("Mazda RX4", 
## "Mazda RX4 Wag", "Datsun 710", "Hornet 4 Drive", "Hornet Sportabout", 
## "Valiant", "Duster 360", "Merc 240D", "Merc 230", "Merc 280", 
## "Merc 280C", "Merc 450SE", "Merc 450SL", "Merc 450SLC", "Cadillac Fleetwood", 
## "Lincoln Continental", "Chrysler Imperial", "Fiat 128", "Honda Civic", 
## "Toyota Corolla", "Toyota Corona", "Dodge Challenger", "AMC Javelin", 
## "Camaro Z28", "Pontiac Firebird", "Fiat X1-9", "Porsche 914-2", 
## "Lotus Europa", "Ford Pantera L", "Ferrari Dino", "Maserati Bora", 
## "Volvo 142E"), class = "data.frame"))
## 
## Coefficients:
## (Intercept)           hp  
##       20.99         1.43

This is why a size check for the saving the call is required in the tidymodels convention guide

df_m <- mtcars %>%
  group_by(cyl) %>%
  nest() %>%
  mutate(m = map(data, wr_slope, disp ~ hp))

map(df_m$m, ~ .$call)

## [[1]]
## slope_model(data = list(mpg = c(21, 21, 21.4, 18.1, 19.2, 17.8, 
## 19.7), disp = c(160, 160, 258, 225, 167.6, 167.6, 145), hp = c(110, 
## 110, 110, 105, 123, 123, 175), drat = c(3.9, 3.9, 3.08, 2.76, 
## 3.92, 3.92, 3.62), wt = c(2.62, 2.875, 3.215, 3.46, 3.44, 3.44, 
## 2.77), qsec = c(16.46, 17.02, 19.44, 20.22, 18.3, 18.9, 15.5), 
##     vs = c(0, 0, 1, 1, 1, 1, 0), am = c(1, 1, 0, 0, 0, 0, 1), 
##     gear = c(4, 4, 3, 3, 4, 4, 5), carb = c(4, 4, 1, 1, 4, 4, 
##     6)), form = disp ~ hp)
## 
## [[2]]
## slope_model(data = list(mpg = c(22.8, 24.4, 22.8, 32.4, 30.4, 
## 33.9, 21.5, 27.3, 26, 30.4, 21.4), disp = c(108, 146.7, 140.8, 
## 78.7, 75.7, 71.1, 120.1, 79, 120.3, 95.1, 121), hp = c(93, 62, 
## 95, 66, 52, 65, 97, 66, 91, 113, 109), drat = c(3.85, 3.69, 3.92, 
## 4.08, 4.93, 4.22, 3.7, 4.08, 4.43, 3.77, 4.11), wt = c(2.32, 
## 3.19, 3.15, 2.2, 1.615, 1.835, 2.465, 1.935, 2.14, 1.513, 2.78
## ), qsec = c(18.61, 20, 22.9, 19.47, 18.52, 19.9, 20.01, 18.9, 
## 16.7, 16.9, 18.6), vs = c(1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1), am = c(1, 
## 0, 0, 1, 1, 1, 0, 1, 1, 1, 1), gear = c(4, 4, 4, 4, 4, 4, 3, 
## 4, 5, 5, 4), carb = c(1, 2, 2, 1, 2, 1, 1, 1, 2, 2, 2)), form = disp ~ 
##     hp)
## 
## [[3]]
## slope_model(data = list(mpg = c(18.7, 14.3, 16.4, 17.3, 15.2, 
## 10.4, 10.4, 14.7, 15.5, 15.2, 13.3, 19.2, 15.8, 15), disp = c(360, 
## 360, 275.8, 275.8, 275.8, 472, 460, 440, 318, 304, 350, 400, 
## 351, 301), hp = c(175, 245, 180, 180, 180, 205, 215, 230, 150, 
## 150, 245, 175, 264, 335), drat = c(3.15, 3.21, 3.07, 3.07, 3.07, 
## 2.93, 3, 3.23, 2.76, 3.15, 3.73, 3.08, 4.22, 3.54), wt = c(3.44, 
## 3.57, 4.07, 3.73, 3.78, 5.25, 5.424, 5.345, 3.52, 3.435, 3.84, 
## 3.845, 3.17, 3.57), qsec = c(17.02, 15.84, 17.4, 17.6, 18, 17.98, 
## 17.82, 17.42, 16.87, 17.3, 15.41, 17.05, 14.5, 14.6), vs = c(0, 
## 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), am = c(0, 0, 0, 0, 0, 
## 0, 0, 0, 0, 0, 0, 0, 1, 1), gear = c(3, 3, 3, 3, 3, 3, 3, 3, 
## 3, 3, 3, 3, 5, 5), carb = c(2, 4, 3, 3, 3, 4, 4, 4, 2, 2, 4, 
## 2, 4, 8)), form = disp ~ hp)

map(df_m$m, plot)

## Error in exists(deparse(data_expr)): first argument has length > 1

instead attach arguments individually

training_data <- function(name, df) {
  structure(
    list(
      name = stringr::str_trunc(name, width = 120)[[1]],
      cols = colnames(df),
      dim = dim(df)
    ),
    class = "train_data"
  )
}

match_training_data <- function(df, train_data) {
  
  stopifnot(is.data.frame(df))
  
  stopifnot(all(train_data$cols %in% colnames(df)))
  
  df <- df[, train_data$cols]
  
  stopifnot(all(dim(df) == train_data$dim))
  
  return(TRUE)
}

slope_model2 <- function(data, form) {
  
  y <- deparse(rlang::f_lhs(form))
  x <- deparse(rlang::f_rhs(form))
  data_name <- deparse(rlang::enexpr(data))
  
  train_data <- training_data(data_name, data[, c(x, y)])
  
  m <- lm(form, data)
  
  
  structure(
    list(
      slope = m$coefficients[[2]],
      intercept = m$coefficients[[1]],
      train_data = train_data,
      x = x,
      y = y
    ),
    class = "slope_model"
  )
}

plot.slope_model <- function(m, data = NULL) {
  stopifnot(inherits(m, "slope_model"))
  
  if (is.null(data) & exists(m$train_data$name)) {
    df_train <- eval(parse(text = m$train_data$name))
    match_training_data(df_train, m$train_data)
  } else if (! is.null(data)) {
    df_train <- data 
    match_training_data(df_train, m$train_data)
  } else {
    stop("training data not found")
  }
  
  ggplot(df_train, aes_string(m$x, m$y)) +
      geom_point() +
      geom_abline(slope = m$slope, intercept = m$intercept) +
      theme_minimal()
  
}


m <- slope_model2(mtcars, disp ~ hp)
str(m)

## List of 5
##  $ slope     : num 1.43
##  $ intercept : num 21
##  $ train_data:List of 3
##   ..$ name: chr "mtcars"
##   ..$ cols: chr [1:2] "hp" "disp"
##   ..$ dim : int [1:2] 32 2
##   ..- attr(*, "class")= chr "train_data"
##  $ x         : chr "hp"
##  $ y         : chr "disp"
##  - attr(*, "class")= chr "slope_model"

plot(m)

check wrapper compatibility

wr_slope <- function(data, form) {
  slope_model2(data, form)
}

m <- wr_slope(mtcars, disp ~ hp)
str(m)

## List of 5
##  $ slope     : num 1.43
##  $ intercept : num 21
##  $ train_data:List of 3
##   ..$ name: chr "data"
##   ..$ cols: chr [1:2] "hp" "disp"
##   ..$ dim : int [1:2] 32 2
##   ..- attr(*, "class")= chr "train_data"
##  $ x         : chr "hp"
##  $ y         : chr "disp"
##  - attr(*, "class")= chr "slope_model"

plot(m)

## Error in match_training_data(df_train, m$train_data): is.data.frame(df) is not TRUE

plot(m, mtcars)

still need it

wr_slope2 <- function(data, form) {
  data <- enexpr(data)
  form <- enexpr(form)
  
  new_call <- expr(slope_model2(!!data, !!form))
  eval(new_call)
}

m <- wr_slope2(mtcars, disp ~ hp)
str(m)

## List of 5
##  $ slope     : num 1.43
##  $ intercept : num 21
##  $ train_data:List of 3
##   ..$ name: chr "mtcars"
##   ..$ cols: chr [1:2] "hp" "disp"
##   ..$ dim : int [1:2] 32 2
##   ..- attr(*, "class")= chr "train_data"
##  $ x         : chr "hp"
##  $ y         : chr "disp"
##  - attr(*, "class")= chr "slope_model"

plot(m)

do.call

m <- do.call(slope_model2, list(mtcars, disp ~ hp))
str(m)

## List of 5
##  $ slope     : num 1.43
##  $ intercept : num 21
##  $ train_data:List of 3
##   ..$ name: chr "structure(list(mpg = c(21, 21, 22.8, 21.4, 18.7, 18.1, 14.3, "
##   ..$ cols: chr [1:2] "hp" "disp"
##   ..$ dim : int [1:2] 32 2
##   ..- attr(*, "class")= chr "train_data"
##  $ x         : chr "hp"
##  $ y         : chr "disp"
##  - attr(*, "class")= chr "slope_model"

plot(m)

## Error in plot.slope_model(m): training data not found

plot(m, mtcars)

Printing R Code for ggplots Plots

we want to display the r code necessary to render a plot

plot_vars <- function(df, x, y, smooth = FALSE) {
    df <- enexpr(df)
    x <- enexpr(x)
    y <- enexpr(y)
    
    ex <- expr(
      ggplot(!!df, aes(!! x, !!y)) +
        geom_point()
    )
    
    if(smooth){
      ex <- expr(!! ex + geom_smooth())
    }
    
    return(ex)
}

ex <- plot_vars(mtcars, disp, hp)
cat(deparse(ex))

## ggplot(mtcars, aes(disp, hp)) + geom_point()

eval(plot_vars(mtcars, disp, hp))

ex_smooth <- plot_vars(mtcars, disp, hp, smooth = TRUE)

cat(deparse(ex_smooth))

## ggplot(mtcars, aes(disp, hp)) + geom_point() + geom_smooth()

eval(ex_smooth)

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

Advanced R - Notes (part1)

Wed, 13 Oct 2021 00:00:00 +0000

Advanced R (Hadley Wickham).

knitr::opts_chunk$set(error = TRUE)

suppressPackageStartupMessages(library(tidyverse))
suppressPackageStartupMessages(library(rlang))
suppressPackageStartupMessages(library(lobstr))
suppressPackageStartupMessages(library(withr))
suppressPackageStartupMessages(library(glue))
# devtools::install_github("openpharma/simaerep@v0.3.1")
suppressPackageStartupMessages(library(simaerep))

Functions

Conventions for arguments that come from a set of strings

center <- function(x, type = c("mean", "median", "trimmed")) {
  type <- match.arg(type)
  switch(type,
         mean = mean(x),
         median = median(x),
         trimmed = mean(x, trim = .1))
}

Functions to Investigate Functions

.f <- function(x,y){
  # Comment
  x + y
}
formals(.f) # returns arguments

## $x
## 
## 
## $y

body(.f) # returns body without comments

## {
##     x + y
## }

environment(.f)

## <environment: R_GlobalEnv>

attributes(.f)$srcref # returns body with commments

## function(x,y){
##   # Comment
##   x + y
## }

Get all Functions from package

objs <- mget(ls("package:base", all = TRUE), inherits = TRUE)
funs <- Filter(is.function, objs)

Function with the most arguments

primitive base functions written in C are either of type “builtin” or “special”. formals(), body()and environment() will return NULL for those functions.

df_funs <- tibble(funs = funs,
       names = names(funs) ) %>%
  mutate(formals = map(funs, formals),
         n_args = map_int(formals, length),
         type = map_chr(funs, typeof)) %>%
  arrange(desc(n_args))

df_funs

## # A tibble: 1,323 × 5
##    funs         names            formals      n_args type   
##    <named list> <chr>            <named list>  <int> <chr>  
##  1 <fn>         scan             <pairlist>       22 closure
##  2 <fn>         format.default   <pairlist>       16 closure
##  3 <fn>         source           <pairlist>       16 closure
##  4 <fn>         formatC          <pairlist>       15 closure
##  5 <fn>         library          <pairlist>       13 closure
##  6 <fn>         merge.data.frame <pairlist>       13 closure
##  7 <fn>         prettyNum        <pairlist>       13 closure
##  8 <fn>         system2          <pairlist>       11 closure
##  9 <fn>         print.default    <pairlist>       10 closure
## 10 <fn>         save             <pairlist>       10 closure
## # … with 1,313 more rows

df_funs %>%
  group_by(type, n_args == 0) %>%
  count()

## # A tibble: 4 × 3
## # Groups:   type, n_args == 0 [4]
##   type    `n_args == 0`     n
##   <chr>   <lgl>         <int>
## 1 builtin TRUE            165
## 2 closure FALSE          1072
## 3 closure TRUE             47
## 4 special TRUE             39

Scoping

Search Environment

my_string <- "hello world"

exists("my_string")

## [1] TRUE

exists("my_string_2")

## [1] FALSE

get0("my_string")

## [1] "hello world"

get0("my_string_2")

## NULL

ls() # get all variable names

## [1] "center"    "df_funs"   "funs"      "my_string" "objs"

List unbound global variables

g12 <- function() x + 1
codetools::findGlobals(g12)

## [1] "+" "x"

g13 <- function(x) x + 1
codetools::findGlobals(g13)

## [1] "+"

Lazy Evaluation of Arguments

arguments even when given as expressions will only be evaluated when called in the function, these structures are called promises. So this works, surprisingly:

h04 <- function(x = 1, y = x * 2, z = a + b) {
  a <- 10
  b <- 100
  
  c(x, y, z)
}

But only when supplied as default arguments not when user-supplied

h04(1, x * 2, a + b)

## Error in h04(1, x * 2, a + b): object 'x' not found

User-Supplied arguments are evaluated before they are passed to the function, that is why infix functions and operators such as + and %%are working.

Default arguments are evaluated as promises only when they are called within the function.

Reminder infix functions take two arguments, code that comes directly before and right after. User defined infix functions need to be defined like this with `%name% <- function(lhs, rhs)`

x <- 1

!is.null(x) && length(x) == 1 && x > 0

## [1] TRUE

# in python we would need to put brackets around the logic statements
(!is.null(x)) && (length(x) == 1) && (x > 0)

## [1] TRUE

c(TRUE, FALSE) && c(TRUE, FALSE) # evaluation stops at first element

## [1] TRUE

c(TRUE, FALSE) & c(TRUE, FALSE) # all elements are pair-wise evaluated

## [1]  TRUE FALSE

FALSE && NULL # evaluation stops after result is determined by first argument FALSE

## [1] FALSE

FALSE || NULL # gives error because NULL needs to be evaluated for OR condition

## Error in FALSE || NULL: invalid 'y' type in 'x || y'

FALSE & NULL # I would expect this to error too

## logical(0)

FALSE | NULL # this as well mmh

## logical(0)

Default or User Supplied argument

h06 <- function(x = 10) {
  is_default <- missing(x)
  return(is_default)
}

h06()

## [1] TRUE

h06(10)

## [1] FALSE

Capture dot dot dot

i03 <- function(...) {
  list(first = ..1, third = ..3)
}
str(i03(1, 2, 3))

## List of 2
##  $ first: num 1
##  $ third: num 3

i04 <- function(...) {
  list(...)
}
str(i04(a = 1, b = 2))

## List of 2
##  $ a: num 1
##  $ b: num 2

Exit Handler `on.exit()`

Always set add = TRUE when using on.exit(). If you don’t, each call to on.exit() will overwrite the previous exit handler. Even when only registering a single handler, it’s good practice to set add = TRUE so that you won’t get any unpleasant surprises if you later add more exit handlers.

j06 <- function(x) {
  cat("Hello\n")
  on.exit(cat("Goodbye!\n"), add = TRUE)
  
  if (x) {
    return(10)
  } else {
    stop("Error")
  }
}

j06(TRUE)

## Hello
## Goodbye!

## [1] 10

j06(FALSE)

## Hello

## Error in j06(FALSE): Error

## Goodbye!

Better than using on.exit is actually to use functions of the withr package that automatically provide cleanups for files and directories

Capture output `capture.output()`

also captures error messages

Everything that happens in R is a function call

Almost everything can be rewritten as a function call

x + y

## Error in eval(expr, envir, enclos): object 'y' not found

`+`(x, y)

## Error in eval(expr, envir, enclos): object 'y' not found

names(df) <- c("x", "y", "z")

## Error in names(df) <- c("x", "y", "z"): names() applied to a non-vector

`names<-`(df, c("x", "y", "z"))

## Error in eval(expr, envir, enclos): names() applied to a non-vector

for(i in 1:10) print(i)

## [1] 1
## [1] 2
## [1] 3
## [1] 4
## [1] 5
## [1] 6
## [1] 7
## [1] 8
## [1] 9
## [1] 10

`for`(i, 1:10, print(i))

## [1] 1
## [1] 2
## [1] 3
## [1] 4
## [1] 5
## [1] 6
## [1] 7
## [1] 8
## [1] 9
## [1] 10

Replacement Functions

`second<-` <- function(x, value) {
  x[2] <- value
  x
}

x <- 1:10
second(x) <- 5

x

##  [1]  1  5  3  4  5  6  7  8  9 10

Environments

Generally, an environment is similar to a named list, with four important exceptions:

Every name must be unique.
The names in an environment are not ordered.
An environment has a parent.
Environments are not copied when modified.

e1 <- env(
  a = FALSE,
  b = "a",
  c = 2.3,
  d = 1:3,
)

rlang::env_print(e1)

## <environment: 0x7fd2d346bac0>
## parent: <environment: global>
## bindings:
##  * a: <lgl>
##  * b: <chr>
##  * c: <dbl>
##  * d: <int>

rlang::env_names(e1)

## [1] "a" "b" "c" "d"

Create a parent environment

e2 <- env(e1, letters = LETTERS)

rlang::env_parent(e2)

## <environment: 0x7fd2d346bac0>

rlang::env_parents(e2)

## [[1]]   <env: 0x7fd2d346bac0>
## [[2]] $ <env: global>

Packages

Composition of the global environment

search()

##  [1] ".GlobalEnv"        "package:simaerep"  "package:glue"     
##  [4] "package:withr"     "package:lobstr"    "package:rlang"    
##  [7] "package:forcats"   "package:stringr"   "package:dplyr"    
## [10] "package:purrr"     "package:readr"     "package:tidyr"    
## [13] "package:tibble"    "package:ggplot2"   "package:tidyverse"
## [16] "package:stats"     "package:graphics"  "package:grDevices"
## [19] "package:utils"     "package:datasets"  "package:methods"  
## [22] "Autoloads"         "package:base"

rlang::search_envs()

##  [[1]] $ <env: global>
##  [[2]] $ <env: package:simaerep>
##  [[3]] $ <env: package:glue>
##  [[4]] $ <env: package:withr>
##  [[5]] $ <env: package:lobstr>
##  [[6]] $ <env: package:rlang>
##  [[7]] $ <env: package:forcats>
##  [[8]] $ <env: package:stringr>
##  [[9]] $ <env: package:dplyr>
## [[10]] $ <env: package:purrr>
## [[11]] $ <env: package:readr>
## [[12]] $ <env: package:tidyr>
## [[13]] $ <env: package:tibble>
## [[14]] $ <env: package:ggplot2>
## [[15]] $ <env: package:tidyverse>
## [[16]] $ <env: package:stats>
## [[17]] $ <env: package:graphics>
## [[18]] $ <env: package:grDevices>
## [[19]] $ <env: package:utils>
## [[20]] $ <env: package:datasets>
## ... and 3 more environments

Package Functions

passively bound by one environment (where they can be called from)
actively bind one environment (which they use to make their calls)

for regular functions both environments are the same. For functions loaded from packages the bind environment is defined by the package namespace created from the package NAMESPACE file. Like this they are not affected by overrides in the execution environment.

Callstacks

use lobstr::cst() in a similar way to traceback() to visualise the callstack.

f <- function(x) {
  g(x = 2)
}
g <- function(x) {
  h(x = 3)
}
h <- function(x) {
  stop()
}

f(x = 1)

## Error in h(x = 3):

traceback()

## No traceback available

h <- function(x) {
  lobstr::cst()
  print("do I get executed =")
}

f(x = 1)

##     █
##  1. └─global::f(x = 1)
##  2.   └─global::g(x = 2)
##  3.     └─global::h(x = 3)
##  4.       └─lobstr::cst()
## [1] "do I get executed ="

Conditions

Warnings

give_warning <- function() {
  warning("You have been warned")
}

withr::with_options(list(warn = 1), give_warning()) # causes warning to appear immediately

## Warning in give_warning(): You have been warned

withr::with_options(list(warn = 2), give_warning()) # convert warning to error

## Error in give_warning(): (converted from warning) You have been warned

Condition Objects

conditions such as messages, warnings and errors are objects

cnd <- rlang::catch_cnd(stop("An error"))
str(cnd)

## List of 2
##  $ message: chr "An error"
##  $ call   : language force(expr)
##  - attr(*, "class")= chr [1:3] "simpleError" "error" "condition"

tryCatch

tryCatch executes code and has arguments for different types of condition objects. Each arguments takes a function with a single condition object argument.

try_me <- function(expr) {
    tryCatch(
      error = function(cnd) print("error"),
      warning = function(cnd) print("warning"),
      message = function(cnd) print("message"),
      finally = print("finished"),
      expr
  )
}

try_me(stop("hello"))

## [1] "error"
## [1] "finished"

try_me(warning("hello"))

## [1] "warning"
## [1] "finished"

try_me(message("hello"))

## [1] "message"
## [1] "finished"

variable assignments within trycatch are not passed to parent env

if(exists("res")) remove(res)
tryCatch(
  warning = function(cnd) res <- 0,
  res <- log(-1)
)
exists("res")

## [1] FALSE

this does not work because user-defined arguments are evaluated on the spot, so alternative expression always gets evaluated

try_me3 <- function(expr, expr_alt) {
    tryCatch(
      warning = function(cnd) expr_alt,
      expr
  )
}

try_me3(res <- log(-1), res <- 0)
res

## [1] 0

try_me3(res <- log(1), res <- 0)
res

## [1] 0

tryCatch returns last value which can be assigned inside the active env

if(exists("res")) remove(res)
res <- tryCatch(
  warning = function(cnd) 0,
  log(-1)
)

res

## [1] 0

withCallingHandlers

withCallingHandlers still executes the condition, while tryCatch muffles them.

try_me <- function(expr) {
    withCallingHandlers(
      error = function(cnd) print("error"),
      warning = function(cnd) print("warning"),
      message = function(cnd) print("message"),
      finally = print("finished"),
      expr
  )
}

try_me(stop("hello"))

## [1] "finished"
## [1] "error"

## Error in withCallingHandlers(error = function(cnd) print("error"), warning = function(cnd) print("warning"), : hello

try_me(warning("hello"))

## [1] "finished"
## [1] "warning"

## Warning in withCallingHandlers(error = function(cnd) print("error"), warning =
## function(cnd) print("warning"), : hello

try_me(message("hello"))

## [1] "finished"
## [1] "message"

## hello

Custom Errors

reuse check function to supply consistent error messages
catch and handle different types of errors

We start by defining a custom error Class

We cannot execute the code chunk below because Rmarkdown is not compatible with custom errors

stop_custom <- function(.subclass, message, ...) {
  err <- structure(
    list(
      message = message,
      call = call,
      ...
    ),
    class = c(.subclass, "error", "condition")
  )
  stop(err)
}

stop_custom("error_new", "This is a custom error", x = 10)

err <- rlang::catch_cnd(
  stop_custom("error_new", "This is a custom error", x = 10)
)

class(err)
# we can supply additional arguments that will be attached as attributes
err$x
str(err)

We can then use this new class for creating customized errors

abort_bad_argument <- function(arg, must, not = NULL) {
  msg <- glue::glue("`{arg}` must be {must}")
  if (!is.null(not)) {
    not <- typeof(not)
    msg <- glue::glue("{msg}; not {not}.")
  }
  
  stop_custom("error_bad_argument", 
    message = msg, 
    arg = arg, 
    must = must, 
    not = not
  )
}

abort_bad_argument("key", "numeric", "ABC")

## Error in stop_custom("error_bad_argument", message = msg, arg = arg, must = must, : could not find function "stop_custom"

We can then chose to handle those errors specifically

mylog <- function(x) {
  if(! is.numeric(x)) abort_bad_argument("x", "numeric", x)
  return(log(x))
}

mylog(1)

## [1] 0

mylog("A")

## Error in stop_custom("error_bad_argument", message = msg, arg = arg, must = must, : could not find function "stop_custom"

tryCatch(
  error_bad_argument = function(cnd) NULL,
  mylog("A")
)

## Error in stop_custom("error_bad_argument", message = msg, arg = arg, must = must, : could not find function "stop_custom"

tryCatch(
  error_bad_argument = function(cnd) NULL,
  stop()
)

## Error in doTryCatch(return(expr), name, parentenv, handler):

Functional Programming

Functionals

purrr::reduce

used to apply a function with two arguments to a stack o items by executing on the first to items and saving the result for the next function call to apply with the next item in line.

purrr::reduce(LETTERS, paste0)

## [1] "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

finding an intersection or union

l <- purrr::map(1:4, ~ sample(1:10, 15, replace = T))
str(l)

## List of 4
##  $ : int [1:15] 5 5 1 9 6 9 1 8 4 4 ...
##  $ : int [1:15] 7 3 4 5 2 6 5 9 9 8 ...
##  $ : int [1:15] 1 3 3 7 1 8 10 1 4 10 ...
##  $ : int [1:15] 8 7 7 7 5 6 5 8 5 7 ...

purrr::reduce(l, intersect)

## [1] 8 4 2

purrr::reduce(l, union)

##  [1]  5  1  9  6  8  4  2  7  3 10

adding up numbers

purrr::reduce(c(1, 2, 3), `+`)

## [1] 6

purrr::accumulate

purrr::accumulate(LETTERS, paste0)

##  [1] "A"                          "AB"                        
##  [3] "ABC"                        "ABCD"                      
##  [5] "ABCDE"                      "ABCDEF"                    
##  [7] "ABCDEFG"                    "ABCDEFGH"                  
##  [9] "ABCDEFGHI"                  "ABCDEFGHIJ"                
## [11] "ABCDEFGHIJK"                "ABCDEFGHIJKL"              
## [13] "ABCDEFGHIJKLM"              "ABCDEFGHIJKLMN"            
## [15] "ABCDEFGHIJKLMNO"            "ABCDEFGHIJKLMNOP"          
## [17] "ABCDEFGHIJKLMNOPQ"          "ABCDEFGHIJKLMNOPQR"        
## [19] "ABCDEFGHIJKLMNOPQRS"        "ABCDEFGHIJKLMNOPQRST"      
## [21] "ABCDEFGHIJKLMNOPQRSTU"      "ABCDEFGHIJKLMNOPQRSTUV"    
## [23] "ABCDEFGHIJKLMNOPQRSTUVW"    "ABCDEFGHIJKLMNOPQRSTUVWX"  
## [25] "ABCDEFGHIJKLMNOPQRSTUVWXY"  "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

predicate functional

purr has only some of those

any(LETTERS == "A")

## [1] TRUE

any(as.list(LETTERS) == "A")

## [1] TRUE

purrr::some(LETTERS, ~ . == "A")

## [1] TRUE

is.na

is.na() is not a predicate function because it is vectorized while anyNA is.

is.na(c(NA, 1))

## [1]  TRUE FALSE

anyNA(c(NA, 1))

## [1] TRUE

apply() and friends

vapply() uses and returns vectors
sapply()

ls <- list(a = c(1, 2, 3), b = c(TRUE, FALSE, TRUE, FALSE))
vs <- c("do", "not", "leak")
cl <- structure(ls, class = "apply_test")

purrr::map() is similar to base::lapply() which uses lists as in and output.

purrr::map(ls, sum)

## $a
## [1] 6
## 
## $b
## [1] 2

purrr::map(vs, str_length)

## [[1]]
## [1] 2
## 
## [[2]]
## [1] 3
## 
## [[3]]
## [1] 4

purrr::map(ls, sum)

## $a
## [1] 6
## 
## $b
## [1] 2

lapply(ls, sum)

## $a
## [1] 6
## 
## $b
## [1] 2

lapply(vs, str_length)

## [[1]]
## [1] 2
## 
## [[2]]
## [1] 3
## 
## [[3]]
## [1] 4

lapply(cl, sum)

## $a
## [1] 6
## 
## $b
## [1] 2

sapply() is more flexible and returns vectors if possible

sapply(ls, sum)

## a b 
## 6 2

sapply(vs, str_length)

##   do  not leak 
##    2    3    4

sapply(cl, sum)

## a b 
## 6 2

vapply() is similar to sapply() requires a FUN.Value argument to set requirements for the output.

It compares the length and type of the FUN.Value argument with the output.

vapply(ls, sum)

## Error in vapply(ls, sum): argument "FUN.VALUE" is missing, with no default

vapply(ls, sum, FUN.VALUE = integer(1))

## Error in vapply(ls, sum, FUN.VALUE = integer(1)): values must be type 'integer',
##  but FUN(X[[1]]) result is type 'double'

vapply(ls, sum, FUN.VALUE = double(1))

## a b 
## 6 2

vapply(ls, sum, FUN.VALUE = double(2))

## Error in vapply(ls, sum, FUN.VALUE = double(2)): values must be length 2,
##  but FUN(X[[1]]) result is length 1

vapply(ls, sum, FUN.VALUE = c(c = 8))

## a b 
## 6 2

vapply(ls, sum, FUN.VALUE = "hello")

## Error in vapply(ls, sum, FUN.VALUE = "hello"): values must be type 'character',
##  but FUN(X[[1]]) result is type 'double'

vapply(vs, str_length, 9999)

##   do  not leak 
##    2    3    4

vapply(cl, sum, 1)

## a b 
## 6 2

sapply() can also return a matrix

i39 <- sapply(3:9, seq)
i39

## [[1]]
## [1] 1 2 3
## 
## [[2]]
## [1] 1 2 3 4
## 
## [[3]]
## [1] 1 2 3 4 5
## 
## [[4]]
## [1] 1 2 3 4 5 6
## 
## [[5]]
## [1] 1 2 3 4 5 6 7
## 
## [[6]]
## [1] 1 2 3 4 5 6 7 8
## 
## [[7]]
## [1] 1 2 3 4 5 6 7 8 9

# fivenum returns boxcox stats
x <- fivenum(i39[[1]])

vapply(vs, str_length)

## Error in vapply(vs, str_length): argument "FUN.VALUE" is missing, with no default

vapply(cl, sum)

## Error in vapply(cl, sum): argument "FUN.VALUE" is missing, with no default

lapply(i39, fivenum)

## [[1]]
## [1] 1.0 1.5 2.0 2.5 3.0
## 
## [[2]]
## [1] 1.0 1.5 2.5 3.5 4.0
## 
## [[3]]
## [1] 1 2 3 4 5
## 
## [[4]]
## [1] 1.0 2.0 3.5 5.0 6.0
## 
## [[5]]
## [1] 1.0 2.5 4.0 5.5 7.0
## 
## [[6]]
## [1] 1.0 2.5 4.5 6.5 8.0
## 
## [[7]]
## [1] 1 3 5 7 9

sapply(i39, fivenum)

##      [,1] [,2] [,3] [,4] [,5] [,6] [,7]
## [1,]  1.0  1.0    1  1.0  1.0  1.0    1
## [2,]  1.5  1.5    2  2.0  2.5  2.5    3
## [3,]  2.0  2.5    3  3.5  4.0  4.5    5
## [4,]  2.5  3.5    4  5.0  5.5  6.5    7
## [5,]  3.0  4.0    5  6.0  7.0  8.0    9

vapply() can add row_names

vapply(i39, fivenum,
       c(Min. = 0, "1st Qu." = 0, Median = 0, "3rd Qu." = 0, Max. = 0))

##         [,1] [,2] [,3] [,4] [,5] [,6] [,7]
## Min.     1.0  1.0    1  1.0  1.0  1.0    1
## 1st Qu.  1.5  1.5    2  2.0  2.5  2.5    3
## Median   2.0  2.5    3  3.5  4.0  4.5    5
## 3rd Qu.  2.5  3.5    4  5.0  5.5  6.5    7
## Max.     3.0  4.0    5  6.0  7.0  8.0    9

vapply(i39, fivenum,
       c(Min. = 0, "1st Qu." = 0, Median = 0, "3rd Qu." = 0))

## Error in vapply(i39, fivenum, c(Min. = 0, `1st Qu.` = 0, Median = 0, `3rd Qu.` = 0)): values must be length 4,
##  but FUN(X[[1]]) result is length 5

Function Factories

Functions that return other functions. Those functions are not garbage collectd and need to be deleted manually.

force()

The expression are evaluated lazily thus when x changes the function does not behave as expected.

power <- function(exp) {
  function(x) {
    x ^ exp
  }
}

x <- 2
square <- power(x)
x <- 3
square(2)

## [1] 8

always use force() when creating function factories

power2 <- function(exp) {
  force(exp)
  function(x) {
    x ^ exp
  }
}

x <- 2
square <- power2(x)
x <- 3
square(2)

## [1] 4

Closures (Stateful functions)

not recommended in R

storer <- function(){
  store_var <- 5
  function() store_var
}
storage <- storer()
storage()

## [1] 5

exists("store_var", envir = rlang::current_env())

## [1] FALSE

exists("store_var", envir = environment(storage))

## [1] TRUE

make_counter <- function(){
  count_var <- 0
  function() {
    count_var <<- count_var + 1 # <<- passes the assignment to parent environment where it is preserved via the binding
    count_var
  }
}
counter <- make_counter()
exists("count_var", envir = rlang::current_env())

## [1] FALSE

exists("count_var", envir = environment(counter))

## [1] TRUE

counter()

## [1] 1

counter()

## [1] 2

counter()

## [1] 3

counter()

## [1] 4

Applications

stats::approxfun()
stats::ecdf()
scales::comma_format() and other scales functions
geom_histogram() binwidth argument (see below)
harmonising input arguments of similar functions
Box-Cox Transformation (see below)
Bootstrap Resampling (see below)
Maximum Likelihood Estimation (see below)

geom_histogram

same number of observations with different sd will give a different number of bins in each facet.

sd <- c(1, 5, 15)
n <- 100

df <- data.frame(x = rnorm(3 * n, sd = sd), sd = rep(sd, n))

head(df)

##            x sd
## 1  0.8702774  1
## 2  4.2134232  5
## 3 -9.6693749 15
## 4 -0.5572895  1
## 5 -2.0192570  5
## 6 10.4718642 15

ggplot(df, aes(x)) + 
  geom_histogram(binwidth = 2) + 
  facet_wrap(~ sd, scales = "free_x") + 
  labs(x = NULL)

In order to fix the number of bins per facet we can pass a function instead.

binwidth_bins <- function(n) {
  force(n)
  
  function(x) {
    (max(x) - min(x)) / n
  }
}

ggplot(df, aes(x)) + 
  geom_histogram(binwidth = binwidth_bins(20)) + 
  facet_wrap(~ sd, scales = "free_x") + 
  labs(x = NULL)

geom_function() and stat_function()

in ggplot2 stat_function() and geom_function() allow you to plot a function that returns y of a given x values.

Here the density derived from 100 samples from a normal distribution vs the actual normal density function.

ggplot(data.frame(x = rnorm(100)), aes(x)) +
  geom_density() +
  geom_function(fun = dnorm, colour = "red")

or using statfunction()

ggplot(data.frame(x = rnorm(100)), aes(x)) +
  geom_density() +
  stat_function(fun = dnorm, geom = "line", colour = "red")

function only

ggplot() +
  stat_function(fun = dnorm, geom = "line", colour = "red") +
  lims(x = c(-3, +3))

Boxcox Transformation

boxcox transformation is a power transformation that is used to convert non normal distributed values to a normal distribution. The degree of the transformation is defined by an unspecified lambda. For lambda == 0 it results in a log(x) transformation.

boxcox1 <- function(x, lambda) {
  if (lambda == 0) {
    log(x)
  } else {
    (x ^ lambda - 1) / lambda
  }
}

in order to plot boxcox transformations for different lambdas we need to generate a function that takes only one x argument.

boxcox2 <- function(lambda) {
  if (lambda == 0) {
    function(x) log(x)
  } else {
    function(x) (x ^ lambda - 1) / lambda
  }
}

ggplot() +
  geom_function(aes(colour = 0), fun = boxcox2(0)) +
  geom_function(aes(colour = 1), fun = boxcox2(1)) +
  geom_function(aes(colour = 1.5), fun = boxcox2(1.5)) +
  lims(x = c(0, 10))

we can wrap the geom calls into another function and use lapply()

geoms_boxcox <- function(lambda, ...) {
  geom_function(aes(colour = lambda), fun = boxcox2(lambda), ...)
}

ggplot() +
  lapply(c(0, 1, 1.5), geoms_boxcox) +
  lims(x = c(0, 10))

Bootstraping

bootstrap resampling to permute columns in a dataframe

boot_permute <- function(df, var) {
  n <- nrow(df)
  force(var)
  
  function() {
    col <- df[[var]]
    col[sample(n, replace = TRUE)]
  }
}

boot_mtcars1 <- boot_permute(mtcars, "mpg")
head(boot_mtcars1())

## [1] 32.4 32.4 24.4 33.9 21.4 21.5

head(boot_mtcars1())

## [1] 26.0 13.3 15.0 17.3 15.2 15.5

Imagine we would want to resample residuals of a model in order to bootstrap error statistics

mod <- lm(mpg ~ wt + disp, data = mtcars)
# fitted returns fitted values, same as predict without newdata argument
fitted <- unname(fitted(mod))
pred <- unname(predict(mod))
stopifnot(identical(round(fitted, 6), round(pred, 6)))

resid <- unname(resid(mod))
head(resid)

## [1] -2.345433 -1.490972 -2.472367  1.785333  1.647193 -1.278631

boot_resid <- boot_permute(tibble(resid = resid), "resid")
head(boot_resid())

## [1] -2.472367 -3.408680  6.348440  2.192792 -2.862147 -2.317052

head(boot_resid())

## [1]  1.3973583 -2.1005656  0.8901898 -0.2734911 -2.4723669 -2.0291802

we can refactor, and remove the model fitting into the factory.

boot_model <- function(df, formula) {
  mod <- lm(formula, data = df)
  resid <- unname(resid(mod))
  # remove the model to save memory
  rm(mod)

  function() {
    sample(resid, size = length(resid), replace = TRUE)
  }
} 

boot_mtcars2 <- boot_model(mtcars, mpg ~ wt + disp)
head(boot_mtcars2())

## [1]  2.728799  2.192792  2.728799  6.348440 -2.317200 -1.278631

head(boot_mtcars2())

## [1] -2.47236688 -0.03421046  0.89018976  2.19486787 -2.31719966  0.22354778

Maximum Likelihod Estimation

find the parameter of a distribution that fits some observed values

lprob_poisson <- function(lambda, x) {
  n <- length(x)
  (log(lambda) * sum(x)) - (n * lambda) - sum(lfactorial(x))
}

obs <- c(41, 30, 31, 38, 29, 24, 30, 29, 31, 38)

lprob_poisson(10, obs)

## [1] -183.6405

lprob_poisson(20, obs)

## [1] -61.14028

lprob_poisson(30, obs)

## [1] -30.98598

the term sum(lfactorial(x) is independent of lambda and can be precomputed to optimise the calculation

c <- sum(lfactorial(x))

lprob_poisson1 <- function(lambda, x, c) {
  n <- length(x)
  (log(lambda) * sum(x)) - (n * lambda) - c
}

lprob_poisson(10, obs)

## [1] -183.6405

we can also move x and c into the function

lprob_poisson2 <- function(x) {
  
  # we do not need to force(x)
  # since it is not used by the 
  # returned function
  n <-length(x)
  c <- sum(lfactorial(x))
  sum_x <- sum(x)
  
  function(lambda) {
    (log(lambda) * sum_x) - (n * lambda) - c
  }
}

ll1 <- lprob_poisson2(obs)
ll1(10)

## [1] -183.6405

we can use optimise to find the best value

optimise(f = ll1, interval = c(0, 100), maximum = TRUE)

## $maximum
## [1] 32.09999
## 
## $objective
## [1] -30.26755

Function Operators

Functions that take a function as an argument and return a modfified function. Are called decorators in python.

purrr::safely() and friends
memoise::memoise() (see below)
any reusable wrapper, for example one that automatically retries a give function on failure

memoise::memoise()

caching the results of a slow function when executed again with the same arguments

slow_function <- function(x) {
  Sys.sleep(1)
  x * 10 * runif(1)
}

# different results
system.time(print(slow_function(1)))

## [1] 3.095154

##    user  system elapsed 
##   0.001   0.000   1.004

system.time(print(slow_function(1)))

## [1] 9.585923

##    user  system elapsed 
##   0.004   0.000   1.008

fast_function <- memoise::memoise(slow_function)

# same results because cached result is returned
system.time(print(fast_function(1)))

## [1] 1.817053

##    user  system elapsed 
##   0.001   0.000   1.003

system.time(print(fast_function(1)))

## [1] 1.817053

##    user  system elapsed 
##   0.022   0.000   0.022

# different result because argument has changed
system.time(print(fast_function(2)))

## [1] 6.450071

##    user  system elapsed 
##       0       0       1

Recursion

a classical example for recursive functions is the fibinacci sequence

fib <- function(n) {
  if (n < 2) return(1)
  fib(n - 2) + fib(n - 1)
}
system.time(print(fib(23)))

## [1] 46368

##    user  system elapsed 
##   0.050   0.002   0.052

system.time(print(fib(33)))

## [1] 5702887

##    user  system elapsed 
##   5.056   0.050   5.138

memoise::memoise() will cache the results

fib2 <- memoise::memoise(function(n) {
  if (n < 2) return(1)
  fib2(n - 2) + fib2(n - 1)
})

system.time(fib2(23))

##    user  system elapsed 
##   0.009   0.000   0.010

system.time(fib2(33))

##    user  system elapsed 
##   0.003   0.000   0.003

OOP

encapsulated OOP object.method(arg1, arg2)
functional OOP generic(object, arg1, arg2)

S3

Functional OOP framework that is most commonly used in R.

There are very few constrictions for creating S3 classes but some conventions.

create a low-level constructor that creates objects with the right structure called new_myclass()
a validator that performs computationally expensive checks, called validate_myclass()
a user-friendly helper called myclass()

simaerep example

the simaerep v0.3.1 package currently performs a sequence of operations on a dataframe. Each operations requires a different function that takes a data.frame and returns a modified version. We could simplify the interface for the users by grouping all those operations using S3 classes.

There is no function wrapping the entire workflow because we want intermediary results to be accessible and visible. By convention a function returns only one object which would then only return the final dataframe df_eval. Then we would loose df_site and df_sim_sites for plotting and inspection.

Advantages:

simplified user interface
input checks only need to run once
preserve intermediary results as class attributes

# devtools::install_github("openpharma/simaerep@v0.3.1")

suppressPackageStartupMessages(library("simaerep"))

set.seed(1)

df_visit <- sim_test_data_study(
  n_pat = 1000, # number of patients in study
  n_sites = 100, # number of sites in study
  frac_site_with_ur = 0.05, # fraction of sites under-reporting
  ur_rate = 0.4, # rate of under-reporting
  ae_per_visit_mean = 0.5 # mean AE per patient visit
)

df_visit$study_id <- "A"

df_site <- site_aggr(df_visit)

df_sim_sites <- sim_sites(df_site, df_visit, r = 1000)

df_eval <- eval_sites(df_sim_sites)

plot_study(df_visit, df_site, df_eval, study = "A")

constructor

new_simaerep <- function(df_site,
                           df_sim_sites,
                           df_eval,
                           r) {
  
  structure(
    list(
      df_site = df_site,
      df_sim_sites = df_sim_sites,
      df_eval = df_eval,
      r = r
    ),
    class = "simaerep"
  )
}

validator

validate_simaerep <- function(obj) {
  comp <- sort(attributes(obj)$names) ==  sort(c("df_site", "df_sim_sites", "df_eval", "r"))
  stopifnot(all(comp))
  return(obj)
}

user-friendly constructor

simaerep <- function(df_visit, r = 1000) {
  
  df_site <- site_aggr(df_visit)
  
  df_sim_sites <- sim_sites(df_site, df_visit, r = 1000)
  
  df_eval <- eval_sites(df_sim_sites)
  
  validate_simaerep(
    new_simaerep(
      df_site,
      df_sim_sites,
      df_eval,
      r
    )
  )
}

simaerep_studyA <- simaerep(df_visit)

str(simaerep_studyA)

## List of 4
##  $ df_site     : tibble [100 × 6] (S3: tbl_df/tbl/data.frame)
##   ..$ study_id          : chr [1:100] "A" "A" "A" "A" ...
##   ..$ site_number       : chr [1:100] "S0001" "S0002" "S0003" "S0004" ...
##   ..$ n_pat             : int [1:100] 10 10 10 10 10 10 10 10 10 10 ...
##   ..$ n_pat_with_med75  : int [1:100] 9 8 9 9 7 8 10 7 10 8 ...
##   ..$ visit_med75       : Named num [1:100] 15 19 14 16 18 19 17 16 16 16 ...
##   .. ..- attr(*, "names")= chr [1:100] "80%" "80%" "80%" "80%" ...
##   ..$ mean_ae_site_med75: num [1:100] 4 5.12 4.22 4.67 6.29 ...
##  $ df_sim_sites: tibble [100 × 9] (S3: tbl_df/tbl/data.frame)
##   ..$ study_id           : chr [1:100] "A" "A" "A" "A" ...
##   ..$ site_number        : chr [1:100] "S0001" "S0002" "S0003" "S0004" ...
##   ..$ n_pat              : int [1:100] 10 10 10 10 10 10 10 10 10 10 ...
##   ..$ n_pat_with_med75   : int [1:100] 9 8 9 9 7 8 10 7 10 8 ...
##   ..$ visit_med75        : Named num [1:100] 15 19 14 16 18 19 17 16 16 16 ...
##   .. ..- attr(*, "names")= chr [1:100] "80%" "80%" "80%" "80%" ...
##   ..$ mean_ae_site_med75 : num [1:100] 4 5.12 4.22 4.67 6.29 ...
##   ..$ mean_ae_study_med75: num [1:100] 7.38 9.33 6.92 7.91 8.84 ...
##   ..$ pval               : num [1:100] 7.14e-05 3.15e-05 1.38e-03 2.60e-04 2.11e-02 ...
##   ..$ prob_low           : num [1:100] 0 0 0 0 0.012 0.431 0.04 1 1 0.395 ...
##  $ df_eval     : tibble [100 × 13] (S3: tbl_df/tbl/data.frame)
##   ..$ study_id           : chr [1:100] "A" "A" "A" "A" ...
##   ..$ site_number        : chr [1:100] "S0002" "S0001" "S0004" "S0003" ...
##   ..$ n_pat              : int [1:100] 10 10 10 10 10 10 10 10 10 10 ...
##   ..$ n_pat_with_med75   : int [1:100] 8 9 9 9 10 7 9 9 9 10 ...
##   ..$ visit_med75        : Named num [1:100] 19 15 16 14 15 18 17 15 16 17 ...
##   .. ..- attr(*, "names")= chr [1:100] "80%" "80%" "80%" "80%" ...
##   ..$ mean_ae_site_med75 : num [1:100] 5.12 4 4.67 4.22 5.4 ...
##   ..$ mean_ae_study_med75: num [1:100] 9.33 7.38 7.91 6.92 7.37 ...
##   ..$ pval               : num [1:100] 3.15e-05 7.14e-05 2.60e-04 1.38e-03 2.19e-02 ...
##   ..$ prob_low           : num [1:100] 0 0 0 0 0.009 0.012 0.017 0.036 0.038 0.04 ...
##   ..$ pval_adj           : num [1:100] 0.00315 0.00357 0.00867 0.03444 0.36483 ...
##   ..$ pval_prob_ur       : num [1:100] 0.997 0.996 0.991 0.966 0.635 ...
##   ..$ prob_low_adj       : num [1:100] 0 0 0 0 0.18 ...
##   ..$ prob_low_prob_ur   : num [1:100] 1 1 1 1 0.82 ...
##  $ r           : num 1000
##  - attr(*, "class")= chr "simaerep"

adding some class methods for common generic functions like print(), plot()

print.simaerep <- function(obj) {
  studies <- unique(obj$df_site$study_id)
  print(paste("AE underreporting for studies:", studies))
}

print(simaerep_studyA)

## [1] "AE underreporting for studies: A"

plot.simaerep <- function(obj, df_visit, study, what = c("study", "med75")) {
  
  stopifnot(study %in% unique(df_visit$study_id))
  
  what <- match.arg(what)
  .f <- switch(
     what,
     study = function(...) simaerep::plot_study(..., df_eval = obj$df_eval, study = study),
     med75 = function(...) simaerep::plot_visit_med75(..., study_id_str = study)
  )
  
  .f(df_visit = df_visit, df_site = obj$df_site)
}

plot(simaerep_studyA, df_visit, study = "A", what = "study")

plot(simaerep_studyA, df_visit, study = "A", what = "med75")

## purple line:          mean site ae of patients with visit_med75
## grey line:            patient included
## black dashed line:    patient excluded
## dotted vertical line: visit_med75, 0.75 x median of maximum patient visits of site 
## solid vertical line:  visit_med75 adjusted, increased to minimum maximum patient visit of included patients
## dashed vertical line: maximum value for visit_med75 adjusted, 80% quantile of maximum patient visits of study

to this point we have not:

created new generic functions
used class inheritance

A class that inherits from another class mus carry all its parents attributes, we can implement this by modifying the parent constructor as below and by calling the parent constructor from within the child constructor.

Here we will create two classes one for initiating a simaerep object and the initial df_site aggregation step and one for the simulation.

new_simaerep <- function(df_site, ..., class = character()) {
  structure(
    list(
      df_site = df_site,
      ...
    ),
    class = c(class, "simaerep")
  )
}

validate_simaerep <- function(obj) {
  comp <- attributes(obj)$names ==  "df_site"
  stopifnot(all(comp))
  return(obj)
}

simaerep <- function(df_visit) {
  
  df_site <- site_aggr(df_visit)
  
  validate_simaerep(
    new_simaerep(
      df_site
    )
  )
}

simaerep_studyA <- simaerep(df_visit)

str(simaerep_studyA)

## List of 1
##  $ df_site: tibble [100 × 6] (S3: tbl_df/tbl/data.frame)
##   ..$ study_id          : chr [1:100] "A" "A" "A" "A" ...
##   ..$ site_number       : chr [1:100] "S0001" "S0002" "S0003" "S0004" ...
##   ..$ n_pat             : int [1:100] 10 10 10 10 10 10 10 10 10 10 ...
##   ..$ n_pat_with_med75  : int [1:100] 9 8 9 9 7 8 10 7 10 8 ...
##   ..$ visit_med75       : Named num [1:100] 15 19 14 16 18 19 17 16 16 16 ...
##   .. ..- attr(*, "names")= chr [1:100] "80%" "80%" "80%" "80%" ...
##   ..$ mean_ae_site_med75: num [1:100] 4 5.12 4.22 4.67 6.29 ...
##  - attr(*, "class")= chr "simaerep"

new_simaerep_sim <- function(df_site, df_sim_sites, df_eval, r) {
  
  new_simaerep(
    df_site = df_site,
    df_sim_sites = df_sim_sites,
    df_eval = df_eval,
    r = r,
    class = "simaerep_sim"
  )

}

validate_simaerep_sim <- function(obj) {
  
  comp <- sort(attributes(obj)$names) ==  sort(c("df_site", "df_sim_sites", "df_eval", "r"))
  stopifnot(all(comp))
  return(obj)
}

next we define a new generic method called sim that starts the simulation which returns the new class simaerep_sim. The process that finds the right method to call for an object called with a generic function is called method dispatching.

# define generic function
sim <- function(obj, ...) {
  UseMethod("sim")
}

sim.simaerep <- function(obj, df_visit, r = 1000) {
  
  df_sim_sites <- sim_sites(obj$df_site, df_visit, r = r)
  
  df_eval <- eval_sites(df_sim_sites)
  
  validate_simaerep_sim(
    new_simaerep_sim(
      df_site,
      df_sim_sites,
      df_eval,
      r
    )
  )
}

simaerep_studyA_sim <- sim(simaerep_studyA, df_visit)

str(simaerep_studyA_sim)

## List of 4
##  $ df_site     : tibble [100 × 6] (S3: tbl_df/tbl/data.frame)
##   ..$ study_id          : chr [1:100] "A" "A" "A" "A" ...
##   ..$ site_number       : chr [1:100] "S0001" "S0002" "S0003" "S0004" ...
##   ..$ n_pat             : int [1:100] 10 10 10 10 10 10 10 10 10 10 ...
##   ..$ n_pat_with_med75  : int [1:100] 9 8 9 9 7 8 10 7 10 8 ...
##   ..$ visit_med75       : Named num [1:100] 15 19 14 16 18 19 17 16 16 16 ...
##   .. ..- attr(*, "names")= chr [1:100] "80%" "80%" "80%" "80%" ...
##   ..$ mean_ae_site_med75: num [1:100] 4 5.12 4.22 4.67 6.29 ...
##  $ df_sim_sites: tibble [100 × 9] (S3: tbl_df/tbl/data.frame)
##   ..$ study_id           : chr [1:100] "A" "A" "A" "A" ...
##   ..$ site_number        : chr [1:100] "S0001" "S0002" "S0003" "S0004" ...
##   ..$ n_pat              : int [1:100] 10 10 10 10 10 10 10 10 10 10 ...
##   ..$ n_pat_with_med75   : int [1:100] 9 8 9 9 7 8 10 7 10 8 ...
##   ..$ visit_med75        : Named num [1:100] 15 19 14 16 18 19 17 16 16 16 ...
##   .. ..- attr(*, "names")= chr [1:100] "80%" "80%" "80%" "80%" ...
##   ..$ mean_ae_site_med75 : num [1:100] 4 5.12 4.22 4.67 6.29 ...
##   ..$ mean_ae_study_med75: num [1:100] 7.38 9.33 6.92 7.91 8.84 ...
##   ..$ pval               : num [1:100] 7.14e-05 3.15e-05 1.38e-03 2.60e-04 2.11e-02 ...
##   ..$ prob_low           : num [1:100] 0 0 0 0 0.012 0.431 0.04 1 1 0.395 ...
##  $ df_eval     : tibble [100 × 13] (S3: tbl_df/tbl/data.frame)
##   ..$ study_id           : chr [1:100] "A" "A" "A" "A" ...
##   ..$ site_number        : chr [1:100] "S0002" "S0001" "S0004" "S0003" ...
##   ..$ n_pat              : int [1:100] 10 10 10 10 10 10 10 10 10 10 ...
##   ..$ n_pat_with_med75   : int [1:100] 8 9 9 9 10 7 9 9 9 10 ...
##   ..$ visit_med75        : Named num [1:100] 19 15 16 14 15 18 17 15 16 17 ...
##   .. ..- attr(*, "names")= chr [1:100] "80%" "80%" "80%" "80%" ...
##   ..$ mean_ae_site_med75 : num [1:100] 5.12 4 4.67 4.22 5.4 ...
##   ..$ mean_ae_study_med75: num [1:100] 9.33 7.38 7.91 6.92 7.37 ...
##   ..$ pval               : num [1:100] 3.15e-05 7.14e-05 2.60e-04 1.38e-03 2.19e-02 ...
##   ..$ prob_low           : num [1:100] 0 0 0 0 0.009 0.012 0.017 0.036 0.038 0.04 ...
##   ..$ pval_adj           : num [1:100] 0.00315 0.00357 0.00867 0.03444 0.36483 ...
##   ..$ pval_prob_ur       : num [1:100] 0.997 0.996 0.991 0.966 0.635 ...
##   ..$ prob_low_adj       : num [1:100] 0 0 0 0 0.18 ...
##   ..$ prob_low_prob_ur   : num [1:100] 1 1 1 1 0.82 ...
##  $ r           : num 1000
##  - attr(*, "class")= chr [1:2] "simaerep_sim" "simaerep"

class(simaerep_studyA_sim)

## [1] "simaerep_sim" "simaerep"

plot.simaerep <- function(obj, df_visit, study,
                          ... # we need ... to ignore additional arguments when called with NextMethod()
                          ) {
  simaerep::plot_visit_med75(df_visit, obj$df_site, study_id_str = study)
}

override plot method of parent class, and use user-supplied argument to switch back to parent class method using NextMethod()

plot.simaerep_sim <- function(obj, df_visit, study, what = c("study", "med75")) {
  what <- match.arg(what)
  if (what == "study") {
    simaerep::plot_study(df_visit, obj$df_site, obj$df_eval, study = study)
  } else {
    # calls parent class method using all original arguments
    NextMethod()
  }
}


plot(simaerep_studyA_sim, df_visit, study = "A", what = "study")

plot(simaerep_studyA_sim, df_visit, study = "A", what = "med75")

## purple line:          mean site ae of patients with visit_med75
## grey line:            patient included
## black dashed line:    patient excluded
## dotted vertical line: visit_med75, 0.75 x median of maximum patient visits of site 
## solid vertical line:  visit_med75 adjusted, increased to minimum maximum patient visit of included patients
## dashed vertical line: maximum value for visit_med75 adjusted, 80% quantile of maximum patient visits of study

plot(simaerep_studyA_sim, df_visit, study = "A", what = "XXX")

## Error in match.arg(what): 'arg' should be one of "study", "med75"

plot(simaerep_studyA, df_visit, study = "A")

## purple line:          mean site ae of patients with visit_med75
## grey line:            patient included
## black dashed line:    patient excluded
## dotted vertical line: visit_med75, 0.75 x median of maximum patient visits of site 
## solid vertical line:  visit_med75 adjusted, increased to minimum maximum patient visit of included patients
## dashed vertical line: maximum value for visit_med75 adjusted, 80% quantile of maximum patient visits of study

sloop provides some function to investigate S3 class behavior.

sloop::s3_methods_class("simaerep")

## # A tibble: 3 × 4
##   generic class    visible source    
##   <chr>   <chr>    <lgl>   <chr>     
## 1 plot    simaerep TRUE    .GlobalEnv
## 2 print   simaerep TRUE    .GlobalEnv
## 3 sim     simaerep TRUE    .GlobalEnv

sloop::s3_methods_class("simaerep_sim")

## # A tibble: 1 × 4
##   generic class        visible source    
##   <chr>   <chr>        <lgl>   <chr>     
## 1 plot    simaerep_sim TRUE    .GlobalEnv

sloop::s3_methods_generic("sim")

## # A tibble: 1 × 4
##   generic class    visible source    
##   <chr>   <chr>    <lgl>   <chr>     
## 1 sim     simaerep TRUE    .GlobalEnv

sloop::s3_dispatch(plot(simaerep_studyA_sim, df_visit, study = "A"))

## => plot.simaerep_sim
## -> plot.simaerep
##  * plot.default

sloop::s3_dispatch(plot(simaerep_studyA, df_visit, study = "A"))

## => plot.simaerep
##  * plot.default

R6

R6 uses the encapsulated OOP framework, commonly used in shiny. Works like object in python.

Use R6::R6Class() to construct classes
Pass a list with attributes (static values) and methods (functions)
Within methods refer to the class as self and subset with $ (self$attribute, self.method())
Instantiate objects by calling x <- Class$new()
methods can be chained x$add(1)$sub(1)
initialize() method overrise new() and works like __init() in python
inherit by using the inherit argument of R6::R6Class()
pass private and public attributes and classes using the privat and public arguments of R6::R6Class()
active fields look like attributes but are methods, can run additional checks
instantiated R6 classes behave like python objects modifying one object will also modify all of its copies
always put randomized default values that you do not want to share across instances into the initialize function

S4

Mostly used for bioconductor packages uses functional OOP framework. A well-known package that uses S4 is ROCR and lubridate

much stricter framework than S3
makes use of specialized functions like setClass(), setGeneric(), setMethod()
all functions are distributed with R in the methods package (which should be explicitly loaded so show S4 framework is used and to avoid problems when running non-interactive mode)
attributes are slots which can be subset using @
supports multiple inheritance and multiple dispatch (which should be avoided because its complicated)

Slots

when instantiated objects slot’s are automatically checked if they contain the correct data types
setValidity(), validObject() can be used to extend checks and to validate existing objects

Conventions

CamelCase
provide constructor with same name as class
write generics that call and set slot values

Multiple Inheritence

in case a class inherits from multiple classes the method that is closest to the class is chosen. If two methods are matching the method for the class which has a higher lexical order is chosen.

Multiple dispatch

If a generic uses two classes as input both classes are searched for methods.

S4 vs S3

S4 more suitable for larger teams
S4 is better with many inter related objects (for example provide methods via generics for combinations of different types of sparse matrices)

Six Sigma with R - Notes

Wed, 01 Sep 2021 00:00:00 +0000

Six Sigma with R. Statistical Engineering for Process Improvement (Cano EL, Moguerza JM and Redchuk A, 2012).

R packages

suppressPackageStartupMessages(library(tidyverse))
library(SixSigma)
library(DiagrammeR)
library(nomnoml)

6 Sigma

6 sigma is framework for process improvement and is not limited to process control. It consists of a cycle of several stages all of which are employing the scientific method:

DMAIC cycle:

Define
Measure
Analyse
Improve
Control

Define

Process Charts

High Level:

Process fits onto one power point slide
Onboarding new people
SIPOC, VSM are commonly used in six sigma

six sigma focuses on the inputs and the output of a process.

Inputs are the 6 Ms:

Manpower
Materials
Machines
Methods
Measurements
Mother Nature (Environment)

Output:

CTQ (Crtitical to Quality Characteristics)
key measurable characteristics of a product or process whose performance standards or specification limits must be met

For example the processing of Individual Case Safety Reports for submission to the Health Authorities.

nomnoml webtool

nomnoml::nomnoml(
"#direction: right
#padding: 20
#spacing: 100

[Input 6M's|ICSR; IT System; Legislation; Process Owner; PV Associate]

[Input 6M's]->[Output CTQs|Recipients; Submission Status; Processing Time; Compliance Status; Medical Risk; Compliance Risk]"
)

Low Level:

more elaborate flow charts
UML activity diagram provides some standards.
BMPN Swim Lanes

UML/BMPN process maps do not focus on 6 Ms and CTQs. We can continue the simplified input output diagram ba adding more steps to the process. The input for each individual consists of elements of the initial 6M input (X) or the output produced by one of the previous steps. Each Step can have parameters (x) that influence the quality of the output. Each step output has quality features (y). Which can be included in the final output CTQs (Y).

nomnoml::nomnoml(
"#title: ICSR Processing
#direction: right
#padding: 20
#spacing: 100


[Input 6M's (X)|ICSR; IT System; Legislation; Process Owner; PV Associate; Product]
[Input 6M's (X)]->[<table> Ensure Completeness|
    Input| ICSR; IT System; PV Associate||
    Substeps/Methods| follow_up()||
    Parameters(x); influence Quality|ICSR Source||
    Quality Features(y)|ICSR Completeness; Time
]
[Ensure Completeness]->[Medical Review|
  ICSR Complete; IT System; PV Associate|
  review(); follow_up()|
  ICSR Complexity;Source Accessibility; Privacy Laws|
  Medical Risk; Causality;Severity; Labelling; Product Approval; Time
]
[Medical Review]->[Apply Submission Legislation|
  ICSR Reviewed; Legislation; IT System; Process Owner|
  encode_legislation(); qc_submission_status(); submit()|
  Legislation Complexity; Number Cases to Review|
  Compliance Risk; Submission Status; Recipients; Time; QC Status
]
[Apply Submission Legislation]->[Output CTQs (Y)|
    Recipients; Submission Status; Processing Time; Compliance Status; Medical Risk; Compliance Risk; QC Status
]")

Analyse

Loss Function Analysis

Loss functioncan be used during the DMAIC measure phase by calculating expected loss as a product of average loss per item by number of items. It can also be used to set the upper and lower specification limits (USL/LSL).

In six sigma loss increases quadratically when deviating from the process target not only after crossing a threshold.

Loss = k(Y-Y0)^2

df <- SixSigma::ss.data.bolts
head(df)

##   diameter
## 1  10.4042
## 2  10.2584
## 3   9.9478
## 4  10.2678
## 5  10.1144
## 6   9.9830

lfa <- SixSigma::ss.lfa(
  lfa.data = df,
  lfa.ctq = "diameter",
  lfa.Delta = 0.5, #process tolerance,
  lfa.Y0 = 10, #process target
  lfa.L0 = 0.001, #cost at tolerance limit
  lfa.size = 1e5
)

lfa

## $lfa.k
## [1] 0.004
## 
## $lfa.lf
## expression(bold(L == 0.004 %.% (Y - 10)^2))
## 
## $lfa.MSD
## [1] 0.03372065
## 
## $lfa.avLoss
## [1] 0.0001348826
## 
## $lfa.Loss
## [1] 13.48826

loss_at_10.25 <- lfa$lfa.k * (10.25 - 10)^2
loss_at_10.25

## [1] 0.00025

Measurement System Analysis

Measurement system analysis (MSA) is also known as gage R&R study identifies and quantifies the sources of variation that influence the measurement system.

In a good measurement the only variability is random and stems from the difference in the parts that are measured and not from the so called appraisers (operator, measurement machines, time of the day). MSA uses ANOVA to compare the ratio of between-groups variability to within-groups variability. If this ratio is large, we conclude that the groups are significantly different.

G R&R (appraisal) contribution to variation must be low and is the sum of Repeatability (appraisers) and Reproducibility (interactions)
part to part contribution to variation must be high
total variation = R&R + part to part

df <- SixSigma::ss.data.rr
head(df)

##   prototype operator    run time1 time2
## 1   prot #1    op #1 run #1  1.27  1.15
## 2   prot #1    op #1 run #2  0.90  1.31
## 3   prot #1    op #1 run #3  1.09  1.25
## 4   prot #2    op #1 run #1  1.12  1.36
## 5   prot #2    op #1 run #2  1.09  1.41
## 6   prot #2    op #1 run #3  1.15  1.37

rr <- SixSigma::ss.rr(
  var = time1,
  part = prototype,
  appr = operator,
  data = df,
  alphaLim = 0.05,
  errorTerm = "Interaction",
  lsl = 0.7,
  usl = 1.8,
  method = "crossed" #crossed uses all possible combinations of parts and appraisals
  # https://blog.minitab.com/en/a-simple-guide-to-gage-randr-for-destructive-testing
)

## Complete model (with interaction):
## 
##                    Df Sum Sq Mean Sq F value   Pr(>F)
## prototype           2 1.2007  0.6004  28.040 2.95e-06
## operator            2 0.0529  0.0265   1.236    0.314
## prototype:operator  4 0.0834  0.0208   0.974    0.446
## Repeatability      18 0.3854  0.0214                 
## Total              26 1.7225                         
## 
## alpha for removing interaction: 0.05 
## 
## 
## Reduced model (without interaction):
## 
##               Df Sum Sq Mean Sq F value   Pr(>F)
## prototype      2 1.2007  0.6004  28.174 8.56e-07
## operator       2 0.0529  0.0265   1.242    0.308
## Repeatability 22 0.4688  0.0213                 
## Total         26 1.7225                         
## 
## Gage R&R
## 
##                        VarComp %Contrib
## Total Gage R&R    0.0218822671    25.38
##   Repeatability   0.0213087542    24.71
##   Reproducibility 0.0005735129     0.67
##     operator      0.0005735129     0.67
## Part-To-Part      0.0643389450    74.62
## Total Variation   0.0862212121   100.00
## 
##                        VarComp     StdDev  StudyVar %StudyVar %Tolerance
## Total Gage R&R    0.0218822671 0.14792656 0.8875594     50.38      80.69
##   Repeatability   0.0213087542 0.14597518 0.8758511     49.71      79.62
##   Reproducibility 0.0005735129 0.02394813 0.1436888      8.16      13.06
##     operator      0.0005735129 0.02394813 0.1436888      8.16      13.06
## Part-To-Part      0.0643389450 0.25365123 1.5219074     86.38     138.36
## Total Variation   0.0862212121 0.29363449 1.7618069    100.00     160.16
## 
## Number of Distinct Categories = 2

% Contribution is the total contribution to variability (range)
% Study Var is the within group variance as percent of the total variance
% Tolerance should be below 100 for R&R

Capability Analysis

see capability performance indeces from previous blogpost.

ss.study.ca(
  xST = ss.data.ca$Volume, # short-term process data,
  xLT = rnorm(40, 753, 3), # long-term process data
    LSL = 740,
  USL = 760,
  Target = 750,
  alpha = 0.05,
)

Cpk: min(left right capability index) CI: Confidence Interval of capability index

Improve

Experimental Design

When optimizing a process it is not enough to vary one variable and keep all other variables constant, because we are missing out on interactions. It is best to use a factorial design (binning continuous variables into two) and try all possible combinations in several repeats. Use ANOVA or pairwise t-test to get best result. Include uncontrollable factors in experimental design to find which controllable variables give most robust results when uncontrollable variables vary. Example: Best frozen Pizza recipe for varying baking time and temperature.

Control

Control Charts

see controil charts in a previous blog post

Quality Control with R - Notes

Fri, 27 Aug 2021 00:00:00 +0000

Quality Control with R. An ISO Standards Approach (Cano EL, Moguerza JM and Prieto M, 2015).

R packages

qcc seems to be the most popular and best maintained QC package for control charts.

suppressPackageStartupMessages(library(tidyverse))
# we use qcc 3.0 which is not released on CRAN yet
# devtools::install_github("luca-scr/qcc", build = TRUE, build_opts = c("--no-resave-data", "--no-manual"))
library(qcc)

## Package 'qcc' version 3.0
## Type 'citation("qcc")' for citing this R package in publications.

library(AcceptanceSampling)
library(SixSigma)
library(DiagrammeR)

ISO standard QC Approach

ISO standards are defined by the International Organisation for Standardisation by technical committees using a process that is similar to peer-review. There are a lot of ISO standards covering Quality Control.

QC tools

There are 7 general quality Ishikava tools, each of them is covered by numerous ISO documents.

Cause and Effect Diagram
Check sheet
Control chart
Histogram
Pareto Chart
Scatter Diagram
Stratification
- Flow charts

Cause and Effect Diagrams

The effect is usually undesired. As causes for a given effect for processes of the producing industry the ISO standard is 5Ms+E

Manpower
Materials
Machines
Methods
Measurements
Environment

Creatively I would adapt this for data-driven business processes to:

Manpower
Events
IT System
Methods (Statistics, DevOps, Code base, Manual Processes)
Measurements of Events (Data Entry, Data Coding)
Environment (Culture, External Events, Regulations)

Specifically for the reporting of Adverse Drug Reactions in the form of individual case safety reports (ICSR) to Health Authorities (HA).

qcc::causeEffectDiagram(
  cause = list(
    Manpower = c(
      "Medical Reviewer",
      "Global Process Owner",
      "Local Process Owner",
      "IT Developer",
      "Database Manager",
      "Auditer"
    ),
    Event = c(
      "ICSR Quality",
      "ICSR Detectability",
      "ICSR Quantity",
      "ICSR Complexity"
    ),
    `IT Systems` = c(
      "Availability",
      "Complexity",
      "Performance",
      "Quality"
    ),
    Methods = c(
      "Medial Review Process\n(Data Guides)",
      "Decisioning\n(Submission Rules)",
      "Risk Management",
      "Quality Mangement System",
      "Change Management"
    ),
    Measurements = c(
      "Data Entry",
      "Medical Coding"
    ),
    Environment = c(
      "HA Regulations",
      "Local Cultures",
      "Company Culture",
      "Epidemiology",
      "Local Health Systems"
    )
  ),
  effect = "ICSR not\nreported\nto HA"
)

Check Sheets

Serve to generate process related data, should be part of a general data collection plan. Will be automated for most processes.

Audit Trail Data
Quality Evidence
IT Logs

Classically serves to attribute each effect (ICSR not reported to HA) to any of the suspected causes in the cause and effect diagram.

Control Charts (Shewhart Charts)

Process Monitoring Charts, can be used to track whether process KPI are in or out of control.

data("pistonrings")
df <- as_tibble(pistonrings)

df_g1 <- df %>%
  group_by(sample) %>%
  mutate(rwn = row_number()) %>%
  filter(rwn == 1)

qcc_shew <- qcc(
  df$diameter,
  type = "xbar.one",
  rules = c(1, 2, 3, 4)
)

qcc_shew

## ── Quality Control Chart ───────────────────────── 
## 
## Chart type                 = xbar.one 
## Data (phase I)             = df$diameter 
## Number of groups           = 200 
## Group sample size          = 1 
## Center of group statistics = 74.0036 
## Standard deviation         = 0.01001461 
## 
## Control limits at nsigmas  = 3 
##       LCL      UCL
##  73.97356 74.03365

str(qcc_shew)

## List of 12
##  $ call      : language qcc(data = df$diameter, type = "xbar.one", rules = c(1, 2, 3, 4))
##  $ type      : chr "xbar.one"
##  $ data.name : chr "df$diameter"
##  $ data      : num [1:200, 1] 74 74 74 74 74 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ Group  : chr [1:200] "1" "2" "3" "4" ...
##   .. ..$ Samples: NULL
##  $ statistics: Named num [1:200] 74 74 74 74 74 ...
##   ..- attr(*, "names")= chr [1:200] "1" "2" "3" "4" ...
##  $ sizes     : int [1:200] 1 1 1 1 1 1 1 1 1 1 ...
##  $ center    : num 74
##  $ std.dev   : num 0.01
##  $ rules     : num [1:4] 1 2 3 4
##  $ nsigmas   : num 3
##  $ limits    : num [1, 1:2] 74 74
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr ""
##   .. ..$ : chr [1:2] "LCL" "UCL"
##  $ violations: num [1:200] NA NA NA NA NA NA NA NA NA NA ...
##   ..- attr(*, "WesternElectricRules")= num [1:4] 1 2 3 4
##  - attr(*, "class")= chr "qcc"

plot(qcc_shew)

qcc_shew$violations

##   [1] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [26] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [51] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA  1 NA NA NA NA NA NA NA NA
##  [76] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [101] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [126] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [151] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA  2 NA NA NA NA
## [176] NA NA NA NA NA NA NA  3 NA  3  1  4  4  4  4  4  4  1  2  2  4  4  4 NA NA
## attr(,"WesternElectricRules")
## [1] 1 2 3 4

qcc_shew$rules

## [1] 1 2 3 4

qcc uses the Western Electric Rules to flag out of control values.

One point plots outside 3-sigma control limits.
Two of three consecutive points plot beyond a 2-sigma limit.
Four of five consecutive points plot beyond a 1-sigma limit.
Eight consecutive points plot on one side of the center line.

These rules do not appear to be customizable, it seems to me that Nelson Rules are a bit more complete and cover more non-random scenarios such as trends and oscillation.

The control chart type depends on the data type and its distribution. There is a decision tree for the chart selection.

DiagrammeR::mermaid(
  "graph TB
    A(Select Control Chart)-->B{data type}
    B --> |Discrete| C{Distribution}
    B --> |Continuous| D{Sample Size}
    C --> |Poisson| E{Sample Size}
    C --> |Binominal| F{Frequency}
    E --> |constant| G[c-chart]
    E --> |variable| H[u-chart]
    F --> |count| I[np-chart]
    F --> |proportion| J[p-chart]
    D --> |n = 1| K[x.one + R chart]
    D --> |n = 2-10| L[x + R chart]
    D --> |n > 10| M[x + S chart]
"
)

Histogram

self explanatory, explore distribution of continuous variable.

ggplot(df_g1) +
  geom_histogram(aes(diameter))

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Pareto Chart

Plot Frequency of effect causes, apply 80:20 rule

defect <- c(80, 27, 66, 94, 33)
names(defect) <- c("HA Regulations", "Risk Management", "Data Entry", "Change Management", "IT System Performance")
qcc_pareto <- qcc::paretoChart(defect)
str(qcc_pareto)

## List of 3
##  $ call     : language qcc::paretoChart(data = defect)
##  $ data.name: chr "defect"
##  $ tab      : num [1:5, 1:4] 94 80 66 33 27 94 174 240 273 300 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ defect: chr [1:5] "Change Management" "HA Regulations" "Data Entry" "IT System Performance" ...
##   .. ..$       : chr [1:4] "Frequency" "Cum.Freq." "Percentage" "Cum.Percent."
##  - attr(*, "class")= chr "paretoChart"

plot(qcc_pareto) +
  theme(axis.text.x = element_text(angle = 90))

Scatter Plots

validate established cause and effect relationships
multivariate control diagrams

Stratification

identify relevant process subgroups by which to stratify the analysis
use of process flow charts

Control Charts

ideally have even sample sizes to obtain even upper and lower control limits, although qcc allow you to create control charts with uneven sample sizes but oc plots cannot be created, thus it is difficult to make good estimates about appropriate sample sizes.
plot in pairs to monitor different summary statistics like x-bar chart (means) and range chart (R chart) as a measure for variance
use Shewart’s formula to estimate control limits
phase I determine a calibration period during which the process is in control and determine control limits
phase II monitor process for out of range values

Continuous Grouped Variables

We are going to measure a continuous variable over time such as the thickness of a board.

Controls Charts use the population standard deviation to flag out of control data points.

Determine population standard deviation:

determine a calibration period during which the process is in control (set n)
at each time point measure samples and take the mean
according to the central limit theorem the distribution of the means will be normally distributed
measure population standard deviation of the means sqrt((n-1)/n) * sd(x)
in statistical process control this is considered to be biased
instead the range and the shewart constant (d2/c4) which depends on the number of measurements (n) are used by the Shewart’s formula to estimate control limits

Determine sample size: - ARL is the average run length (number of consecutive samples) needed to get a point that is outside the upper and lower control limits. For a normal distribution the ARL is 370. So every 370 measurements we will get a false positive signal. - The power of a control chart depends on the sample size. The operator characteristics (OC) plots the probabilty of a false negative (type two error) against the process shift in standard deviations for several sample sizes (n). For a given shift in process deviation we can also determine the probability beta for a false negative using the OC curve. - ARL = 1 / (1 - beta)

X-bar Chart

Monitors the mean
uses d2 Shewart’s constants

df

## # A tibble: 200 x 3
##    diameter sample trial
##       <dbl>  <int> <lgl>
##  1     74.0      1 TRUE 
##  2     74.0      1 TRUE 
##  3     74.0      1 TRUE 
##  4     74.0      1 TRUE 
##  5     74.0      1 TRUE 
##  6     74.0      2 TRUE 
##  7     74.0      2 TRUE 
##  8     74.0      2 TRUE 
##  9     74.0      2 TRUE 
## 10     74.0      2 TRUE 
## # … with 190 more rows

# pivot from long to wide
qcc_gr <- qcc::qccGroups(df, diameter, sample)

qcc_gr

##      [,1]   [,2]   [,3]   [,4]   [,5]
## 1  74.030 74.002 74.019 73.992 74.008
## 2  73.995 73.992 74.001 74.011 74.004
## 3  73.988 74.024 74.021 74.005 74.002
## 4  74.002 73.996 73.993 74.015 74.009
## 5  73.992 74.007 74.015 73.989 74.014
## 6  74.009 73.994 73.997 73.985 73.993
## 7  73.995 74.006 73.994 74.000 74.005
## 8  73.985 74.003 73.993 74.015 73.988
## 9  74.008 73.995 74.009 74.005 74.004
## 10 73.998 74.000 73.990 74.007 73.995
## 11 73.994 73.998 73.994 73.995 73.990
## 12 74.004 74.000 74.007 74.000 73.996
## 13 73.983 74.002 73.998 73.997 74.012
## 14 74.006 73.967 73.994 74.000 73.984
## 15 74.012 74.014 73.998 73.999 74.007
## 16 74.000 73.984 74.005 73.998 73.996
## 17 73.994 74.012 73.986 74.005 74.007
## 18 74.006 74.010 74.018 74.003 74.000
## 19 73.984 74.002 74.003 74.005 73.997
## 20 74.000 74.010 74.013 74.020 74.003
## 21 73.988 74.001 74.009 74.005 73.996
## 22 74.004 73.999 73.990 74.006 74.009
## 23 74.010 73.989 73.990 74.009 74.014
## 24 74.015 74.008 73.993 74.000 74.010
## 25 73.982 73.984 73.995 74.017 74.013
## 26 74.012 74.015 74.030 73.986 74.000
## 27 73.995 74.010 73.990 74.015 74.001
## 28 73.987 73.999 73.985 74.000 73.990
## 29 74.008 74.010 74.003 73.991 74.006
## 30 74.003 74.000 74.001 73.986 73.997
## 31 73.994 74.003 74.015 74.020 74.004
## 32 74.008 74.002 74.018 73.995 74.005
## 33 74.001 74.004 73.990 73.996 73.998
## 34 74.015 74.000 74.016 74.025 74.000
## 35 74.030 74.005 74.000 74.016 74.012
## 36 74.001 73.990 73.995 74.010 74.024
## 37 74.015 74.020 74.024 74.005 74.019
## 38 74.035 74.010 74.012 74.015 74.026
## 39 74.017 74.013 74.036 74.025 74.026
## 40 74.010 74.005 74.029 74.000 74.020

q1 <- qcc(
  qcc_gr[1:25, ],
  type = "xbar",
  newdata = qcc_gr[26:nrow(qcc_gr), ],
  rules = c(1, 2, 3, 4)
)

q1

## ── Quality Control Chart ───────────────────────── 
## 
## Chart type                 = xbar 
## Data (phase I)             = qcc_gr[1:25, ] 
## Number of groups           = 25 
## Group sample size          = 5 
## Center of group statistics = 74.00118 
## Standard deviation         = 0.009785039 
## 
## New data (phase II)        = qcc_gr[26:nrow(qcc_gr), ] 
## Number of groups           = 15 
## Group sample size          = 5 
## 
## Control limits at nsigmas  = 3 
##       LCL     UCL
##  73.98805 74.0143

plot(q1)

q1_oc <- qcc::ocCurves(q1)

q1_oc

## ── Operating Characteristic Curves ─────────────── 
## 
## Chart type                 = xbar 
## Prob. type II error (beta) =
##               sample size
## shift (StdDev)      1      5     10     15     20
##            0.0 0.9973 0.9973 0.9973 0.9973 0.9973
##            0.1 0.9972 0.9966 0.9959 0.9952 0.9944
##            0.2 0.9968 0.9944 0.9909 0.9869 0.9823
##            :                                     
##            4.9 0.0287 0.0000 0.0000 0.0000 0.0000
##            5.0 0.0228 0.0000 0.0000 0.0000 0.0000
## Average run length (ARL)   =
##               sample size
## shift (StdDev)   1   5  10  15  20
##            0.0 370 370 370 370 370
##            0.1 353 296 244 206 178
##            0.2 308 178 110  76  57
##            :                      
##            4.9   1   1   1   1   1
##            5.0   1   1   1   1   1

plot(q1_oc)

arl_n5 <- q1_oc$ARL %>%
  as_tibble(rownames = "shift_stdev") %>%
  filter(shift_stdev == "1.0") %>%
  pull(`5`)

arl_n5

## [1] 4.495312

So for a change in average diameter by 0.009785 we need in average 4.4953122 runs to detect a change in the mean statistic using 5 samples.

R Chart

monitors process stability by means of the sample ranges
uses d3 and d2 Shewart’s constants
appropriate for sample sizes < 8

q2 <- qcc(
  qcc_gr[1:25, ],
  type = "R",
  newdata = qcc_gr[26:nrow(qcc_gr), ],
  rules = c(1, 2, 3, 4)
)

q2

## ── Quality Control Chart ───────────────────────── 
## 
## Chart type                 = R 
## Data (phase I)             = qcc_gr[1:25, ] 
## Number of groups           = 25 
## Group sample size          = 5 
## Center of group statistics = 0.02276 
## Standard deviation         = 0.009785039 
## 
## New data (phase II)        = qcc_gr[26:nrow(qcc_gr), ] 
## Number of groups           = 15 
## Group sample size          = 5 
## 
## Control limits at nsigmas  = 3 
##  LCL        UCL
##    0 0.04812533

plot(q2)

q2_oc <- qcc::ocCurves(q2)

# throws error, https://github.com/luca-scr/qcc/issues/31
# plot(q2_oc)

q2_oc

## ── Operating Characteristic Curves ─────────────── 
## 
## Chart type                 = R 
## Prob. type II error (beta) =
##                 sample size
## scale multiplier      2      5     10     15     20
##              1.0 0.9908 0.9954 0.9956 0.9955 0.9954
##              1.1 0.9822 0.9864 0.9841 0.9818 0.9798
##              1.2 0.9701 0.9692 0.9583 0.9486 0.9403
##              :                                     
##              5.9 0.3413 0.0233 0.0003 0.0000 0.0000
##              6.0 0.3360 0.0219 0.0002 0.0000 0.0000
## Average run length (ARL)   =
##                 sample size
## scale multiplier   2   5  10  15  20
##              1.0 109 217 229 223 217
##              1.1  56  74  63  55  50
##              1.2  33  32  24  19  17
##              :                      
##              5.9   2   1   1   1   1
##              6.0   2   1   1   1   1

arl_n5 <- q2_oc$ARL %>%
  as_tibble(rownames = "scale_multiplier") %>%
  filter(scale_multiplier == "1.5") %>%
  pull(`5`)

arl_n5

## [1] 7.198125

So for a change in range by 50% need in average 7.1981249 runs using 5 samples.

S Chart

monitors process stability by means of standard deviations
uses c4 Shewart’s constant
appropriate for sample sizes >= 8

q3 <- qcc(
  qcc_gr[1:25, ],
  type = "S",
  newdata = qcc_gr[26:nrow(qcc_gr), ],
  rules = c(1, 2, 3, 4)
)

q3

## ── Quality Control Chart ───────────────────────── 
## 
## Chart type                 = S 
## Data (phase I)             = qcc_gr[1:25, ] 
## Number of groups           = 25 
## Group sample size          = 5 
## Center of group statistics = 0.009240037 
## Standard deviation         = 0.009829977 
## 
## New data (phase II)        = qcc_gr[26:nrow(qcc_gr), ] 
## Number of groups           = 15 
## Group sample size          = 5 
## 
## Control limits at nsigmas  = 3 
##  LCL        UCL
##    0 0.01930242

plot(q3)

q3_oc <- qcc::ocCurves(q3)

# throws error, https://github.com/luca-scr/qcc/issues/31
# plot(q3_oc)

q3_oc

## ── Operating Characteristic Curves ─────────────── 
## 
## Chart type                 = S 
## Prob. type II error (beta) =
##                 sample size
## scale multiplier      2      5     10     15     20
##              1.0 0.9908 0.9961 0.9970 0.9972 0.9972
##              1.1 0.9822 0.9874 0.9860 0.9838 0.9812
##              1.2 0.9701 0.9700 0.9574 0.9425 0.9261
##              :                                     
##              5.9 0.3413 0.0212 0.0001 0.0000 0.0000
##              6.0 0.3360 0.0199 0.0001 0.0000 0.0000
## Average run length (ARL)   =
##                 sample size
## scale multiplier   2   5  10  15  20
##              1.0 109 256 333 351 358
##              1.1  56  79  72  62  53
##              1.2  33  33  23  17  14
##              :                      
##              5.9   2   1   1   1   1
##              6.0   2   1   1   1   1

arl_n5 <- q3_oc$ARL %>%
  as_tibble(rownames = "scale_multiplier") %>%
  filter(scale_multiplier == "1.5") %>%
  pull(`5`)

So for a change in range by 50% need in average 6.9559271 runs using 5 samples.

Continuous Non-Grouped Variables

If a process is described best by a continuous one at a time measurement we cannot use sampling

central limit theorem does not apply
normality needs to be confirmed
if possible use power transformation to normalize
accompany x-bar chart with moving range chart

X-bar chart

uses the moving range to calculate global standard deviation
takes Shewart’s constant d2 for n = 2

# airplane paint viscosity, one batch takes hours to produce and no rational subgroups can be formed
data("viscosity")
df_vis <- viscosity

df_vis

##    batch viscosity trial
## 1      1     34.05  TRUE
## 2      2     34.40  TRUE
## 3      3     33.59  TRUE
## 4      4     35.96  TRUE
## 5      5     34.70  TRUE
## 6      6     33.51  TRUE
## 7      7     33.79  TRUE
## 8      8     34.04  TRUE
## 9      9     34.52  TRUE
## 10    10     33.75  TRUE
## 11    11     33.27  TRUE
## 12    12     33.71  TRUE
## 13    13     34.03  TRUE
## 14    14     34.58  TRUE
## 15    15     34.02  TRUE
## 16    16     33.97  TRUE
## 17    17     34.05  TRUE
## 18    18     34.04  TRUE
## 19    19     33.73  TRUE
## 20    20     34.05  TRUE
## 21    21     34.39 FALSE
## 22    22     33.75 FALSE
## 23    23     33.40 FALSE
## 24    24     33.27 FALSE
## 25    25     34.65 FALSE
## 26    26     34.80 FALSE
## 27    27     34.55 FALSE
## 28    28     35.40 FALSE
## 29    29     34.75 FALSE
## 30    30     34.50 FALSE
## 31    31     34.70 FALSE
## 32    32     34.29 FALSE
## 33    33     34.61 FALSE
## 34    34     34.49 FALSE
## 35    35     35.03 FALSE

q4 <- qcc(
  df_vis$viscosity[df_vis$trial],
  type = "xbar.one",
  newdata = df_vis$viscosity[! df_vis$trial],
  rules = c(1, 2, 3, 4)
)

q4

## ── Quality Control Chart ───────────────────────── 
## 
## Chart type                 = xbar.one 
## Data (phase I)             = df_vis$viscosity[df_vis$trial] 
## Number of groups           = 20 
## Group sample size          = 1 
## Center of group statistics = 34.088 
## Standard deviation         = 0.5076521 
## 
## New data (phase II)        = df_vis$viscosity[!df_vis$trial] 
## Number of groups           = 15 
## Group sample size          = 1 
## 
## Control limits at nsigmas  = 3 
##       LCL      UCL
##  32.56504 35.61096

plot(q4)

R Chart

uses the range between a given and the next measurement

vis_mat <- df_vis %>%
  mutate(lead = lead(viscosity)) %>%
  select(viscosity, lead) %>%
  filter(! is.na(lead)) %>%
  as.matrix()


q5 <- qcc(
  vis_mat[df_vis$trial[1:nrow(df_vis)-1], ],
  type = "R",
  newdata = vis_mat[! df_vis$trial[1:nrow(df_vis)-1], ]
)

q5

## ── Quality Control Chart ───────────────────────── 
## 
## Chart type                 = R 
## Data (phase I)             = vis_mat[df_vis$trial[1:nrow(df_vis) - 1], ] 
## Number of groups           = 20 
## Group sample size          = 2 
## Center of group statistics = 0.561 
## Standard deviation         = 0.4973404 
## 
## New data (phase II)        = vis_mat[!df_vis$trial[1:nrow(df_vis) - 1], ] 
## Number of groups           = 14 
## Group sample size          = 2 
## 
## Control limits at nsigmas  = 3 
##  LCL      UCL
##    0 1.832953

plot(q5)

Discrete Measurements

p and np Charts

measure frequency or relative frequency
p is for relative frequency
np for frequency

data("orangejuice")
df_oj <- orangejuice

q6 <- qcc(
  df_oj$D[df_oj$trial],
  df_oj$size[df_oj$trial],
  type = "p",
  newdata = df_oj$D[! df_oj$trial],
  newsizes = df_oj$size[! df_oj$trial],
  rules = c(1, 2, 3, 4)
)

q6

## ── Quality Control Chart ───────────────────────── 
## 
## Chart type                 = p 
## Data (phase I)             = df_oj$D[df_oj$trial] 
## Number of groups           = 30 
## Group sample size          = 50 
## Center of group statistics = 0.2313333 
## Standard deviation         = 0.05963526 
## 
## New data (phase II)        = df_oj$D[!df_oj$trial] 
## Number of groups           = 24 
## Group sample size          = 50 
## 
## Control limits at nsigmas  = 3 
##          LCL       UCL
##   0.05242755 0.4102391
##   0.05242755 0.4102391
## :                     
##   0.05242755 0.4102391

plot(q6)

q6_oc <- qcc::ocCurves(q6)

q6_oc

## ── Operating Characteristic Curves ─────────────── 
## 
## Chart type                 = p 
## Prob. type II error (beta) =
##                       
## fraction nonconforming   [,1]
##                   0.00 0.0000
##                   0.01 0.0894
##                   0.02 0.2642
##                   :          
##                   0.99 0.0000
##                   1.00 0.0000
## Average run length (ARL)   =
##                       
## fraction nonconforming [,1]
##                   0.00    1
##                   0.01    1
##                   0.02    1
##                   :        
##                   0.99    1
##                   1.00    1

plot(q6_oc)

plot(q6_oc, what = "ARL")

q6a <- qcc(
  df_oj$D[df_oj$trial],
  df_oj$size[df_oj$trial],
  type = "np",
  newdata = df_oj$D[! df_oj$trial],
  newsizes = df_oj$size[! df_oj$trial],
  rules = c(1, 2, 3, 4)
)

q6a

## ── Quality Control Chart ───────────────────────── 
## 
## Chart type                 = np 
## Data (phase I)             = df_oj$D[df_oj$trial] 
## Number of groups           = 30 
## Group sample size          = 50 
## Center of group statistics = 11.56667 
## Standard deviation         = 2.981763 
## 
## New data (phase II)        = df_oj$D[!df_oj$trial] 
## Number of groups           = 24 
## Group sample size          = 50 
## 
## Control limits at nsigmas  = 3 
##       LCL      UCL
##  2.621377 20.51196

plot(q6a)

c chart

for count of events that cannot be attributed to a sample size
examples: nonconformities per day, defects per m^2 of fabric or flaws per metal plate
unit should stay constant

library(SixSigma)

ss.data.thickness2 %>%
  head(15)

##    day shift thickness ushift flaws
## 1    1     1     0.713    1.1     9
## 2    1     1     0.776    1.1    NA
## 3    1     1     0.743    1.1    NA
## 4    1     1     0.713    1.1    NA
## 5    1     1     0.747    1.1    NA
## 6    1     1     0.753    1.1    NA
## 7    1     2     0.749    1.2     2
## 8    1     2     0.726    1.2     7
## 9    1     2     0.774    1.2     9
## 10   1     2     0.744    1.2    NA
## 11   1     2     0.718    1.2    NA
## 12   1     2     0.677    1.2    NA
## 13   2     1     0.778    2.1     7
## 14   2     1     0.802    2.1    NA
## 15   2     1     0.798    2.1    NA

# remove uninspected items
df_flaws <- ss.data.thickness2 %>%
  as_tibble() %>%
  filter(! is.na(flaws))

df_flaws

## # A tibble: 23 x 5
##    day   shift thickness ushift flaws
##    <fct> <fct>     <dbl> <chr>  <int>
##  1 1     1         0.713 1.1        9
##  2 1     2         0.749 1.2        2
##  3 1     2         0.726 1.2        7
##  4 1     2         0.774 1.2        9
##  5 2     1         0.778 2.1        7
##  6 2     2         0.78  2.2        4
##  7 2     2         0.729 2.2        6
##  8 2     2         0.793 2.2        9
##  9 3     1         0.775 3.1        9
## 10 3     2         0.727 3.2        4
## # … with 13 more rows

q7 <- qcc(
  df_flaws$flaws,
  type = "c",
  rules = c(1, 2, 3, 4)
)

q7

## ── Quality Control Chart ───────────────────────── 
## 
## Chart type                 = c 
## Data (phase I)             = df_flaws$flaws 
## Number of groups           = 23 
## Group sample size          = 1 
## Center of group statistics = 5.26087 
## Standard deviation         = 2.293659 
## 
## Control limits at nsigmas  = 3 
##  LCL      UCL
##    0 12.14185

plot(q7)

q7_oc <- qcc::ocCurves(q7)

q7_oc

## ── Operating Characteristic Curves ─────────────── 
## 
## Chart type                 = c 
## Prob. type II error (beta) =
##        [,1]
## 0.00  1e+00
## 1.00  1e+00
## 2.00  1e+00
## :          
## 28.00 6e-04
## 29.00 3e-04
## Average run length (ARL)   =
##              [,1]
## 0.00          Inf
## 1.00  15723815904
## 2.00      4822834
## :                
## 28.00           1
## 29.00           1

plot(q7_oc, what = "ARL") +
  coord_cartesian(ylim = c(0, 10))

u chart

average number of defects from a varying number of samples
for example: 18 flaws from 3 metal plates, then 3 flaws in 5 metal plates

df_gr_flaws <- df_flaws %>%
  group_by(ushift) %>%
  summarise(n_plates_per_shift = n(),
            n_flaws_per_shift = sum(flaws))

df_gr_flaws

## # A tibble: 14 x 3
##    ushift n_plates_per_shift n_flaws_per_shift
##    <chr>               <int>             <int>
##  1 1.1                     1                 9
##  2 1.2                     3                18
##  3 2.1                     1                 7
##  4 2.2                     3                19
##  5 3.1                     1                 9
##  6 3.2                     1                 4
##  7 4.1                     2                 6
##  8 4.2                     1                 4
##  9 5.1                     1                 5
## 10 5.2                     2                13
## 11 6.1                     2                 5
## 12 6.2                     1                 4
## 13 7.1                     1                 7
## 14 7.2                     3                11

qu8 <- qcc(
  df_gr_flaws$n_flaws_per_shift,
  type = "u",
  sizes = df_gr_flaws$n_plates_per_shift,
  rules = c(1, 2, 3, 4)
)

qu8

## ── Quality Control Chart ───────────────────────── 
## 
## Chart type                 = u 
## Data (phase I)             = df_gr_flaws$n_flaws_per_shift 
## Number of groups           = 14 
## Group sample sizes         =              
##   sizes  1 2 3
##   counts 8 3 3
## Center of group statistics = 5.26087 
## Standard deviation         = 2.293659 
## 
## Control limits at nsigmas  = 3 
##        LCL       UCL
##   0.000000 12.141845
##   1.288136  9.233603
## :                   
##   1.288136  9.233603

plot(qu8)

# OC curves need constant sample sizes
# qu8_oc <- qcc::ocCurves(qu8)

Capability/Performance Indices

measure whether consumer specified upper and lower specification limits (LSL/USL) are compatible with process control limits (LCL/UCL)
performance measures long-term variability and capacity short-term variability
C = (USL - LSL) / 6sigma
index below 1 is unsufficient, 1.33-167 is outstanding and 2 refers to six sigma quality
adjusted index variations account for processes that are not perfectly centered
Cp: capability index
Cp_l: lower index
Cp_u: upper index
Cp_k: minimum of lower and upper index
Cpm : Tagauchi index (controls for not centered processes)

q1

## ── Quality Control Chart ───────────────────────── 
## 
## Chart type                 = xbar 
## Data (phase I)             = qcc_gr[1:25, ] 
## Number of groups           = 25 
## Group sample size          = 5 
## Center of group statistics = 74.00118 
## Standard deviation         = 0.009785039 
## 
## New data (phase II)        = qcc_gr[26:nrow(qcc_gr), ] 
## Number of groups           = 15 
## Group sample size          = 5 
## 
## Control limits at nsigmas  = 3 
##       LCL     UCL
##  73.98805 74.0143

q1_pc <- qcc::processCapability(q1, spec.limits = c(73.975, 74.025))

q1_pc

## ── Process Capability Analysis ─────────────────── 
## 
## Number of obs = 125          Target = 74      
## Center        = 74.00118     LSL    = 73.975  
## StdDev        = 0.009785039  USL    = 74.025  
##                   
## Capability indices  Value   2.5%  97.5%
##               Cp    0.852  0.746  0.957
##               Cp_l  0.892  0.786  0.997
##               Cp_u  0.812  0.714  0.910
##               Cp_k  0.812  0.695  0.928
##               Cpm   0.846  0.740  0.951
## 
## Exp<LSL 0.0037%   Obs<LSL 0.008%
## Exp>USL 0.0075%   Obs>USL 0.008%

plot(q1_pc)

q1_pc <- qcc::processCapability(q1, spec.limits = c(73.95, 74.05))

q1_pc

## ── Process Capability Analysis ─────────────────── 
## 
## Number of obs = 125          Target = 74      
## Center        = 74.00118     LSL    = 73.95   
## StdDev        = 0.009785039  USL    = 74.05   
##                   
## Capability indices  Value  2.5%  97.5%
##               Cp     1.70  1.49   1.91
##               Cp_l   1.74  1.55   1.93
##               Cp_u   1.66  1.48   1.84
##               Cp_k   1.66  1.45   1.88
##               Cpm    1.69  1.48   1.90
## 
## Exp<LSL 0%    Obs<LSL 0%
## Exp>USL 0%    Obs>USL 0%

plot(q1_pc)

CUSUM Chart

cumulative sum chart
two lines one below zero and one above zero and a center which is the expected value.
positive deviation of the process from the central value results in an uptick of both lines
negative deviation of the process from the central value results in a down tick of both lines
both lines never cross the central line
supposedly more sensitive than regular control charts

qcc_gr

##      [,1]   [,2]   [,3]   [,4]   [,5]
## 1  74.030 74.002 74.019 73.992 74.008
## 2  73.995 73.992 74.001 74.011 74.004
## 3  73.988 74.024 74.021 74.005 74.002
## 4  74.002 73.996 73.993 74.015 74.009
## 5  73.992 74.007 74.015 73.989 74.014
## 6  74.009 73.994 73.997 73.985 73.993
## 7  73.995 74.006 73.994 74.000 74.005
## 8  73.985 74.003 73.993 74.015 73.988
## 9  74.008 73.995 74.009 74.005 74.004
## 10 73.998 74.000 73.990 74.007 73.995
## 11 73.994 73.998 73.994 73.995 73.990
## 12 74.004 74.000 74.007 74.000 73.996
## 13 73.983 74.002 73.998 73.997 74.012
## 14 74.006 73.967 73.994 74.000 73.984
## 15 74.012 74.014 73.998 73.999 74.007
## 16 74.000 73.984 74.005 73.998 73.996
## 17 73.994 74.012 73.986 74.005 74.007
## 18 74.006 74.010 74.018 74.003 74.000
## 19 73.984 74.002 74.003 74.005 73.997
## 20 74.000 74.010 74.013 74.020 74.003
## 21 73.988 74.001 74.009 74.005 73.996
## 22 74.004 73.999 73.990 74.006 74.009
## 23 74.010 73.989 73.990 74.009 74.014
## 24 74.015 74.008 73.993 74.000 74.010
## 25 73.982 73.984 73.995 74.017 74.013
## 26 74.012 74.015 74.030 73.986 74.000
## 27 73.995 74.010 73.990 74.015 74.001
## 28 73.987 73.999 73.985 74.000 73.990
## 29 74.008 74.010 74.003 73.991 74.006
## 30 74.003 74.000 74.001 73.986 73.997
## 31 73.994 74.003 74.015 74.020 74.004
## 32 74.008 74.002 74.018 73.995 74.005
## 33 74.001 74.004 73.990 73.996 73.998
## 34 74.015 74.000 74.016 74.025 74.000
## 35 74.030 74.005 74.000 74.016 74.012
## 36 74.001 73.990 73.995 74.010 74.024
## 37 74.015 74.020 74.024 74.005 74.019
## 38 74.035 74.010 74.012 74.015 74.026
## 39 74.017 74.013 74.036 74.025 74.026
## 40 74.010 74.005 74.029 74.000 74.020

q1 <- qcc(
  qcc_gr[1:25, ],
  type = "xbar",
  newdata = qcc_gr[26:nrow(qcc_gr), ],
  rules = c(1, 2, 3, 4)
)

plot(q1)

q9 <- qcc::cusum(
  qcc_gr[1:25, ],
  newdata = qcc_gr[26:nrow(qcc_gr), ]
)

plot(q9)

EWMA Chart

exponentially weighted moving average chart
zj = gamma * xj + (1 - gamma) * zj-1
if the smoothing parameter gamma is 0.2 a given value for x is 20% present value and 80% past values
+ indicates the actual values
supposed to work well for not normal values

q10 <- qcc::ewma(
  qcc_gr[1:25, ],
  newdata = qcc_gr[26:nrow(qcc_gr), ]
)

plot(q10)

Sampling/Stratification

Naturally samples need to be representative of the population. If there are known subgroups it is important to adapt a stratified sampling strategy.

free ebook

Attribute Acceptance Sampling

attribute: defective / not defective
producer wants a high probability of acceptance for a lot with a low defective fraction
producers and consumer agree on acceptable quality level (AQL)
alpha (producers risk) is the probability with which a lot that passes AQL is rejected
consumer wants a high probability of rejection for a lot with a high defective ratio
producers and consumer agree on lot tolerance percent defective (LTPD)
beta (consumers risk) is the probability with which a lot that does not pass LTPD is accepted

Requirements:

AQL: 0.06
alpha: 0.05
LTPD: 0.16
beta: 0.10

library(AcceptanceSampling)

plan <- AcceptanceSampling::find.plan(
  PRP = c(0.06, 0.95),
  CRP = c(0.16, 0.10)
)

plan

## $n
## [1] 79
## 
## $c
## [1] 8
## 
## $r
## [1] 9

oc <- AcceptanceSampling::OC2c(plan$n, plan$c, plan$r)

plot(oc, xlim = c(0, 0.25))

take a sample of 79 and reject when 9 items are defective

Variable Acceptance Sampling

specify:

upper specification limit (USL)

and or:

lower specification limit (LSL)

plan2 <- AcceptanceSampling::find.plan(
  PRP = c(0.06, 0.95),
  CRP = c(0.16, 0.10),
  type = "normal",
  s.type = "known"
)

plan2

## $n
## [1] 28
## 
## $k
## [1] 1.243925
## 
## $s.type
## [1] "known"

proceed:

take a sample of 28
compute the mean
compute LSL/USL - mean(sample) / sd
compare accept if value above is greater 1.2439255

plan3 <- AcceptanceSampling::find.plan(
  PRP = c(0.06, 0.95),
  CRP = c(0.16, 0.10),
  type = "normal",
  s.type = "unknown"
)

plan3

## $n
## [1] 49
## 
## $k
## [1] 1.245424
## 
## $s.type
## [1] "unknown"

proceed:

take a sample of 49
compute the mean
compute LSL/USL - mean(sample) / sd(sample)
compare accept if value above is greater 1.2454244

Note that sample size has increased because we do not know population sd and need to estimate it from the sample.

simaerep

Tue, 10 Nov 2020 00:00:00 +0000

Simulate adverse event reporting in clinical trials with the goal of detecting under-reporting sites.

Adverse Events

{simaerep}

simaerep can be used to flag sites that are statistically reporting fewer AEs than other sites by using bootstrap resampling. For a site that needs to be tested it draws with replacement a new patient sample from the entire study patient population. This is repeated several times to be able to determine the probability to get an equal or lower number of AEs than initially reported.

There is a bit more to it of course simaerep needs to account for the fact that patients have been recruited at different points in time and it needs to account for the alpha-error that occurs when you perform many statistical tests. The exact methodology is explained here

AE Reporting Quality Assurance

simaerep is currently a cornerstone in our AE reporting quality assurance strategy. As we describe in our latest publication:

Collaboration

We are frequently refining our quality analytics methods and are happy to collaborate in developing industry standards. Please reach out if you have any comments or questions.

Application

suppressPackageStartupMessages(library("simaerep"))

set.seed(1)

df_visit <- sim_test_data_study(
  n_pat = 1000, # number of patients in study
  n_sites = 100, # number of sites in study
  frac_site_with_ur = 0.05, # fraction of sites under-reporting
  ur_rate = 0.4, # rate of under-reporting
  ae_per_visit_mean = 0.5 # mean AE per patient visit
)

df_visit$study_id <- "A"

df_site <- site_aggr(df_visit)

df_sim_sites <- sim_sites(df_site, df_visit, r = 1000)

df_eval <- eval_sites(df_sim_sites, r_sim_sites = 1000)

plot_study(df_visit, df_site, df_eval, study = "A")

easyalluvial 0.2.3 released

Sun, 17 May 2020 00:00:00 +0000

easyalluvial allows you to build exploratory and interactive alluvial plots (sankey diagrams) with a single line of code while automatically binning numerical variables. This release 0.2.3 ensures dplyr 1.0.0 compatibilitiy and now builds a slick pkgdown documentation website and makes better use of Travis CI using multiple builds to test compatibility with development versions of selected package dependencies.

New ‘pkgdown’ Documentaion

If I knew how easy it was to create a pkgdown documentation website I would have done it long time ago. The easyalluvial documentation used to consist of only the README.md file with links to blogposts that would contain more detailed tutorials. Now everything can be found in one place.

https://erblast.github.io/easyalluvial/

New ‘Travis CI’ Configuration

The real change however, is that I am now making better use of Travis CI. I made it a habit to develop in a designated branch and use pull requests to merge with the master branch. Travis CI now controls the merge of the pull request only allowing it if all checks in all builds have passed. In addition to simply running package checks Travis CI now uses multiple parallel builds. One build each for R-release and R-devel and a couple of more for checking compatibility with development versions of selected tidyverse dependencies. Another build checks the reverse dependency parcats.

Even cooler Travis CI is setup to build the pkgdown website and publishes it immediately to a separate github pages branch. So me forgetting to build the website before commiting to github will not effect the documentation. There is a great blogpost with instruction on how to set-up Travis CI to deploy github pages.

Since I set up many parallel builds in different environments I only want one of them to render the documentation. Therefore I created an environment variable PKGDOWN which is set to yes in only one of the builds and set to no in the others. The deploy section will only run if PKGDOWN=yes on the master branch.

For R-packages the script section of each build is pre-configured. In order to integrate the building of the pkgdown website into the script part of the r-release build I had to overwrite it. Which required me to also add commands for installing package dependencies and running package checks.

This is the content of the final .travis.yml

language: R
R:
  - release
sudo: false
cache: packages

r_packages:
  - covr

matrix:
  include:
  - r: devel
    after_success:
    - export PKGDOWN=no
  - r: release
    before_script: 
      - Rscript -e 'install.packages(c("earth", "tidyverse", "mlbench", "pkgdown"))'
      - Rscript -e "devtools::install_deps('.', dependencies = 'suggests')"
    script:
      - Rscript -e "devtools::check('.', error_on = 'note')"
      - Rscript -e 'pkgdown::build_site(run_dont_run = TRUE)'
    after_success:
      - Rscript -e 'covr::codecov()'
      - export PKGDOWN=yes
  - r: release
    name: tidyr-devel
    before_script: Rscript -e "remotes::install_github('tidyverse/tidyr')"
    after_success:
    - export PKGDOWN=no
  - r: release
    name: dplyr-devel
    before_script: Rscript -e "remotes::install_github('tidyverse/dplyr')"
    after_success:
    - export PKGDOWN=no
  - r: release
    name: parcats-devel
    script:
      - git clone https://github.com/erblast/parcats.git
      - git clone https://github.com/erblast/easyalluvial.git
      - Rscript -e "install.packages('spelling')"
      - Rscript -e "devtools::install_deps('easyalluvial/', dependencies = 'suggests')"
      - Rscript -e "devtools::install_deps('parcats/', dependencies = 'suggests')"
      - Rscript -e "devtools::install('easyalluvial/')"
      - Rscript -e "devtools::check('easyalluvial/', error_on = 'note')"
      - Rscript -e "devtools::check('parcats/', error_on = 'note')"
    after_success:
    - export PKGDOWN=no
    
deploy:
  provider: pages
  skip_cleanup: true
  github_token: $GITHUB_TOKEN  # Set in the settings page of your repository, as a secure variable
  keep_history: true
  local-dir: docs
  on:
    branch: master
    condition: $PKGDOWN = yes

More changes

… NEWS.md

parcats 0.0.1 released

Thu, 05 Dec 2019 00:00:00 +0000

parcats was released on CRAN. It is an htmlwidget providing bindings to the plotly.js parcats trace, which is not supported by the plotly R package. Also adds marginal histograms for numerical variables.

demogif

What it can do

I wanted to add interactivity to easyalluvial plots for a while now and found that the parcats trace of plotly.js would be perfect because brushing with the mouse highlights the entire flow and not just everything flowing in and out of a specific node as in most D3 Sankey chart implementations. Unfortunately the parcats trace was not available in the plotly R package so I decided to build a new html widget to create R bindings for specifically this trace.

converts any easyalluvial plot to an interactive parallel categories diagram
interactive marginal histograms
multidimensional partial dependency and model response plots

easyalluvial

parcats requires an alluvial plot created with easyalluvial to create an interactive parrallel categories diagram.

Demo

Examples

suppressPackageStartupMessages( require(tidyverse) )
suppressPackageStartupMessages( require(easyalluvial) )
suppressPackageStartupMessages( require(parcats) )

Parcats from alluvial from data in wide format

p = alluvial_wide(mtcars2, max_variables = 5)
parcats(p, marginal_histograms = TRUE, data_input = mtcars2)

Parcats from model response alluvial

Machine Learning models operate in a multidimensional space and their response is hard to visualise. Model response and partial dependency plots attempt to visualise ML models in a two dimensional space. Using alluvial plots or parrallel categories diagrams we can increase the number of dimensions.

Visualise model response with alluvial plots

Here we see the response of a random forest model if we vary the three variables with the highest importance while keeping all other features at their median/mode value.

df = select(mtcars2, -ids )
m = randomForest::randomForest( disp ~ ., df)
imp = m$importance
dspace = get_data_space(df, imp, degree = 3)
pred = predict(m, newdata = dspace)
p = alluvial_model_response(pred, dspace, imp, degree = 3)
parcats(p, marginal_histograms = TRUE, imp = TRUE, data_input = df)

Easyalluvial 0.2.1 released

Tue, 17 Sep 2019 00:00:00 +0000

easyalluvial allows you to build exploratory alluvial plots (sankey diagrams) with a single line of code while automatically binning numerical variables. This releas 0.2.1 ensures tidyr 1.0.0 compatibility and fixes a bug around categorical variables for model response plots

Model Response Plots with Categorical Variables

This feature had som glitches before as edvardoss reported in this issue. If anybody else encounters some glitches or inconcistencies please report them as well.

We create a grid of all possible feature combinations and use an alluvial plot to visualise the model response.

Learn more about this feature in this previous blog post

suppressPackageStartupMessages( require(tidyverse) )
suppressPackageStartupMessages( require(easyalluvial) )

df = titanic %>%
  select_if(is.factor)

set.seed(0)
m = randomForest::randomForest( Survived ~ ., df)
imp = m$importance
dspace = get_data_space(df, imp, degree = 3)
pred = predict(m, newdata = dspace,type = 'response')


p = alluvial_model_response(pred, dspace, imp, degree = 3)

grid = add_marginal_histograms(p, plot = F, data_input = df) 
grid = add_imp_plot(grid = grid, p = p, data_input = df, plot = T)

More changes

… NEWS.md

Europython 2019

Mon, 15 Jul 2019 00:00:00 +0000

Europython 2019

I attended europython 2019 here are some of my takeaways and notes.

General Takeaways

docker is widely used for reproducible environments especially for training sessions and for deploying models.
mostly docker images would be deployed as flask apps, with an REST API.
REST APIs can be managed using swagger
docker images would be managed using kubernetes
continuous delivery was advertised a lot
VS Code seems to be the most popular IDE, very good demo at the MS booth. Beats atom and pycharm in my opinion.
scikitlearn 0.21 release great new features ColumnTransformer replaces sklearn-pandas, histogram gradient boosting, faster and more light weight then regular gradient boosting.
dirty_cat has great encoders for dirty data. SimilarityEncoder and

the new sci-kit column transformer, has very a very simple API, that makes it easy to transform your pandas df into a numpy matrix. Howver the method get_feature_names(). Is not working for most transformers github issue. So it is not really possible to inspect the transformations inside the matrix in a systematic way. sklearn-pandas does not have that problem, however its API is a bit more complicated.

Training Days

REST API/Microservices

use connexion with swagger to build YAML configurable REST API’s. swagger provides documentation and user interface based on yaml.

Pytest

pytest can run tests from other testing suites, in order to incorporate examples from docstrings doctest can be used as pytest --doctest
pytest goes by no API is a good API
markers can be used to organise tests
fixtures can be used to pass data to tests
hypothesis can be used to generate random testing strings. If a fail is detected it will give a minimal reproducible example.

Intel Tensorflow

intel published tensorflow configuration that is 2X -4x times faster than out-of-the-box tensorflow

Talks

scikitlearn 0.21

rf models are larger than gb trees
histogram gradient boosted trees are implemented, low memory cost, faster training
early stopping, stops training when a platuea of performance has been reached such as for number of trees.
column transformer has been introduced, game changer, better alternative to sklearn-pandas
kbinsdicretizer preprocessor to compute nonelinear decision boundaries in order to generate new features which improves performance of linear models.

Vaex

lazy loads large data from disk to RAM
creates virtual columns from column calculations

has great histogram plotting features
supports hdfs and appache arrow
user defined functions, can be translated to C using numbajit
window functions like aggregate in pandas
comes with a lot of wrappers for python ml libraries, supports scikitlearn but does not support all scalers
pca on data points on a map with x-y coordinates can be used to shift coordinate points representing a density grid tilted grid into a horizontally alligned grid
save all operations done in one df, can be saved as json and applied to a new dataframe. Replacement for pipelines

Make Docker Images Safe

Large docker images have many exposed vulnarbilities
securety tools like claire can be used to scan them
shells can be attached to the docker image
use distroless image (reduced images)
distroless get rid of everything that is not needed, for example the ls command from the shell.
pyinstaller can be used to reduce dependencies, but does not detect all dependencies and then they need to be added manually.

Do: - dont run as root - use image hash instead of image name and tag (hash sign version of image similar like git commit hashes) - build your own distroless images - sign docker images

Recommendation Engine

use euclidean distance of ratings to calculate similarity score
calculate weighted average (by similarity score) as prediction
recommend if predicted recommendation is higher than average rating

Python packaging

slides

Dev Test workflow

use pip install -e . install package from from curent wd, during package dev. updates all files loaded from repo, like devtools::load_all() in R. Does not install directly into py dist.

put .py files into src/ directory instead of packagename directory. Force your tests to run on pip install -e . version of your code.

Testing with Tox somehow like Rcmdcheck, different python versions can be spcified.

check-manifest checks whether all files are included in tar ball.

Documentation

sphinx pythonic solution for python doc. generates api reference from docstrings

mkdocs language agnostic markdown documentation for projects libraries, pydocmd claims to do generate api reference from docstrings. sphinx might be more advanced, on this, best to check receommended docstring layout recommended for the tool.

pydoc can also bve used to make documentation from docstrings. In standard library.

add readme.md to setuptools so it propably shows up on python

from setuptools import setup
with open("README.md", "r") as fh:
 long_description = fh.read()
setup(
 …
 long_description=long_description,
 long_description_content_type="text/markdown", 
 ...
)

Templates

cookiecutter has python package templates

Dirty Data

Dirty categorical features

manualy break up into two or more seperate features, for example first name, last name
manualy group categories
Similarity Endoding, similarity distance to category, new strings can be fitted on old categories
Jaro-winkler, levenstain, 3-gram similarity scores
dirty_cat has similarity encoder from dirty_cat import SimilarityEncoder
TargetEncoder, Encode Categorical Feature as Mean/Median of other value, example police officer ranking on Salary
Latent Category Encoder, builds new categories based on substring similarities

Missing Values

classical data generation assumption, data generation is complete and random entries are random.
NA values are seldom random, and sometimes are the result of the data model, like age of spouse will be NA for people that are single
mean imputation distorts the distribution, concerning for statisitcal models but not algorithmic models
when imputing age of spouse, missingness indicator could be used to flagg single people

From Script to Open Source

-docopt helps you build GNU compliant CLI-tools - code guides, only 2 parameters per function. - python setup.py develop same as pip install -e . - setup.py let’s you define entry points (for package plug-ins) and CLI callable name - requirements.txt file can augment setup.py dependencies, stating tested dependency versions - black reformats code to be pythonic - pre-commit runs formatters such as black before git commit - flake8 to check you code - tox.ini configuration file for black code standard and flake8 - use static type analysis, MyPy checks if function with wrong type has been called - tox manages all those tools including testing tools similar to Rcmdcheck I guess - travisCI pip installing tox is enough to run all test - requirements updater is a bot that will continuosly check versions of dependencies, PyUP - pytest-cov will check test coverage - automated code review PR - automated pull request merge mergify - twine to upload to pypi

blog

State of Production ML in 2019

slides + example projects

GITOPS STRATEGIES FOR ML

CI/CD via github, using, docker, kubernetes description

Modelling Process

data assessment
model assessment (feature importance, shap-values, pdp-plots, interpretability)
production monitoring (see that asassments remain intact during production)
explainer, model that adds explanations to predictions,
- alibi, delivers pertinent negative and pertinate positive (minimum changes for positive and negative prediction)
seldon can be used to manage kubernetes

Reproducibility

Container Versioning

Modern Continuous Delivery

slides
- deploy to production from commit #1
- take over release schedule from IT to Business
- CDEV is concept, CI and CDEP are techniques
- Modern
* immutable infrastructure
* container orchestration
* version control and automation
* cloud native apps

tools? choice or lock-in?, lock-in choices should be avoided

cookiecutter seems to be what devtools/usethis is for python, can be used to setup CDEV for projects.
generate + seal your secrets, otherwise you cant continuously deliver
dont overload your yaml
test-driven, pair programming
the only way to go fast is to go well, robert c. martin

Practical Clean Architecture

Typing for data interfaces

typing, use type annotations when writing functions
typing package has objects that allow you type specifications for dictionaries
python 3.7 offers data classes that make this easier
dataclasses can be frozen, immutability can be added
use abstractions to interact with databases, ABC packages
we can use injector to build interfaces, will inject stuff into data classes
the interfaces can be documented with swagger
make an in RAM db for testing

These interfaces are easily testable

Architecture

lifetime 10 years
make an application centric infrastructure
do not put your db the center of your architecture

Visualising Model Response with easyalluvial

Wed, 10 Apr 2019 00:00:00 +0000

In this tutorial I want to show how you can use alluvial plots to visualise model response in up to 4 dimensions. easyalluvial generates an artificial data space using fixed values for unplotted variables or uses the partial dependence plotting method. It is model agnostic but offers some convenient wrappers for caret models. HUGOMORE42

Introduction

Taking a peek

When building machine learning models we are usually faced with a trade-off between accurracy and interpretability. However even if we tend to lean towards accuracy and pick a modelling method that results in nearly uninterpretable models we can still make use of model agnostic interporetation techniques that have been summarized in this excellent ebook Interpretable Machine Learning by Christoph Molnar.

Whithout getting to theoretical I personally always feel the urge to simply take a peek simulate some data and see how the model reacts a method described in here. In order to simulate data we can generate a a vector with a sequence of values over the entire range of a predictor variable of interest while setting all the others to their median or mode and use this artificial data space to obtain model predictions which we can plot against our variable of interest. An R package that will do this for you is (plotmo)[https://cran.r-project.org/web/packages/plotmo/index.html]. Instead of ranging over 1 predictor variable we can create a data grid using 2 predictor variables and plot the response as a third dimension. However this is as far as you can go in a conventional plot. Alluvial plots can line up much more than 3 dimensions on a plane next to each other only limited by the number of flows as it will get too cluttered when there are too many of them.

Which variables to plot

When using conventional model response plotting beeing limited two 2 variables we can simply resolve this by generating many plots and look at them one by one. Alluvial plots require a bit more attention and cannot easily be screened and compared since visually there is so much going on. Therefore I do not recommend to brute force it by simply creating a lot of random combinations of predictor variables and multiple alluvial plots but instead to focus on those that have the highest calculated feature importance. Feature importance values are natively provided by most modelling packages. So the question is how many can we plot and it turns out 4 features will usually result in well-interpretable plot.

Generating the data space

suppressPackageStartupMessages( require(tidyverse) )
suppressPackageStartupMessages( require(easyalluvial) )
suppressPackageStartupMessages( require(mlbench) )
suppressPackageStartupMessages( require(randomForest) )

We start by creating a model

data('BostonHousing')
df = as_tibble( BostonHousing )
m = randomForest( lstat ~ ., df )

and looking at the importance features

imp = m$importance %>%
  tidy_imp(df) # 

knitr::kable(imp)

vars	imp
medv	7978.9670
rm	3683.4451
age	2696.7073
indus	2625.7043
crim	2360.3927
nox	1851.2070
dis	1801.1501
b	699.6415
tax	586.4917
ptratio	385.9052
rad	211.5843
zn	136.5514
chas	125.0429

When generating the data space we cannot screen an infinite amount of values per variable but will have to limit ourselves to a fixed number. Then we want to create all possible combinations between these values which determines the number of flows. The visual limit for flows on an alluvial plot is somewhere around 1000 flows. Thus I recommend to go with 5 values which will result in 5 x 5 X 5 X 5 –> 625 combinations and the same number of flows. That also leaves some wiggeling room if one of the top 4 variables is a factor with more than 5 levels. get_data_space() will split the range of a variable into 3 and pick the median of each split and add the variable minimum and the maximum to the set.

dspace = get_data_space(df, imp
                        , degree = 4 # specifies the number of variables
                        , bins = 5 # the number of values per variable
                        )

knitr::kable( head(dspace, 10) )

medv	rm	age	indus	crim	nox	dis	b	tax	ptratio	rad
5	3.561	2.9	0.46	0.25651	0.538	3.20745	391.44	330	19.05	5
5	3.561	2.9	4.27	0.25651	0.538	3.20745	391.44	330	19.05	5
5	3.561	2.9	9.90	0.25651	0.538	3.20745	391.44	330	19.05	5
5	3.561	2.9	18.10	0.25651	0.538	3.20745	391.44	330	19.05	5
5	3.561	2.9	27.74	0.25651	0.538	3.20745	391.44	330	19.05	5
5	3.561	32.2	0.46	0.25651	0.538	3.20745	391.44	330	19.05	5
5	3.561	32.2	4.27	0.25651	0.538	3.20745	391.44	330	19.05	5
5	3.561	32.2	9.90	0.25651	0.538	3.20745	391.44	330	19.05	5
5	3.561	32.2	18.10	0.25651	0.538	3.20745	391.44	330	19.05	5
5	3.561	32.2	27.74	0.25651	0.538	3.20745	391.44	330	19.05	5

Total rows in dspace: 625

dspace %>%
  summarise_all( ~ length( unique(.) ) ) %>%
  knitr::kable()

medv	rm	age	indus	crim	nox	dis	b	tax	ptratio	rad	zn	chas
5	5	5	5	1	1	1	1	1	1	1	1	1

Generating model response

pred = predict(m, newdata = dspace)

Plotting

The predictions will be binned as well into 5 bins. Binning options can be passed as a list via the params_bin_numeric_pred parameter.

p = alluvial_model_response(pred, dspace, imp
                            , degree = 4, bins = 5
                            , stratum_label_size = 2.8 )
p

We can see the binned range of predictions and explore by which variable combination they have been created by tracing the coloured flows. The stratum labels of the prediction variables indicate the value of the variable and which fraction of the flows of that colour (prediction variable bin range) pass through that stratum.

Marginal histograms

As well as for other easyalluvial plots we can add marginal histograms and as a bonus also the feature importance.

p_grid = add_marginal_histograms(p, data_input = df
                                 , plot = F # plot only after adding feature importance
                                 , scale = 50 # to increase distance between ridge plots, Default: 400
                                 ) %>%
  add_imp_plot( p = p, data_input = df)

We can see the original distribution of the variables, the lines indicate the position of the values as picked by get_data_space(). When comparing the distribution of the predictions against the original distribution of lstat we see that the range of the predictions in response to the artificial dataspace do not cover all of the range of lstat. Which most likely means that all possible combinations of the 4 plotted variables in combination with moderate values for all other predictors will not give any extreme values. Which we can further explore, first we will need to check whether the model is capable of making predictions in the lower and upper ranges of lsat. We can use plot_hist() to only plot the distributions and add the prediction for the training data set using the pred_train parameter.

pred_train = predict(m)

plot_hist('pred', p, df
          , pred_train = pred_train # pred_train can also be passed to add_marginal_histograms()
          , scale = 50)

We see that the training prediction also do not completely cover all of the lstat range but more of it than the predictions from the aritficial data space.

If we wanted to emphasize this we can bin the data space predictions on the basis of the training predictions. In this case it makes sense to increase the number of bins for the predictions in order not to loose resolution on the plot.

p = alluvial_model_response(pred, dspace, imp, degree = 4, bins = 7
                            , bin_labels = c("LLL","LL", "ML", "M", "MH", "HH", "HHH")
                            , pred_train = pred_train
                            , stratum_label_size = 2.8 )

plot_hist('pred', p, df, scale = 50)

p_grid = add_marginal_histograms(p, data_input = df
                                 , plot = F # plot only after adding feature importance
                                 , scale = 50 # to increase distance between ridge plots, Default: 400
                                 ) %>%
  add_imp_plot( p = p, data_input = df)

What feature combinations are needed to obtain predictions in the lower and higher ranges of `lstat`?

We can add the training predictions to the training data and assign the variables not covered by the model response plot to bins. We can then create an alluvial plot over the entire training dataframe in order to trace the lstat ranges not covered by the model response alluvial plot above. Since we are only interested in those observations we remove all other flows from the plot by setting their color to NA.

breaks = c( min(pred_train) - 1,min(pred),max(pred),max(pred_train) + 1 )

df_inv = df %>%
  select(-lstat) %>%
  mutate( pred_train = pred_train
          , pred_train = cut(pred_train, breaks) ) %>%
  select( pred_train, one_of(imp$vars) ) # order by feature importance

p = alluvial_wide(df_inv, bin_labels = 'min_max'
                  , stratum_label_size = 3
                  , col_vector_flow = c('blue', NA, 'orange')
                  , colorful_fill_variable_stratum = F)

p_grid = add_marginal_histograms(p, df_inv)

We can see that for the upper ranges of lstat a pretty specific combination values is required from 8 feature variables from medv until tax only then begin the flows to scatter over the eintire range of the following variables. The lower range values of lstat start to scatter at crim or dis. Interestingly there seems to be a set of houses that branches off from the other houses in the lower range of lstat predictions already at the third feature, age. We could potentially explore this further, as a reminder you can get the binned input data for each alluvial plot by calling p$data_key and trace the variables of interest.

`caret` wrapper

caret provides a uniformous interface for training and calling a lot of machine learning models as well as for calculating feature importance. easyalluvial provides a function that wraps the above described workflow into one single call. Note that feature importance values are slightly different. randomForest returns a combined importance for all levels of a factor variable while caret splits them up. tidy_imp() aggregates them and uses the maximum value of all values. This behaviour can be adjusted by passing another aggregating function to the .f parameter.

train = caret::train( lstat ~ .
                     , df
                     , method = 'rf'
                     , trControl = caret::trainControl( method = 'none' )
                     , importance = TRUE )

alluvial_model_response_caret(train, degree = 4, bins = 5
                              , stratum_label_size = 2.8)

Advantages

Model response alluvial plots can help us to get an immediate intuitive understanding how predictions of a certain range can be generated by the model. They can be understood by none-statistical stakeholders and invite the viewer to start exploring and question the decision making process of the model while also conveying an appreciation for the model complexity as flows branch out to the variables of lower feature importance.

Partial Dependence Plotting Method

When simulating artificial data space we need to be aware that we will create data space that is outside the feature distribution space of our original training data. In this example we could be creating houses that cannot exist as such maybe a 5 square meter appartment with 10 bedrooms. We have to keep this in mind when interpretating the plot. Moreover by setting all the none-plotted values to median/mode we might also be creating observations outside the possible feature distribution space but this will be hidden and not foreseable even by somebody who has some subject matter expertise. Simply imagine how likely it would be if I meassurre a hundred different feautures of the inhabitants of a certain country how likely will it be that I find one person that is exactly the average for all of those measurements? So to alleviate this we can use the partial dependency plotting method:

construct the data space as described above, but instead of setting all none-plotted variables to median/mode we set them to the values found in the first row of the training data.
Repeat 1. for each row
Use all data spaces to get model predictions
Average model predictions

Using this method we reduce the risk of simulating data outside the feature distribution space concerning the variables that are not plotted.

pred = get_pdp_predictions(df, imp, m, degree = 4, bins = 5)

## [=>---------------------------------------------------------------------] 3%
## [==>--------------------------------------------------------------------] 4%
## [==>--------------------------------------------------------------------] 5%
## [===>-------------------------------------------------------------------] 5%
## [===>-------------------------------------------------------------------] 6%
## [====>------------------------------------------------------------------] 7%
## [====>------------------------------------------------------------------] 8%
## [=====>-----------------------------------------------------------------] 8%
## [=====>-----------------------------------------------------------------] 9%
## [======>----------------------------------------------------------------] 9%
## [======>----------------------------------------------------------------] 10%
## [=======>---------------------------------------------------------------] 11%
## [=======>---------------------------------------------------------------] 12%
## [========>--------------------------------------------------------------] 12%
## [========>--------------------------------------------------------------] 13%
## [=========>-------------------------------------------------------------] 13%
## [=========>-------------------------------------------------------------] 14%
## [=========>-------------------------------------------------------------] 15%
## [==========>------------------------------------------------------------] 15%
## [==========>------------------------------------------------------------] 16%
## [===========>-----------------------------------------------------------] 16%
## [===========>-----------------------------------------------------------] 17%
## [===========>-----------------------------------------------------------] 18%
## [============>----------------------------------------------------------] 18%
## [============>----------------------------------------------------------] 19%
## [=============>---------------------------------------------------------] 19%
## [=============>---------------------------------------------------------] 20%
## [==============>--------------------------------------------------------] 21%
## [==============>--------------------------------------------------------] 22%
## [===============>-------------------------------------------------------] 22%
## [===============>-------------------------------------------------------] 23%
## [================>------------------------------------------------------] 23%
## [================>------------------------------------------------------] 24%
## [================>------------------------------------------------------] 25%
## [=================>-----------------------------------------------------] 25%
## [=================>-----------------------------------------------------] 26%
## [==================>----------------------------------------------------] 26%
## [==================>----------------------------------------------------] 27%
## [===================>---------------------------------------------------] 27%
## [===================>---------------------------------------------------] 28%
## [===================>---------------------------------------------------] 29%
## [====================>--------------------------------------------------] 29%
## [====================>--------------------------------------------------] 30%
## [=====================>-------------------------------------------------] 30%
## [=====================>-------------------------------------------------] 31%
## [=====================>-------------------------------------------------] 32%
## [======================>------------------------------------------------] 32%
## [======================>------------------------------------------------] 33%
## [=======================>-----------------------------------------------] 33%
## [=======================>-----------------------------------------------] 34%
## [========================>----------------------------------------------] 35%
## [========================>----------------------------------------------] 36%
## [=========================>---------------------------------------------] 36%
## [=========================>---------------------------------------------] 37%
## [==========================>--------------------------------------------] 37%
## [==========================>--------------------------------------------] 38%
## [==========================>--------------------------------------------] 39%
## [===========================>-------------------------------------------] 39%
## [===========================>-------------------------------------------] 40%
## [============================>------------------------------------------] 40%
## [============================>------------------------------------------] 41%
## [============================>------------------------------------------] 42%
## [=============================>-----------------------------------------] 42%
## [=============================>-----------------------------------------] 43%
## [==============================>----------------------------------------] 43%
## [==============================>----------------------------------------] 44%
## [===============================>---------------------------------------] 44%
## [===============================>---------------------------------------] 45%
## [===============================>---------------------------------------] 46%
## [================================>--------------------------------------] 46%
## [================================>--------------------------------------] 47%
## [=================================>-------------------------------------] 47%
## [=================================>-------------------------------------] 48%
## [==================================>------------------------------------] 49%
## [==================================>------------------------------------] 50%
## [===================================>-----------------------------------] 50%
## [===================================>-----------------------------------] 51%
## [====================================>----------------------------------] 52%
## [====================================>----------------------------------] 53%
## [=====================================>---------------------------------] 53%
## [=====================================>---------------------------------] 54%
## [======================================>--------------------------------] 54%
## [======================================>--------------------------------] 55%
## [======================================>--------------------------------] 56%
## [=======================================>-------------------------------] 56%
## [=======================================>-------------------------------] 57%
## [========================================>------------------------------] 57%
## [========================================>------------------------------] 58%
## [=========================================>-----------------------------] 58%
## [=========================================>-----------------------------] 59%
## [=========================================>-----------------------------] 60%
## [==========================================>----------------------------] 60%
## [==========================================>----------------------------] 61%
## [===========================================>---------------------------] 61%
## [===========================================>---------------------------] 62%
## [===========================================>---------------------------] 63%
## [============================================>--------------------------] 63%
## [============================================>--------------------------] 64%
## [=============================================>-------------------------] 64%
## [=============================================>-------------------------] 65%
## [==============================================>------------------------] 66%
## [==============================================>------------------------] 67%
## [===============================================>-----------------------] 67%
## [===============================================>-----------------------] 68%
## [================================================>----------------------] 68%
## [================================================>----------------------] 69%
## [================================================>----------------------] 70%
## [=================================================>---------------------] 70%
## [=================================================>---------------------] 71%
## [==================================================>--------------------] 71%
## [==================================================>--------------------] 72%
## [==================================================>--------------------] 73%
## [===================================================>-------------------] 73%
## [===================================================>-------------------] 74%
## [====================================================>------------------] 74%
## [====================================================>------------------] 75%
## [=====================================================>-----------------] 75%
## [=====================================================>-----------------] 76%
## [=====================================================>-----------------] 77%
## [======================================================>----------------] 77%
## [======================================================>----------------] 78%
## [=======================================================>---------------] 78%
## [=======================================================>---------------] 79%
## [========================================================>--------------] 80%
## [========================================================>--------------] 81%
## [=========================================================>-------------] 81%
## [=========================================================>-------------] 82%
## [==========================================================>------------] 82%
## [==========================================================>------------] 83%
## [==========================================================>------------] 84%
## [===========================================================>-----------] 84%
## [===========================================================>-----------] 85%
## [============================================================>----------] 85%
## [============================================================>----------] 86%
## [============================================================>----------] 87%
## [=============================================================>---------] 87%
## [=============================================================>---------] 88%
## [==============================================================>--------] 88%
## [==============================================================>--------] 89%
## [===============================================================>-------] 90%
## [===============================================================>-------] 91%
## [================================================================>------] 91%
## [================================================================>------] 92%
## [=================================================================>-----] 92%
## [=================================================================>-----] 93%
## [==================================================================>----] 94%
## [==================================================================>----] 95%
## [===================================================================>---] 95%
## [===================================================================>---] 96%
## [====================================================================>--] 97%
## [====================================================================>--] 98%
## [=====================================================================>-] 98%
## [=====================================================================>-] 99%
## [======================================================================>] 99%
## [======================================================================>] 100%
## [=======================================================================] 100%

alluvial_model_response(pred, dspace, imp, degree = 4
                        , method = 'pdp' # changes title and caption
                        , stratum_label_size = 2.8 )

thanks to the uniformous modelling interface of caret alluvial_model_response_caret() can call get_pdp_predictions() directly.

alluvial_model_response_caret(train, degree = 4, bins = 5
                              , method = 'pdp'
                              , stratum_label_size = 2.8 )

## [=>---------------------------------------------------------------------] 3%
## [==>--------------------------------------------------------------------] 4%
## [==>--------------------------------------------------------------------] 5%
## [===>-------------------------------------------------------------------] 5%
## [===>-------------------------------------------------------------------] 6%
## [====>------------------------------------------------------------------] 7%
## [====>------------------------------------------------------------------] 8%
## [=====>-----------------------------------------------------------------] 8%
## [=====>-----------------------------------------------------------------] 9%
## [======>----------------------------------------------------------------] 9%
## [======>----------------------------------------------------------------] 10%
## [=======>---------------------------------------------------------------] 11%
## [=======>---------------------------------------------------------------] 12%
## [========>--------------------------------------------------------------] 12%
## [========>--------------------------------------------------------------] 13%
## [=========>-------------------------------------------------------------] 13%
## [=========>-------------------------------------------------------------] 14%
## [=========>-------------------------------------------------------------] 15%
## [==========>------------------------------------------------------------] 15%
## [==========>------------------------------------------------------------] 16%
## [===========>-----------------------------------------------------------] 16%
## [===========>-----------------------------------------------------------] 17%
## [===========>-----------------------------------------------------------] 18%
## [============>----------------------------------------------------------] 18%
## [============>----------------------------------------------------------] 19%
## [=============>---------------------------------------------------------] 19%
## [=============>---------------------------------------------------------] 20%
## [==============>--------------------------------------------------------] 21%
## [==============>--------------------------------------------------------] 22%
## [===============>-------------------------------------------------------] 22%
## [===============>-------------------------------------------------------] 23%
## [================>------------------------------------------------------] 23%
## [================>------------------------------------------------------] 24%
## [================>------------------------------------------------------] 25%
## [=================>-----------------------------------------------------] 25%
## [=================>-----------------------------------------------------] 26%
## [==================>----------------------------------------------------] 26%
## [==================>----------------------------------------------------] 27%
## [===================>---------------------------------------------------] 27%
## [===================>---------------------------------------------------] 28%
## [===================>---------------------------------------------------] 29%
## [====================>--------------------------------------------------] 29%
## [====================>--------------------------------------------------] 30%
## [=====================>-------------------------------------------------] 30%
## [=====================>-------------------------------------------------] 31%
## [=====================>-------------------------------------------------] 32%
## [======================>------------------------------------------------] 32%
## [======================>------------------------------------------------] 33%
## [=======================>-----------------------------------------------] 33%
## [=======================>-----------------------------------------------] 34%
## [========================>----------------------------------------------] 35%
## [========================>----------------------------------------------] 36%
## [=========================>---------------------------------------------] 36%
## [=========================>---------------------------------------------] 37%
## [==========================>--------------------------------------------] 37%
## [==========================>--------------------------------------------] 38%
## [==========================>--------------------------------------------] 39%
## [===========================>-------------------------------------------] 39%
## [===========================>-------------------------------------------] 40%
## [============================>------------------------------------------] 40%
## [============================>------------------------------------------] 41%
## [============================>------------------------------------------] 42%
## [=============================>-----------------------------------------] 42%
## [=============================>-----------------------------------------] 43%
## [==============================>----------------------------------------] 43%
## [==============================>----------------------------------------] 44%
## [===============================>---------------------------------------] 44%
## [===============================>---------------------------------------] 45%
## [===============================>---------------------------------------] 46%
## [================================>--------------------------------------] 46%
## [================================>--------------------------------------] 47%
## [=================================>-------------------------------------] 47%
## [=================================>-------------------------------------] 48%
## [==================================>------------------------------------] 49%
## [==================================>------------------------------------] 50%
## [===================================>-----------------------------------] 50%
## [===================================>-----------------------------------] 51%
## [====================================>----------------------------------] 52%
## [====================================>----------------------------------] 53%
## [=====================================>---------------------------------] 53%
## [=====================================>---------------------------------] 54%
## [======================================>--------------------------------] 54%
## [======================================>--------------------------------] 55%
## [======================================>--------------------------------] 56%
## [=======================================>-------------------------------] 56%
## [=======================================>-------------------------------] 57%
## [========================================>------------------------------] 57%
## [========================================>------------------------------] 58%
## [=========================================>-----------------------------] 58%
## [=========================================>-----------------------------] 59%
## [=========================================>-----------------------------] 60%
## [==========================================>----------------------------] 60%
## [==========================================>----------------------------] 61%
## [===========================================>---------------------------] 61%
## [===========================================>---------------------------] 62%
## [===========================================>---------------------------] 63%
## [============================================>--------------------------] 63%
## [============================================>--------------------------] 64%
## [=============================================>-------------------------] 64%
## [=============================================>-------------------------] 65%
## [==============================================>------------------------] 66%
## [==============================================>------------------------] 67%
## [===============================================>-----------------------] 67%
## [===============================================>-----------------------] 68%
## [================================================>----------------------] 68%
## [================================================>----------------------] 69%
## [================================================>----------------------] 70%
## [=================================================>---------------------] 70%
## [=================================================>---------------------] 71%
## [==================================================>--------------------] 71%
## [==================================================>--------------------] 72%
## [==================================================>--------------------] 73%
## [===================================================>-------------------] 73%
## [===================================================>-------------------] 74%
## [====================================================>------------------] 74%
## [====================================================>------------------] 75%
## [=====================================================>-----------------] 75%
## [=====================================================>-----------------] 76%
## [=====================================================>-----------------] 77%
## [======================================================>----------------] 77%
## [======================================================>----------------] 78%
## [=======================================================>---------------] 78%
## [=======================================================>---------------] 79%
## [========================================================>--------------] 80%
## [========================================================>--------------] 81%
## [=========================================================>-------------] 81%
## [=========================================================>-------------] 82%
## [==========================================================>------------] 82%
## [==========================================================>------------] 83%
## [==========================================================>------------] 84%
## [===========================================================>-----------] 84%
## [===========================================================>-----------] 85%
## [============================================================>----------] 85%
## [============================================================>----------] 86%
## [============================================================>----------] 87%
## [=============================================================>---------] 87%
## [=============================================================>---------] 88%
## [==============================================================>--------] 88%
## [==============================================================>--------] 89%
## [===============================================================>-------] 90%
## [===============================================================>-------] 91%
## [================================================================>------] 91%
## [================================================================>------] 92%
## [=================================================================>-----] 92%
## [=================================================================>-----] 93%
## [==================================================================>----] 94%
## [==================================================================>----] 95%
## [===================================================================>---] 95%
## [===================================================================>---] 96%
## [====================================================================>--] 97%
## [====================================================================>--] 98%
## [=====================================================================>-] 98%
## [=====================================================================>-] 99%
## [======================================================================>] 99%
## [======================================================================>] 100%
## [=======================================================================] 100%

A note on feature importance

Calculating feature importance in a dataset with strongly correlating variables will lead to inacurrate results. It usually means that two strongly correlating variables share the importance that would be accredited to them if only one of them was present in the data set. Further some feature importance calculation methods require the model to be trained with scaled, centered and potentially normalized (transformed to be more normally distributed) numerical variables in order to deliver meaningful results. We can use the recipes package to perform these tasks. Using the below described workflow we can create the artifical dataspace with untransformed numerical values which will give us more meaningful output.

suppressPackageStartupMessages( require(recipes) )


# filter correlating variables recipe- ------------------------------
# caret tends to complain if recipe filters any variables, therefore
# we use two recipes

rec_filt_corrs = recipe(df, lstat ~ . ) %>%
  step_corr( all_numeric()
             , - all_outcomes()
             , threshold = 0.7 ) %>%
  prep()


df_filt_corrs = bake(rec_filt_corrs, df)

# transformation recipe --------------------------------------------
rec_trans = recipe( df_filt_corrs, lstat ~ .) %>%
  step_center( all_numeric(), - all_outcomes() ) %>%
  step_scale( all_numeric(), - all_outcomes() ) %>%
  step_YeoJohnson( all_numeric(), - all_outcomes() ) %>%
  prep()

# train and plot ---------------------------------------------------
set.seed(1)
train = caret::train( rec_trans
                     , df_filt_corrs
                     , method = 'earth'
                     , trControl = caret::trainControl( method = 'cv'
                                                        , search = 'random')
                     , tuneLength = 100)

pred_train = predict(train, df_filt_corrs)

p = alluvial_model_response_caret(train, degree = 4, bins = 5
                                  , pred_train = pred_train
                                  , stratum_label_size = 2.8 )

p_grid = add_marginal_histograms(p, df, plot = F
                                 , pred_var = 'lstat'
                                 , scale = 50) %>%
  add_imp_plot(p, df)

None-regression models

Works the same way.

df = select(mtcars2, -ids)
m = randomForest::randomForest( am ~ ., df)
imp = m$importance
dspace = get_data_space(df, imp, degree = 3)

pred = predict(m, newdata = dspace,type = 'response')
p = alluvial_model_response(pred, dspace, imp, degree = 3)
p

Limitations

There is a loss of information when binning the numerical variables
The combinations generated when making the grid might be outside the feature distribution space (generate combinations that are impossible)
We only look at the combination of 4 features and disregard the others

To alleviate this you can reduce the complexity of the model by reducing features (take out correlating variables) or use additional model exploration methods such as classical PDPs, ALE plots, Shapely values, etc, …

Easyalluvial 0.2.0 released

Mon, 01 Apr 2019 00:00:00 +0000

easyalluvial allows you to build exploratory alluvial plots (sankey diagrams) with a single line of code while automatically binning numerical variables. In version 0.2.0 marginal histograms improve the visibility of those numerical variables. Further a method has been added that creates model agnostic 4 dimensional partial dependence alluvial plots to visualise the response of statistical models.

Introduction

I am happy to announce the release of easyalluvial 0.2.0 with some exciting new features and some minor changes compared to version 0.1.8 Some improvements were made on the default plotting options with improved colors and label size.

suppressPackageStartupMessages( require(tidyverse) )
suppressPackageStartupMessages( require(easyalluvial) )

Marginal Histograms

The automated binning of numerical variables hides their distribution. This new feature alleviates that.

p = alluvial_wide(mtcars2, max_variables = 9)

p_grid = add_marginal_histograms(p, mtcars2)

Partial Dependence Alluvial Plots with 4 dimensions

Alluvial plots are capable of displaying higher dimensional data on a plane, thus lend themselves to plot the response of a statistical model to changes in the input data across multiple dimensions. The practical limit here is 4 dimensions while conventional partial dependence plots are limited to 2 dimensions.

Briefly the 4 variables with the highest feature importance for a given model are selected and 5 values spread over the variable range are selected for each. Then a grid of all possible combinations is created. All none-plotted variables are set to the values found in the first row of the training data set. Using this artificial data space model predictions are being generated. This process is then repeated for each row in the training data set and the overall model response is averaged in the end. Each of the possible combinations is plotted as a flow which is coloured by the bin corresponding to the average model response generated by that particular combination.

more on partial dependence plots (ebook)

df = select(mtcars2, -ids)

train = caret::train( disp ~ .
                      ,  df
                      , method = 'rf'
                      , trControl = caret::trainControl( method = 'none' )
                      , importance = TRUE )


p = alluvial_model_response_caret(train, degree = 4, method = 'pdp')

## [======================================================>----------------] 78%
## [=========================================================>-------------] 81%
## [===========================================================>-----------] 84%
## [=============================================================>---------] 88%
## [===============================================================>-------] 91%
## [==================================================================>----] 94%
## [====================================================================>--] 97%
## [=======================================================================] 100%

p_grid = add_marginal_histograms(p, df, plot = F) %>%
  add_imp_plot(p, df)

We see that the top 4 important features of the model have been selected and that 5 values have been picked over the range of the numerical variables which together with the levels of the categorical variable have been used to construct a data grid of all possible combinations.

Step-by-Step

On the left we see the averaged model predictions that are generated by a specific combination of the 4 most important variables. You can find the combinations by tracing the coloured flows.
The stratum label of the individual feature variables indicate the variable value and which fraction of the colored flows pass through it.
On the right you see the feature importance of all variables and the proportion contributed by the plotted variables on the alluvial plot.
On the top left you see how the distribution of the generated predictions compare to the distribution of the predicted variable (in this case disp) in the training data.
The marginal histograms indicate the original distributions in the raining data and the lines indicate the location of the values picked for the data grid.

A more in-depth tutorial for this feature can be found on the project’s github page which will also be vailable on this blog in a few days.

If you are as enthusiastic about alluvial plots as me you will appreciate partial dependency alluvial plots because they can help us to get an immediate intuitive understanding how predictions of a certain range can be generated by the model. They can be understood by none-statistical stakeholders and invite the viewer to start exploring and question the decision making process of the model while also conveying an appreciation for the model complexity as flows branch out to the variables of lower feature importance. Ther are limitations though.

Limitations

There is a loss of information when binning the numerical variables
The combinations generated when making the grid might be outside the feature distribution space (generate combinations that are impossible)
We only look at the combination of 4 features and disregard the others
For a better interpretability of the feature importance it is adivable to remove strongly correlating variables and to scale, center and transform (Yeo-Johnson, Box-Cox) numerical variables, depending on the statistical model.

We do not have to use `caret`

Note: importance is calculated differently when using this implementation of random forest.

df = select(mtcars2, -ids)
m = randomForest::randomForest( disp ~ ., df)
imp = m$importance

dspace = get_data_space(df, imp, degree = 4)

pred = get_pdp_predictions(df, imp
                           , m
                           , degree = 4
                           , bins = 5)


p = alluvial_model_response(pred, dspace, imp, degree = 4, method = 'pdp')

p_grid = add_marginal_histograms(p, df, plot = F) %>%
  add_imp_plot(p, df)

Changes in Default Plotting Settings

Default colors have been changed. The first 7 colors of palette_qualitative() the function that provides the default colors have hand-picked for better contrast.
The stratum fill color of the variable determining the flow fill color in alluvial_wide() hast been set to match the flow fill color.
label text size can now be modified via stratum_label_size parameter. Labels have gotten slightly bigger by default.

More changes

… NEWS.md

Tidymodels

Sat, 29 Dec 2018 00:00:00 +0000

Introduction

RStudio is expanding the tidyverse principles to modelling with R and is building up another metapackage called tidymodels. There are a number of packages at different stages in their development. I am already familiar with rsample and recipes and have tried to implement them in a tidy caret-based modelling workflow before.

The goal of this post is to check up on all the different packages and try build up a regression modelling workflow using all the appropriate tidymodels tools as soon as they become available at CRAN for I think that this indicates that the authors were confident enough that their package has reached an acceptable stage of maturity.

Packages

CRAN availability of tidymodels packages:

package	CRAN	description
broom		Convert statistical analysis objects from R into tidy format
rsample		Classes and functions to create and summarize different types of resampling objects
dials		Tools for creating tuning parameter values
textrecipes		Extra recipes for Text Processing
yardstick		Tidy methods for measuring model performance
parsnip	NR	A tidy unified interface to models
probably	NR	Tools for post-processing class probability estimates
recipes		A preprocessing engine to generate design matrices
embed		Extra recipes for categorical predictor embeddings
infer		An R package for tidyverse-friendly statistical inference
tidyposterior		Bayesian comparisons of models using resampled statistics

Unified Modelling Syntax

The declared goal of the tidymodels metapackage is to provide a unified modelling synthax similar to scikit-learn in the python domain or an improved version of caret but adhering to the tidyverse principles. parsnip is going to be the core package while dials will provide suitable objects and functions for parameter tuning. The amount of supported models is still a bit meager so we will not explore these packages any further for the moment.

Statistical Tests and Model Selection

The regular statistical test supported by R have the same problem as the modelling implementations, they lack a uniform tidyverse compatible synthax. Further traditional statistical tests have lately gotten a bit out of fashion. The following criticism keeps popping up:

Specific statistical requirements for each test. The strategies for selecting the right statistical tests are a bit convoluted and a certain set of statistical requirements need to be full-filled for each of them.
Interpretation of P Values. There is a pickiness when it comes to interpreting P Values, the perfect definition eludes me and is completly useless to a none-statistician. Allen Downey has a refreshing practical approach to P values in which he uses a bayesian approach to show that indeed from small p values (<= 0.01) one can conlude that the observed effect has a low probability to be the result of chance (post)
Disregard of Effect Size. If we have a large sample even irrelevant effects will result in low p-values and if we have a small sample only very large effects will result in low p-values. If we detect a relevant effect with a low p-value we cannot be sure that the magnitude of the effect is reproducible. Typically the effect size will decrease the larger the sample. The Null hypothesis does not incorporate a minimum effect size.

As a remedy for the issue of the convoluted statisical requirements for each test a workaround has again been proposed by Allen Downey. He proposes to simulate data that assumes that there is no connection between two hypothetical sets of data that we want to compare (the null hypothesis is true). ( post1, post2 ). Similar to bootstrapping this method is none-parametric and we can use the simulated data to calculate a set of summary statistics. Then we can compare the distribution of these statistics against the actual value. infer allows us to do just that and on-top offers a tidy synthax to the conventional R implementations of standard statistical tests.

However even the simulation technique does not really help us to judge the effect size properly. This is something that can be adressed using bayesian modelling techniques, which will provide you with a posterior distribution of your response variable which allows you to sufficiently judge the effect size.

When using any k-fold cross-validation strategy for model training and validation we can apply statistical tests on each set of k performance metrics to select the best performing model. In general we run into the same issues as discussed above. In order to adress them we can either use the simulation technique of the inferpackage or use tidyposterior which uses Bayesian modelling to compare performance metrics which allows us to define a relevant effect size to test against.

In general I think tidyposterior is probably best practise, however to reduce complexity I am personally quite happy with the 1 SE rule. Simply plotting the mean value with the SE and then picking the simplest model that is within 1SE of the model with the highest performance. Thus I will not include these packages in my modelling workflow for the moment.

Resampling, Feature Engineering and Performance Metrics

rsample, recipes and yardstick are packages that give an overall complete impression and can be used with caret. rsample allows us to create cross validation pairs by indexing an existing dataframe and facilitates the use of modelling dataframes. If supports a variety of resampling methods such as not only limited to k-fold cross validation but also bootstrapping and nested cross validation. recipes allows straight forward feature engineering and preprocessing and yardstick allows us to easily calculate performance metrics from model predictions.

Modeling

We will fit the following regression models to the Boston Housing Data Set

xgbTree
lm
randomForest
MARS
Cubist
CART tree

For tuning we will use a randomized parameter search in a 5-fold cross validation

We will use the following packages: -recipes -resample -caret -yardstick -easyalluvial (for color palette)

suppressPackageStartupMessages( library('mlbench') )
suppressPackageStartupMessages( library('tidyverse') )
suppressPackageStartupMessages( library('recipes') )
suppressPackageStartupMessages( library('caret') )
suppressPackageStartupMessages( library('Hmisc') )
suppressPackageStartupMessages( library('xgboost') )


# ggplot default theme
theme_set(theme_minimal())

# Register mutiple cores for parallel processing
suppressPackageStartupMessages( library(parallel) )
suppressPackageStartupMessages( library(doParallel) )
cluster <- makeCluster(detectCores() - 1) ## convention to leave 1 core for OS
registerDoParallel(cluster)

```

Data

data('BostonHousing')
df = as_tibble( BostonHousing )
summary(df)

##       crim                zn             indus       chas         nox        
##  Min.   : 0.00632   Min.   :  0.00   Min.   : 0.46   0:471   Min.   :0.3850  
##  1st Qu.: 0.08205   1st Qu.:  0.00   1st Qu.: 5.19   1: 35   1st Qu.:0.4490  
##  Median : 0.25651   Median :  0.00   Median : 9.69           Median :0.5380  
##  Mean   : 3.61352   Mean   : 11.36   Mean   :11.14           Mean   :0.5547  
##  3rd Qu.: 3.67708   3rd Qu.: 12.50   3rd Qu.:18.10           3rd Qu.:0.6240  
##  Max.   :88.97620   Max.   :100.00   Max.   :27.74           Max.   :0.8710  
##        rm             age              dis              rad        
##  Min.   :3.561   Min.   :  2.90   Min.   : 1.130   Min.   : 1.000  
##  1st Qu.:5.886   1st Qu.: 45.02   1st Qu.: 2.100   1st Qu.: 4.000  
##  Median :6.208   Median : 77.50   Median : 3.207   Median : 5.000  
##  Mean   :6.285   Mean   : 68.57   Mean   : 3.795   Mean   : 9.549  
##  3rd Qu.:6.623   3rd Qu.: 94.08   3rd Qu.: 5.188   3rd Qu.:24.000  
##  Max.   :8.780   Max.   :100.00   Max.   :12.127   Max.   :24.000  
##       tax           ptratio            b              lstat      
##  Min.   :187.0   Min.   :12.60   Min.   :  0.32   Min.   : 1.73  
##  1st Qu.:279.0   1st Qu.:17.40   1st Qu.:375.38   1st Qu.: 6.95  
##  Median :330.0   Median :19.05   Median :391.44   Median :11.36  
##  Mean   :408.2   Mean   :18.46   Mean   :356.67   Mean   :12.65  
##  3rd Qu.:666.0   3rd Qu.:20.20   3rd Qu.:396.23   3rd Qu.:16.95  
##  Max.   :711.0   Max.   :22.00   Max.   :396.90   Max.   :37.97  
##       medv      
##  Min.   : 5.00  
##  1st Qu.:17.02  
##  Median :21.20  
##  Mean   :22.53  
##  3rd Qu.:25.00  
##  Max.   :50.00

Response Variable lstat

p_hist = ggplot(df) +
  geom_histogram( aes(lstat) ) +
  lims( x = c(0,40) )

p_ecdf = ggplot(df) +
  stat_ecdf(aes(lstat) ) +
  lims( x = c(0,40) )

gridExtra::grid.arrange( p_hist, p_ecdf )

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Correlations

df_cor = df %>%
  select_if( is.numeric ) %>%
  gather( key = 'variable', value = 'value', - lstat) %>%
  group_by(variable) %>%
  nest() %>%
  mutate( cor = map_dbl(data, function(x) cor(x$lstat, x$value) ) ) %>%
  unnest(cols = c(data)) %>%
  ungroup() %>%
  mutate( variable = fct_reorder(variable, cor)
          , cor = round(cor,2) )

df_label = df_cor %>%
  group_by( variable, cor) %>%
  summarise( pos = max(value) *.9 )

ggplot( df_cor, aes(lstat, value) ) +
  geom_point( alpha = 0.2 ) +
  geom_smooth( method = 'lm') +
  geom_label( aes( x = 5, y = pos, label = cor)
             , df_label
             , color = 'pink') +
  facet_wrap(~variable, scales = 'free_y')

## `geom_smooth()` using formula 'y ~ x'

lstat vs categorical variables

df %>%
  select_if( is.factor ) %>%
  bind_cols( df['lstat'] ) %>%
  gather( key = 'variable', value = 'value', - lstat) %>%
  ggplot( aes( x = value, y = lstat) ) +
  geom_violin() +
  geom_boxplot( alpha = 0.5 ) +
  ggpubr::stat_compare_means() +
  facet_wrap( ~ variable )

Preprocessing with recipe

Note we are intentionally standardizing the response variable since the unit of lstat is irrelevant for this demo

We will

Yeo Johnson Transform
Scale
Center
remove co-correlating variables (threshold 0.5)
dummy encode

rec = recipe(df, lstat ~ . )

summary(rec)

## # A tibble: 14 x 4
##    variable type    role      source  
##    <chr>    <chr>   <chr>     <chr>   
##  1 crim     numeric predictor original
##  2 zn       numeric predictor original
##  3 indus    numeric predictor original
##  4 chas     nominal predictor original
##  5 nox      numeric predictor original
##  6 rm       numeric predictor original
##  7 age      numeric predictor original
##  8 dis      numeric predictor original
##  9 rad      numeric predictor original
## 10 tax      numeric predictor original
## 11 ptratio  numeric predictor original
## 12 b        numeric predictor original
## 13 medv     numeric predictor original
## 14 lstat    numeric outcome   original

rec = rec %>%
  step_scale( all_numeric() ) %>%
  step_center( all_numeric() ) %>%
  step_YeoJohnson( all_numeric() ) %>%
  step_corr( all_numeric(), - all_outcomes(), threshold = 0.5 ) %>%
  step_dummy( all_nominal() )

Summary Recipe

prep_rec = prep(rec, df)
prep_rec

## Data Recipe
## 
## Inputs:
## 
##       role #variables
##    outcome          1
##  predictor         13
## 
## Training data contained 506 data points and no missing data.
## 
## Operations:
## 
## Scaling for crim, zn, indus, nox, rm, age, dis, rad, ... [trained]
## Centering for crim, zn, indus, nox, rm, age, dis, rad, ... [trained]
## Yeo-Johnson transformation on crim, zn, indus, nox, rm, age, ... [trained]
## Correlation filter removed indus, nox, age, dis, tax, medv, crim [trained]
## Dummy variables from chas [trained]

df_prep = bake(prep_rec, df )

Resampling with rsample

rs = rsample::vfold_cv(df, v = 5)

rsample::pretty.vfold_cv(rs)

## [1] "5-fold cross-validation"

Convert to caret-compatible object

rs_caret = rsample::rsample2caret(rs)

Modelling with caret

Wrapper

We will be using randomized parameter search instead of grid search despite the author’s suggestions. It is purely for convenience since it will automatically pick parameters within a sensible range for each model. If we would not automate that we would have to look up the ranges in the documentation or determine them empirically.

car = function( method, recipe, rsample, data){
  

  car = caret::train( recipe
                      , data
                      , method = method
                      , trControl = caret::trainControl(index = rsample$index
                                                        , indexOut = rsample$indexOut
                                                        , method = 'cv'
                                                        , verboseIter = T
                                                        , savePredictions = T
                                                        , search = 'random')
                      , metric = 'RMSE'
                      , tuneLength = 100
                       )
  
  return( car )
}

# c = car( 'lm', rec, rs_caret, df)

Apply Wrapper

df_m = tibble( methods = c('lm', 'rpart', 'cubist', 'parRF', 'earth', 'xgbTree') )

df_m = df_m %>%
  mutate( c = map(methods, car, rec, rs_caret, df ) )

Assess Performance with yardstick

df_pred = df_m %>%
  mutate( pred = map(c, 'pred' )
          , pred = map(pred, as_tibble )
          , best_tune = map(c, 'bestTune') )
  
df_pred

## # A tibble: 6 x 4
##   methods c          pred                   best_tune       
##   <chr>   <list>     <list>                 <list>          
## 1 lm      <tran.rcp> <tibble [506 × 5]>     <df[,1] [1 × 1]>
## 2 rpart   <tran.rcp> <tibble [18,216 × 5]>  <df[,1] [1 × 1]>
## 3 cubist  <tran.rcp> <tibble [48,070 × 6]>  <df[,2] [1 × 2]>
## 4 parRF   <tran.rcp> <tibble [3,036 × 5]>   <df[,1] [1 × 1]>
## 5 earth   <tran.rcp> <tibble [13,156 × 6]>  <df[,2] [1 × 2]>
## 6 xgbTree <tran.rcp> <tibble [50,600 × 11]> <df[,7] [1 × 7]>

filter(df_pred, methods == 'cubist') %>%
  .$pred

## [[1]]
## # A tibble: 48,070 x 6
##        obs rowIndex    pred committees neighbors Resample
##      <dbl>    <int>   <dbl>      <int>     <int> <chr>   
##  1 -1.87          4 -1.32            3         5 Fold1   
##  2  0.740         8 -0.0712          3         5 Fold1   
##  3  1.55          9  0.616           3         5 Fold1   
##  4  0.855        11 -0.240           3         5 Fold1   
##  5 -0.351        15 -0.0309          3         5 Fold1   
##  6 -0.123        19  1.15            3         5 Fold1   
##  7  0.481        26  1.06            3         5 Fold1   
##  8  0.292        27  0.225           3         5 Fold1   
##  9  0.560        28  0.608           3         5 Fold1   
## 10 -0.0793       30 -0.0862          3         5 Fold1   
## # … with 48,060 more rows

Parameters as string

We need to horizontally concat all parameter columns into two columns that are the same for all models otherwise we will not be able to unnest the predictions. We need to convert strings to symbols in order to use them for dplyr functions (see programming with dplyr ).

params_as_str = function(df, params){
  
  symbols = map( names(params), as.name )
  
  df %>%
    mutate( desc_values = pmap_chr( list( !!! symbols), paste )
            , desc_params = paste( names(params), collapse = ' ' ) )
}

# params_as_str(df_pred$pred[[6]], df_pred$best_tune[[6]] )

Apply and unnest

df_pred = df_pred %>%
  mutate( pred = map2(pred, best_tune, params_as_str )
          , pred = map(pred, select, Resample, desc_params, desc_values, rowIndex, obs, pred)
          ) %>%
  unnest(pred)

df_pred

## # A tibble: 133,584 x 9
##    methods c     Resample desc_params desc_values rowIndex     obs    pred
##    <chr>   <lis> <chr>    <chr>       <chr>          <int>   <dbl>   <dbl>
##  1 lm      <tra… Fold1    intercept   TRUE               4 -1.87   -0.815 
##  2 lm      <tra… Fold1    intercept   TRUE               8  0.740  -0.627 
##  3 lm      <tra… Fold1    intercept   TRUE               9  1.55   -0.177 
##  4 lm      <tra… Fold1    intercept   TRUE              11  0.855  -0.726 
##  5 lm      <tra… Fold1    intercept   TRUE              15 -0.351   0.0395
##  6 lm      <tra… Fold1    intercept   TRUE              19 -0.123   0.644 
##  7 lm      <tra… Fold1    intercept   TRUE              26  0.481   0.534 
##  8 lm      <tra… Fold1    intercept   TRUE              27  0.292   0.250 
##  9 lm      <tra… Fold1    intercept   TRUE              28  0.560   0.218 
## 10 lm      <tra… Fold1    intercept   TRUE              30 -0.0793 -0.331 
## # … with 133,574 more rows, and 1 more variable: best_tune <list>

Get best performing model for each method

df_best_models = df_pred %>%
  group_by( methods, desc_params, desc_values) %>%
  yardstick::rmse(obs, pred) %>%
  group_by( methods ) %>%
  mutate( rnk = rank(.estimate, ties.method = 'first' ) ) %>%
  filter( rnk == 1 ) %>%
  select( - rnk ) %>%
  arrange(.estimate) %>%
  ungroup() %>%
  mutate( methods = fct_reorder(methods, .estimate) )

df_best_models

## # A tibble: 6 x 6
##   methods desc_params          desc_values          .metric .estimator .estimate
##   <fct>   <chr>                <chr>                <chr>   <chr>          <dbl>
## 1 parRF   mtry                 2                    rmse    standard       0.512
## 2 xgbTree nrounds max_depth e… 638 4 0.02251800388… rmse    standard       0.540
## 3 cubist  committees neighbors 36 8                 rmse    standard       0.540
## 4 earth   nprune degree        8 2                  rmse    standard       0.563
## 5 rpart   cp                   0.00450606062062921  rmse    standard       0.592
## 6 lm      intercept            TRUE                 rmse    standard       0.624

Get cv-performance

performance = yardstick::metric_set( yardstick::rmse, yardstick::rsq, yardstick::mae, yardstick::mape )

df_perf = df_best_models %>%
  select(methods, desc_params, desc_values) %>%
  left_join(df_pred) %>%
  group_by( methods, Resample) %>%
  performance(obs, pred) %>%
  mutate( methods = as.factor(methods)
          , methods = fct_relevel(methods, levels(df_best_models$methods) )) %>%
  group_by(methods, .metric) %>%
  mutate( me = mean(.estimate)
             , se = sd(.estimate)/sqrt(n()) )

## Joining, by = c("methods", "desc_params", "desc_values")

Get 1SE stats

df_1se = df_perf %>%
  group_by(methods, .metric, me, se) %>%
  summarise() %>%
  mutate(  ymin = me - se
          , ymax = me + se ) %>%
  group_by(.metric) %>%
  mutate( rnk = rank(me, ties.method = 'first')
          , rnk_desc = rank( desc(me), ties.method = 'first')
          ) %>%
  rename( best_method = methods ) %>%
  filter( (rnk == 1 & .metric != 'rsq') | (.metric == 'rsq' & rnk_desc == 1) )

df_1se

## # A tibble: 4 x 8
## # Groups:   .metric [4]
##   best_method .metric      me      se    ymin    ymax   rnk rnk_desc
##   <fct>       <chr>     <dbl>   <dbl>   <dbl>   <dbl> <int>    <int>
## 1 parRF       mae       0.394  0.0149   0.379   0.409     1        6
## 2 parRF       rmse      0.510  0.0221   0.488   0.532     1        6
## 3 parRF       rsq       0.703  0.0372   0.666   0.740     6        1
## 4 lm          mape    167.    32.0    135.    199.        1        6

Plot

len = levels(df_perf$methods) %>%
  length()

col_class = RColorBrewer::brewer.pal('Greys', n = 9) %>% rev()
col_folds = RColorBrewer::brewer.pal('Dark2', n = 8) %>%
  easyalluvial::palette_filter(greens = F, greys = F)

pal = c( col_class[2], col_folds[1:5], col_class[4], col_class[6] )

df_perf %>%
  left_join( select(df_1se, .metric, ymin, ymax, best_method) ) %>%
  mutate( classification = case_when( best_method == methods ~ 'best'
                                      , me >= ymin & me <= ymax ~ 'in'
                                      , T ~ 'out' )
          ) %>%
  ggplot( aes(methods, .estimate) ) +
    geom_rect( aes(ymin = ymin, ymax = ymax )
               , xmin = 0, xmax = len
               , fill = col_class[7]
               , alpha = 0.05 ) +
    geom_line( aes( group = Resample, color = Resample)
               , size = .5, alpha = 1 ) +
    stat_summary( aes( color = classification)
                  , size = 1
                  , fun.data = function(x) mean_se( x, mult = 1) ) +
    scale_color_manual( values = pal ) +
    theme( legend.position = 'none') +
    labs( y = '', x = '', caption = 'grey area: 1SE range of best model'
        , title = 'CV Performance Metrics + SE') +
    facet_wrap(~.metric, scales = 'free_y', ncol = 1)

## Joining, by = ".metric"

Data exploration with alluvial plots - An introduction to easyalluvial

Wed, 31 Oct 2018 00:00:00 +0000

Introduction

Alluvial plots are a form of sankey diagrams that are a great tool for exploring categorical data. They group categorical data into flows that can easily be traced in the diagram. Other than sankey diagrams they are constrained to x-y dimensions, however their graphical grammar is a bit mor complex then that of a regular x-y plot. The ggalluvial package made a great job of translating that grammar into ggplot2 synthax and gives you many option to tweak the appearance of a plot, nevertheless there still remains a multilayered complexity that makes it difficult to use ggalluvial for explorative data analysis. easyalluvial provides a simple interface to this package that allows you to put out a decent alluvial from any dataframe where data is stored in either long or wide format while automatically binning continuous data. It is meant to allow a quick visualisation of entire dataframes similar to the visualisations created by the tabplot package providing different colouring options which give it the flexibility needed for data exploration.

easyalluvial

github repository

Features

plot alluvial graph with a single line of code of a given datafram
support for wide and long data format (wiki, wide vs. long/narrow data)
automatically transforms numerical to categorical data
helper functions for variable selection
convenient parameters for coloring and ordering

Install

# install.packages("devtools")
devtools::install_github("erblast/easyalluvial")

Wide Format

Sample data

suppressPackageStartupMessages( require(easyalluvial) )
suppressPackageStartupMessages( require(tidyverse) )

data_wide = as_tibble(mtcars)
categoricals = c('cyl', 'vs', 'am', 'gear', 'carb')
numericals = c('mpg', 'cyl', 'disp', 'hp', 'drat', 'wt', 'qsec')

data_wide = data_wide %>%
  mutate_at( vars(categoricals), as.factor ) %>%
  mutate( car_id = row_number() )

## Note: Using an external vector in selections is ambiguous.
## ℹ Use `all_of(categoricals)` instead of `categoricals` to silence this message.
## ℹ See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
## This message is displayed once per session.

knitr::kable( head(data_wide) )

mpg	cyl	disp	hp	drat	wt	qsec	vs	am	gear	carb	car_id
21.0	6	160	110	3.90	2.620	16.46	0	1	4	4	1
21.0	6	160	110	3.90	2.875	17.02	0	1	4	4	2
22.8	4	108	93	3.85	2.320	18.61	1	1	4	1	3
21.4	6	258	110	3.08	3.215	19.44	1	0	3	1	4
18.7	8	360	175	3.15	3.440	17.02	0	0	3	2	5
18.1	6	225	105	2.76	3.460	20.22	1	0	3	1	6

alluvial_wide()

Binning of Numerical Variables

This function produces a simple alluvial plot of the given dataframe. Numerical variables are centered, scaled and yeo johnson transformed (transformed to resemble more of a normal distribution) by easyalluvial::manip_bin_numerics(). Outliers as defined by the boxplot criteria ( see documentation for grDevices::boxplot.stats()) are stunted to to the min and max values that are defined by the whiskers of the box plot. The so transformed numeric variables are then cut into 5 (default) equally ranged bins which are lebeled ‘LL’ (low-low), ‘ML’ (medium-low), ‘M’ (medium), ‘MH’ (medium-high), HH (high-high) by default.

alluvial_wide(data_wide
              , bins = 5 # Default
              , bin_labels = c('LL','ML','M','MH','HH') # Default
              , fill_by = 'all_flows'
              )

Alluvial Plot Organisation

Each group of stacked bars represents a variable while the size of each segment represents how many observations in the dataframe belong to that level machting the segment label. The colored flows between the bar stack represent a group of observations that match the value for each variable indicated by the flow. The thickness of the flow indicates how many observations belong to that group.

We see that each flow has more or less the same thickness and the statistical information in the plot caption tells us that we have 30 flows in total for 32 observations in the dataframe. Which means that almost each observation is unique in its combination of variable values.

Reduce the Number of Variables

In order to reduce the compexity we can use a helper function plot_condensation() to get an idea which variables we want to include in our alluvial plot. Lets say we are especially interested in the mpg (miles per gallon) variable and how it relates to the other variables. plot_condensation will look for other variables it can combine mpg with while trying to condense the data frame to a minimum.

plot_condensation(data_wide, first = mpg)

In general we want to condense the dataframe to 50% or less we might get a meaningfull alluvial when looking at mpg, cyl, vs, am in that order.

alluvial_wide( select(data_wide, mpg, cyl, vs, am), fill_by = 'first_variable' )

Reorder Levels

We can see a clear pattern in the flows now, especially now that we have colored the flows by the mpg variable. However some of the flows are unnecessarily criss-crossing. We can improve this by changing the order of the levels of the cyl variable.

alluvial_wide( select(data_wide, mpg, cyl, vs, am)
               , fill_by = 'first_variable'
               , order_levels = c('8','6','4') )

If levels of several variables have levels of the same name we cannot order them individually per variable, this is a design choice (see documentation of alluvial_wide() ). If we want to reorder them we need to assign individual level names first.

p_unordered = alluvial_wide( select(data_wide, mpg, disp, hp)
                              , fill_by = 'first_variable' ) +
  labs( title = 'Unordered', caption = '\n\n' )

bin_labels = c('mpg_LL','mpg_LM','mpg_M','mpg_MH','mpg_HH')

p_ordered = data_wide %>%
  mutate( mpg = manip_bin_numerics(mpg, bin_labels = bin_labels)
          , mpg = fct_rev(mpg) ) %>%
  select( mpg, disp, hp) %>%
  alluvial_wide() +
  labs( title = 'Ordered')

gridExtra::grid.arrange( p_unordered, p_ordered, nrow = 1 )

Long Format

In certain cases we might want to start with a dataframe that is already in long format, this is mostly the case for time-series data where we want to track a categorical value over different time periods.

Sample Data

monthly_flights = nycflights13::flights %>%
  group_by(month, tailnum, origin, dest, carrier) %>%
  summarise() %>%
  group_by( tailnum, origin, dest, carrier) %>%
  count() %>%
  filter( n == 12 ) %>%
  select( - n ) %>%
  left_join( nycflights13::flights ) %>%
  .[complete.cases(.), ] %>%
  ungroup() %>%
  mutate( flight_id = pmap_chr(list(tailnum, origin, dest, carrier), paste )
          , qu = cut(month, 4)) %>%
  group_by(flight_id, carrier, origin, dest, qu ) %>%
  summarise( mean_arr_delay = mean(arr_delay) ) %>%
  ungroup() %>%
  mutate( mean_arr_delay = ifelse( mean_arr_delay < 10, 'on_time', 'late' ) )

## Joining, by = c("tailnum", "origin", "dest", "carrier")

  levels(monthly_flights$qu) = c('Q1', 'Q2', 'Q3', 'Q4')

  data_long = monthly_flights

  
knitr::kable( head( data_long) )

flight_id	carrier	origin	dest	qu	mean_arr_delay
N0EGMQ LGA BNA MQ	MQ	LGA	BNA	Q1	on_time
N0EGMQ LGA BNA MQ	MQ	LGA	BNA	Q2	on_time
N0EGMQ LGA BNA MQ	MQ	LGA	BNA	Q3	on_time
N0EGMQ LGA BNA MQ	MQ	LGA	BNA	Q4	on_time
N11150 EWR MCI EV	EV	EWR	MCI	Q1	late
N11150 EWR MCI EV	EV	EWR	MCI	Q2	late

alluvial_long()

In long format we only need the column that contains the keys (timepoints, Q1, Q2, Q3, Q4) and the values (late, ontime), but we also need a column for the ID (flight_id) because in long format data for one flight is spread over 4 rows and the function needs to know which IDs to group to put into a flow. If ther is implicitly missing data so one flight_id has less than in this case four rows of data (one for each timepoint) it will be made explicit and labelled 'NA'.

col_vector = c('tomato', 'green3')

alluvial_long(data_long
              , key = qu
              , value = mean_arr_delay
              , id = flight_id 
              , fill_by = 'value'
              , col_vector_flow = col_vector
              , col_vector_value = col_vector
              )

We might be more interested which airline carrier had the most late flights, we can add it as an additional variable to the plot and use it for coloring. We can place this variable either on the left or on the right.

p_right = alluvial_long(data_long
              , key = qu
              , value = mean_arr_delay
              , id = flight_id 
              , fill = carrier
              , fill_by = 'last_variable'
              , fill_right = T # Default
              ) +
  labs(title = 'Color fill variable placed to the right')


p_left = alluvial_long(data_long
              , key = qu
              , value = mean_arr_delay
              , id = flight_id 
              , fill = carrier
              , fill_by = 'last_variable'
              , fill_right = F
              ) +
  labs(title = 'Color fill variable placed to the left'
       , caption = '\n\n')


gridExtra::grid.arrange( p_left, p_right, nrow = 1)

Order Levels

alluvial_long() takes three different order_levels_* arguments, one for the keys (x-axis) one for the values (y-axis) and one for the fill variable. Here we want to demonstrate how to order the carrier variable by number of flights.

carriers_ordered_by_count = data_long %>%
  group_by(carrier) %>%
  count() %>%
  arrange( n ) %>%
  .[['carrier']]

alluvial_long(data_long
              , key = qu
              , value = mean_arr_delay
              , id = flight_id 
              , fill = carrier
              , fill_by = 'last_variable'
              , order_levels_fill = carriers_ordered_by_count
              , fill_right = F
              ) +
  labs(title = 'Carriers ordered by number of flights')

General

Missing Data

Explicitly and implicitly missing data will automaticall be labeled as 'NA' and added as a level. The order of that level can be changed like any other. We will automatically generate implicitly missing data if we sample only a fraction of our long format dataframe, because then not every flight_id will have a value (late, on_time) assigned for each time point (Q1, Q2, Q3, Q4). We can replace 'NA' with any other string.

col_vector = c( 'tomato', 'grey', 'green3')

data_na = data_long %>%
  select(flight_id, qu, mean_arr_delay) %>%
  sample_frac(0.9)

alluvial_long(data_na
              , key = qu
              , value = mean_arr_delay
              , id = flight_id
              , fill_by = 'value'
              , NA_label = 'None'
              , col_vector_value = col_vector
              , col_vector_flow = col_vector
              ) +
  labs(title = 'Implicit NA values')

Colors

alluvial_wide() and alluvial_long take any sequence of either HEX code or string color values. easyalluvial offers some convenience functions around constructing qualitative color pallettes for distinct values.

palette_qualitative() %>%
  palette_filter(greys = F) %>%
  palette_plot_rgp()

Connect Flows to observations in original data

We might recognise interesting patterns in the alluvial plot that we want to follow up upon. For example which cars With medium-low mpg and 8 cyl and 0 vs has an am value of 1. Note that we are passing the car_id variable.

p = alluvial_wide( select(data_wide, mpg, cyl, vs, am, car_id)
                   , id = car_id
                   , fill_by = 'first_variable'
                   , order_levels = c('8','6','4') )

p

The plot objects returned by both functions have an attribute called data_key which is an x-y table arranged like the alluvial plot one column containing the original ID. We can use the car_id variable to rejoin the original dataframe.

p$data_key %>%
  filter( mpg == 'ML'
          , cyl == 8
          , vs == 0 
          , am == 1 ) %>%
  # in order to convert factors to integers we have to convert them
  # to character first. Converting from factor returns the order of
  # the factor instead.
  mutate( car_id = as.character(car_id)
          , car_id = as.integer(car_id) ) %>%
  left_join(data_wide, by = 'car_id') %>%
  knitr::kable()

car_id	mpg.x	cyl.x	vs.x	am.x	alluvial_id	n	mpg.y	cyl.y	disp	hp	drat	wt	qsec	vs.y	am.y	gear	carb
29	ML	8	0	1	11	2	15.8	8	351	264	4.22	3.17	14.5	0	1	5	4
31	ML	8	0	1	11	2	15.0	8	301	335	3.54	3.57	14.6	0	1	5	8

ggplot2 manipulations

thanks to ggalluvial the alluvial plots that easyalluvial returns can be manipulated using ggplot2 synthax

p + 
  coord_flip() +
  theme_minimal() +
  ggtitle('look at my minimal flip')

Revisiting jupyter notebooks

Thu, 25 Oct 2018 00:00:00 +0000

There has been a lot of discussion about jupyter notebooks in the online channels I consume and the point of this post is to bring them together.

Coming from R and beeing a heavy user of Rmarkdown files jupyter notebooks felt familiar right away but also a bit awkward. Datacamp made the effort of comparing the to feature by feature in a blog post at the end of 2016. It is a bit out-dated but skimming through it most of it still holds to be true. With some exceptions. of course since there have been some developments on both sides. But more on that later

In the end what we want from both tools are four things:

literate programming, meaning we can have natural language code comments and code output right next to our actual code and have all three components well seperated.
create awesome code-enriched html content
polyglot coding, the division of code in small executable chunks also allows us to run each chunk in a different programming language
comofortable programming, being able to use IDE features, like code completion, visual representation of all variables, data and variable exploration, git-based version control

Both jupyter and Rmarkdown can be used for all these things, however there are some criticism on how jupyter performs in these categories. Most fameously summed up by Joel Grus at jupytercon this year in his presentation and Owain Kenway in ths older blogpost.

To sum this criticism up is that jupyter by design stores its output within the notebook file. The codeoutput can be saved at any time and then code chunks can be executed in any given order. When opening a jupyter notebook, there is no garantuee that execution of all code chunks will again result in the same output. Code output is saved as a binary addition to the underlying json a format that is not compatible with version control tools.

Personally for me this is the reason why I am not using jupyter for programming. Unless I want to create some python-based html content as for this blog for example.

However Brian Granger from project jupyter hase recently been on the dataframed podcast and has talked about his vision of project jupyter. He mentioned to things that stuck with me.

do not use jupyter notebooks use jupyter lab, because jupyter lab is more advanced and makes things better for you on the IDE side.
at netflix they are running thousands of jupyter jobs a day.

So this made me very curious because it sounds like finally there is a well implemented solution to ensuring execution of code chunks in order. So I stumbled across this blog post in which netflix was showing their jupyter system landscape.

This is quite outstanding, especially the tool papermill caught my attention which allows you to pass parameters to notebooks. A feature I was dearly missing from Rmarkdown. The code output of a jupyter notebook run with a fixed set of parameters via papermill is sure to be reproducible. Also it makes jupyter notebooks production compatible so we do not have to copy paste all the notebook code into a .py file and rewrite the whole thing.

On a second note the company nteract also develops hydrogen one of the most popular atom packages. (atom is an open-source text editor which has become my new favourite IDE for python development)

Parametrized reports are a feature that has been around in Rmarkdown for a while, but it might be difficult to set-up a similar R-Spark landscape that works as well as the python-Spark infrastructure.

So I guess purists will probably always feel a bit cranky about jupyter and its json-based file format. But there seems to be a silver lining and we might finally be able to integrate jupyter more sensibly into our workflows.

But still as Brian Granger mentioned on the dataframed podcast there are no best-practice guidelines for jupyter notebooks at the moment and that is something that they are working on.

Polyglot conda environments - 3/3 - jupyter and rpy2

Thu, 30 Aug 2018 00:00:00 +0000

Here we want to show how we can use R and python in the same jupyter notebook.

jupyter notebooks

We first need to create a conda and install R and python and jupyter, then we need to activate that environment and run the jupyter notebook command. When creating a new notebook you will automatically use the active conda environment as a kernel.

For the sake of completeness you can also install the IRkernel and follow the instructions in order to start up a jupyter notebook using a R kernel.

When installing the package nb_conda you will be able to select a conda kernel from all the conda kernels on your system via the jupyter notebook GUI. For mixed environments you can select whether it should be a R or a python notebook. When you want to mix both languages inside one notebook rpy2 will always look for the R installation circumventing jupyter. It is therefore important that you activate the appropriate mixed environment before starting jupyter.

mixing R and python with rpy2

rpy2 allows us to mix R and python code in our jupyter notebook by using the rmagic commands, which are part of the rpy2 package.

First we import the ipython module from rpy2

%load_ext rpy2.ipython

The rpy2.ipython extension is already loaded. To reload it, use:
  %reload_ext rpy2.ipython

We can execute a line of R code using the %R prefix. The last returned variable is treated as cell output

%R X=c(1,4,5,7); sd(X); mean(X)

array([4.25])

I would recommend using conda which allows us to manage python and R packages in the same environment. The following code will check the R version jupyter is using.

%R d = as.data.frame( R.Version() )
%R d = d['version.string']

	version.string
1	R version 3.4.3 (2017-11-30)

We can get variables from the R instance that jupyter is running in the background using the %Rget command as cell output.

%Rget d

	version.string
1	R version 3.4.3 (2017-11-30)

We can pass variables from the python environment into the R environment using %R -i

import pandas as pd
df = pd.DataFrame( dict(a = [1,2,3], b = [4,5,6]) )

%R -i df
%R df_R = df
%Rget df_R

	a	b
0	1	4
1	2	5
2	3	6

Similarily we can pass variables from R back to python using %R -o

%R -o df_R
df_R
print( 'type of imported R object: ' + str( type(df_R) ) )
df_R

type of imported R object: <class 'pandas.core.frame.DataFrame'>

	a	b
0	1	4
1	2	5
2	3	6

We can also define an entire cell as R code using %%R and run complex R code that uses external none-standard R packages. (Note for this code bit to run you need to create a conda environment from one of the .yml files found here).

%%R -o df

require(tidyverse)
require(oetteR)

m = lm(price ~ carat + depth, ggplot2::diamonds)

df = tibble( obs = ggplot2::diamonds$price
           , pred = predict(m, newdata = ggplot2::diamonds) ) %>%
   f_prediction_intervall_raw( 'pred','obs', intervall = 0.975) %>%
   f_prediction_intervall_raw( 'pred','obs', intervall = 0.025)

p = f_plot_pretty_points( dplyr::sample_n(df, 500), 'pred', 'obs' ) +
  geom_ribbon(mapping = aes(ymin = pred_PI2.5_raw
                            , ymax = pred_PI97.5_raw
                            , fill = 'lightsalmon')
              , data = df
              , color = NA
              , fill = 'lightsalmon'
              , alpha = 0.1 ) + 
  geom_line(mapping = aes(x = pred
                          , y = pred_mean_raw
                          )
            , data = df
            , color = 'deepskyblue4'
            #, size = 1
            ) +
  coord_cartesian( xlim=c(0,20000), ylim = c(0,20000))

# reorganize layers
p$layers = list(p$layers[[2]], p$layers[[1]], p$layers[[3]] )

print(df)

# A tibble: 53,940 x 6

     obs  pred steps               pred_PI97.5_raw pred_mean_raw pred_PI2.5_raw

   <int> <dbl> <fctr>                        <dbl>         <dbl>          <dbl>

 1   337  -897 [ -897.30, -368.04)             645           492            338

 2   367  -879 [ -897.30, -368.04)             645           492            338

 3   367  -797 [ -897.30, -368.04)             645           492            338

 4   478  -789 [ -897.30, -368.04)             645           492            338

 5   386  -781 [ -897.30, -368.04)             645           492            338

 6   367  -767 [ -897.30, -368.04)             645           492            338

 7   425  -758 [ -897.30, -368.04)             645           492            338

 8   472  -758 [ -897.30, -368.04)             645           492            338

 9   367  -756 [ -897.30, -368.04)             645           492            338

10   472  -748 [ -897.30, -368.04)             645           492            338

# ... with 53,930 more rows

Plots

We can plot R graphics as follows using %%R -w 5 -h 5 --units in -r 200 which sets the output to 5 x 5 inches with a resoulution of 200 dpi. Note this only works as cell magic not as in-line magic.We are using the ggplot2 plot which we created in the previouse R cell.

%%R -w 3 -h 3 --units in -r 200
p

htmlwidgets

plotly

We can convert ggplot2 plots to plotly objects and save them as html and embedd them in an iframe.

%%R
require(plotly)
pl = ggplotly(p, tooltip = c('~pred_mean_raw', '~pred_PI2.5_raw', '~pred_PI97.5_raw'))
htmlwidgets::saveWidget(pl, 'pred_intervall.html' )

from IPython.display import IFrame

IFrame("./pred_intervall.html"
      , width = 700
      , height = 700)

DT

Similarly to plotly we can embedd dynamic datatables from the DT package

%%R

dt = oetteR::f_datatable_universal( sample_n(df, 500) )
htmlwidgets::saveWidget(dt, 'table.html' )

IFrame("./table.html"
      , width = 1100
      , height = 600)

tabplot

We can use other packages from R to integrate other useful visualisations such as tabplots

%%R -h 5 -w 8 --units in -r 200

require(tabplot)

tableplot( select(ggplot2::diamonds, price, carat, everything()) )

ggalluvial

%%R -h 5 -w 8 --units in -r 200

require(oetteR)

f_plot_alluvial( select(ggplot2::diamonds, price, carat, cut, clarity) )

ggpubr

%%R -h 5 -w 8 --units in -r 200

require(ggpubr)
require(oetteR)

# generates all possible compbinations and removes pairings with P val > thresh
compare = f_plot_generate_comparison_pairs(ggplot2::diamonds, 'price', 'cut', thresh = 0.05) 

ggviolin( data = ggplot2::diamonds
           , x = 'cut'
           , y = 'price'
           , color = 'cut'
           , fill = 'cut'
           , palette = f_plot_col_vector74()
           , add = 'boxplot'
           , add.params = list( fill = 'white')
           ) + 
  stat_compare_means(comparisons = compare, label = "p.signif")

git command line documentation

Wed, 29 Aug 2018 09:55:50 +0200

IDE vs Shell

So far I was not happy with all the IDEs (Rstudio/Gitkraken/Github desktop) that I have tested. They provide some convenient shortcuts but in the end they tended to screw things up for me. That is why I am writing this documentation.

Advantages of IDEs

IDEs are much better at visualizing the branches and the commits. They are also much better for resolving merge conflicts (gitkraken).

Disadvantages of IDEs

You are always missing a functionality that makes you switch to the Shell. It is better to be literate with the shell commands all together to speed up your workflow.

The git repository

The git repository is your project folder, it contains some hidden files and folders that are used by git to track your commits and the branches. If you run git and open your repository you can set the folder to mirror commits or branches. This will actually change the files that you can find with your system explorer.

Introduce yourself

git config --global user.name 'Jennifer Bryan'
git config --global user.email 'jenny@stat.ubc.ca'
git config --global --list

Configure Proxy

git config --global http.proxy http://@173.15.80.153:8080

Setup local git without remote repos and RStudio

start with

git init

setup .gitignore (see instruction further down)

git add .
git commit -m 'message'

Setup local git repository with remote repository

starting with a local repository

Setup a new project using the git option in Rstudio
Create a new git repository on the github webpage

add the remote repository

git remote add origin https://github.com/user/repo.git

verify

git remote -v

first pull

to get README or .gitognore

pull --allow-unrelated-histories

first push

git push --set-upstream origin master

starting with a remote repository

open the directory you want to clone the repository in right click and select git bash here

git clone https://github.com/erblast/oetteR.git

.gitignore

The .gitignore file contains a list of filenames that will be ignored and not and not tracked by git. When you are starting a git project it easy to skip this important file. It is however crucial to set it up before you start coding away. Once you are already deep in the project your workflow will be seriously disturbed when you keep having to do commits for file changes that you cannot control (for example thumbs.db) or have to resolve merge conflicts in outputfiles of your code such as *.pdf and *.html files. You will find that adding filenames to .gitignore that are already tracked will not work. You have to tediously add them manually in your git bash shell.

setting up `.gitignore`

Creating your git project with Rstudio will already add some R/Rstudio files to .gitignore.
Here you can find a useful list of files to be added for R projects.

Creating `.gitignore` from scratch

windows will not let you create files with a file name starting with ‘.’ use the windows command line tool

rename gitignore.txt .gitignore

Untracking files in hindsight

untracking a single file

git rm --cached [file_name]

untracking all files in a directory

git rm --cached inst/\*

untrack all files of a certain type

git rm -r --cached **/*.html

Navigating in the shell

switch between branches remember you create them only in the remote/origin repository

git checkout branch

what’s going on? Carefull the status is not always up to date. It seems to not check if the branch was updated from somewhere else than the current computer. It hapenned several times that the reply to the command implied that the current branch is up-to-date with the origin branch but then a pull command would still retrieve changes.

git status

Pull

Pull all
this would be nice to have but it DOES NOT WORK, it fetches from all branches but MERGES ONLY THE ACTIVE BRANCH.

git pull --all

pull active branch

git pull

pull and rebase
If you expect changes in you remote repository for your active branch (if your working on a collaborative project), you can rebase before/while pulling.

git pull --rebase

see http://kernowsoul.com/blog/2012/06/20/4-ways-to-avoid-merge-commits-in-git/, for setting this up permanently

commit

Use git status to see a if there are any changes to commit. Commit as often as you like, give resonable namings to you commits. A commit will not work if you do not supply a commit message. Git will let you rollback to any commit you made. Always use the -m "text" operator when calling git commit, otherwise you will end up will display confusing commit screen.

git commit -m "enter message here"

if you see the confusing commit screen

you forgot to type -m "text"

**hit ESC **

:wq

Undo commits, reset

Opt1: roll back to remote branch version

git reset --hard origin/workbranch

soft and hard parameter determines whether to keep the changes or not

~1 determines how many commits to go back in time

Opt2: undo last commit keep all changes

git reset --soft HEAD~1

Opt3: undo last commit discard all changes

git reset --hard HEAD~1

**Opt4: go back to specific commit **

git reset --hard 904jfd40f

Should I amend to previous commits?

No, dont do it. This only work if you have not pushed after your previous commit. If you have pushed you possibly get a merge conflict between origin and the local repository because the two commits are different. You can however fix this by rebasing the remote branch.

git rebase origin/master

Push

Push local commits to remote

git push

Overwrite remote version

git push origin branch_name -f

Rebase

rebase to update your work branch from master DO NOT FORGET MASTER in the command. Your branch will not fully merge and stuff will be missing and you will get merge conflicts. rebase active branch

git rebase master

Merge

Merging can be the most annoying part of using git, I tend to have merge conflicts all the time and they are annoying to resolve. I will have an extra section on this further down.

merge branch into master

git checkout master
git merge work_branch

Merge conflicts

Those are tedious to resolve and eat up time that could better be spent coding. If you have them use git status to see whats wrong. Open the files with an editor and find the highlighted conflicting code and edit it. (remove the highlights inserted by git and keep the code that is correct). If there is an delete you can either add git add filename or remove (git rm filename). I think it is best to use this manual approach for a while and develope a disciplined git workflow that makes you avoid these all together. Then when you think you got it right switch to gitkraken to handle your merge conflicts.

Restore old commit versions

Checkout commit history of a certain branch

git log master

git revert 2342jk23l4jl2hg23k4j2h34

Managing branches

Create branch


git checkout -b [name_of_your_new_branch]

Delete branch


git branch -d [name_of_your_new_branch]

Accidently worked on the wrong branch

Sometimes you want to commit your changes and realize that you were working in master instead of your release or feature branch

git stash
git checkout branch123
git stash apply

Versioning

Your master branch should always be the branch carrying the latest stable version. Branching off master you have a release branch which carries the newest developments. From this you branch off the other branches working on different aspects of the next release. Once the release branch is stable it can be merged with master

Remove files from the history

Sometimes you might need to remove files from prior commits, either you carelessly commited large binary files which are bloating up your history, or some of the history contains sensitive information like passwords.

If you did not push to remote try undoing the commit using git reset --soft

This is an incredible hard thing to do. You will find lots of online ressources the most common being a command called filter-branch. However removing files from git like this is a bit like rying to uninstall a program by removing the run.exe from the installation folder. There will be a lot of clutter and references which will not be removed. I recommend the following in this case.

remove the files you want to remove from your current branch
create an on-disk copy of your repository
delete your branch locally and from the remote
create a new branch
restore your branch by copying all files from your on-disk copy
commit all changes
push to remote

You cannot remove files from the master branch like this. Either if you do not need the history start a new repo, or figure out the filter-branch command. This however needs some deeper knowledge on how git acutally works.

Submodules

SUbmodules are great if you need to include code from another repository into your current repository that should be kept up to date.

git submodule add repo_adress
git submodule init
git submodule update
cd submodule
git checkout v1.0

Remove Submodules

If you dump another git repository into your currrent git repository because you might want to merge the two. Git will create a submodule that persits even if you delete all the git files from the repo that you want to fuze.

git rm --cached submodule_path # delete reference to submodule HEAD (no trailing slash)
git rm .gitmodules             # if you have more than one submodules,
                               # you need to edit this file instead of deleting!
rm -rf submodule_path/.git     # make sure you have backup!!
git add submodule_path         # will add files instead of commit reference
git commit -m "remove submodule"

Release Tags

It is good practice to add a release tag after bumping up the version of your repository. It is the easiest to to this via the github website interface. However if you made a mistake and want to remove your current release because you made a typo github will not remove your release tag entirely but simply mark it as deleted which prevents you from creating a new tag with the same name. Thus we can use the following console command to delete it completely (source).

# delete local tag '12345'
git tag -d 12345
# delete remote tag '12345' (eg, GitHub version too)
git push origin :refs/tags/12345

Polyglot conda environments - 2/3 - command line documentation

Wed, 29 Aug 2018 00:00:00 +0000

Managing conda environments

conda navigator GUI

after installing the anaconda distribution you can run the navigator app, which allows you to create environments and manage the installed packages. As always with these tools some commands will only work in the command line.

Command Line

condensated version of official documentation

conda cheat sheet

Check installation

conda --version

Create an environment

that contains python and R, we are specifiying r-base because conda will install the microsoft R distribution by default.

conda create --name myenv python=3.6 r-base=3.4.3

Activate environment

will add your environment to your command line

conda activate myenv

on older versions of conda will add your environment to your command line

source activate myenv

Deactivate environment

will remove your environment from your command line

conda deactivate

Remove an environment

conda env remove --name myenv

Install packages and apps

Install MacOS SDK

anaconda not only contains packages but also apps and other programs. It also contains a set of compilers. For licensing reasons the MacOS SDK cannot be included and needs to be installed seperately as explained here. MacOS SDK can be downloaded here I suggest to download the version that matches the version number of your installed macOS.

Add the following code to your conda_build_config.yaml in your HOME directory (create new file if not present).

CONDA_BUILD_SYSROOT:
  - /opt/MacOSX10.13.sdk        # [osx]

Channels

An important issue for anaconda are the channels where we can find tha packages that we want to install in our anaconda environments. Each environment contains a list of channels which will be searched from top to bottom for a package that we would like to install. anaconda will always prioritize the channel over the version number thus might not always install the latest versions. Each environment starts with the channel defaults which are the official channels

Add a channel to the bottom of the list

You want to make sure that the defaults channels rank high thus I recommend appending all new channels.

conda config --append channels conda-forge bioconductor

Add a channel to the top of the list

here you want to add your own channel containing your anaconda builds.

conda config --prepend channels anaconda_username

Install packages without build/compilation

make sure the environment that you want to install to is active

we can install apps such as Rstudio, pip, etc (see anaconda launcher with the same synthax)

do not use R; install.packages(), packages installed that way cannot be tracked

Install from listed channel

conda install package_name

Install from pip (python packages)

conda install pip
pip install package_name
pip install git+repos_url

Install packages with build/compilation (R packages)

This will be mostly required for R packages that cannot be found on anaconda ressources which unfortunately is true for most of the packages. Managing your R packages with anaconda takes a long time to set up if you already start with a large set of package requirements and can be efficient if you gradually build it up as you go. However you will not be cross platform compatible. You will have to more or less go through the same iterative steps on each platform you want to be compatible with. The reason is that R packages containing C++ or Fortran code need different compilers depending on the operating system that you use. Some of these compilers are not referenced directly but they reference to another R package which is at the base of the dependency trail. There is the option of converting you package builds compiled on one platform to another which will work for the majority of the packages but not for all.

Workflow outline for creating an `R` environment

create an anaconda account where you will upload your packages to
enable automatic uploading after package building
create an environment inlcuding python, R, and r-essentials.
add personal R channel to the top of you channels list
add bioconductor and conda-forge to the end of your channels list
identify a package that you want to add to your environment which is not available from an anaconda source
download a skeleton from CRAN
build/compile the package
- anaconda will create test environment in which the package will be built based on the requirements saved in the skeleton. For R packages it will only detect dependencies in the DESCRIPTION file.
- anaconda will look for the required packages in the channels and try to install whatever it finds. It will list all packages and sources it will install from. If it cannot find the necessary packages it will fail.
- anaconda might raise a dependency conflict remove the package you suspect to be the oldest and skeleton/build install again.
Troubleshoot if compiling/building fails
- Try to skim the error message for the incompatible package, however the error message is not always meaningful
- R Packages from conda-forge and bioconductor are likely to be outdated get them from CRAN as skeleton instead
- R packages have the R version that they were compiled for attached to the version number. Check if that matches the r-base version of your environment
- Packages that come from you own repository but have initially been built for another platform and contain C++ or Fortran code must likely be rebuilt from skeleton for your present platform.
If building/compilation was successfull the package will be uploaded to our anaconda repository from where it can be installed
repeat those steps until all packages have been successfully installed
if you can run some test code, download the source code with the highest number of dependencies and run the inlcuded test.
export an yml file and try to recreate the environment from it.
Consider to repeat this process for the other platorms as well if you want your code to be completely portable

This process is very tedious however it will always work once you identify the incompatibilities

List of R packages that contain `C++` or `fortran` and are not part of r-essentials

fastmatch
ff
ffbase
bit
spam
maps
dotcall64
fields
spam
mda
party
cubist
kknn
gamlss
rlang (part of r-essentials but better to install the newest version)

create the account on anaconda.org

anaconda login
conda config --set anaconda_upload yes
# anaconda logout

Download skeleton form CRAN/github

github release tags

anaconda will automatically checkout out the master branch with the latest release tag of packages from github. Often repository owners do not assign release tags or only if a major version increment has been made. Therefore it is best to fork the repository to a personal public github account and then apply any missing release tags.

github dependencies

R packages from github do not have to pass any quality checks as they need to for being uploaded to CRAN. Therefore it can happen that not all dependencies from the NAMESPACE file are also listed in the DESCRIPTION file. In such a case the testing environment for creating a conda build will not be sufficient.

conda skeleton cran rlang
conda skeleton cran https://github.com/erblast/ggplot2.git

Build packages from skeleton

we have to ad a r- prefix to the package name and put the package name in lowercase the build are R-version specific so it is best to specify it in the command.

conda build r-rlang --R 3.5.1

Check package installations

conda list -name myenv pandas

Exporting an environment to .yml

activate the environment that you want to export. It will save a .yml file into the current working directory

conda env export -f myenv.yml

Build environment based on .yml file

conda env create -f environment.yml

Clone an existing environment

conda create --name myclone --clone myenv

Convert packages to other formats on linux

This did only work for me when trying to convert from OS-64 to linux-64 for packages that did not need compilation.

Change to your conda-bld directory in the shell

for f in *.bz2; do conda convert -f --platform linux-64 -o .. $f; done

Polyglot conda environments - 1/3 - Introduction

Tue, 28 Aug 2018 00:00:00 +0000

In this series of posts we want to show how we can use conda environments for polyglot data science projects that use both R and python.

Polyglot Environments

Polyglot environments are basically environments that use more than one programming language. For data science R and python are the most popular programming languages and most projects decide on either using one or the other. Why should we shoulder the extra effort of using R and python on the same project? Well there could be plenty of reasons:

Inclusiveness, you can include new team members that come from the other language more quickly.
Reusability, if you already have solved similar problems in the other language you can reuse the code.
Capability, you increase the number of tools and packages that you can use for your project.

Your typical data science environment does not only include the code that you write but also the software that is installed on you computer including the operating system as well as the hardware it is running on. Typically it also consists of a data interface through which your data is loaded onto your system and a reporting interface that communicates the results of your analysis.

In fact most data projects are already openly polyglot because they include SQL code to call data from database via the data interface (the database drivers). But even if they are not underneath the hood the interfaces and the packages you have installed will be using a variety of other programming languages so technically the primary language that you chose for you data project is primarily glue code for all the other languages that you are implicitly using.

Both R and python make it easy for you to put your code in packages and to add documentation and unittests. So using a second language can basically be seen as using yet another package. Simply put the code of the secondary language into functional units that in the end require minimal, easily readable code when called. Add some tests and documentation so also team members that are inexperienced in the secondary language can understand, use and trust its code.

Reproducibilty

Reproducibility is a challenge for each data science project. As illustrated before data science environments are not isolated entities that run independently by themselves but they are often connected to other systems from where they gather there data and to which they transmit their results to. Therefore a variety of dependencies exist that are needed for the code to run properly.

Dependencies

Code dependencies

These are the obvious dependencies which are easily avoided by adhering to good coding practices.

file paths
random numbers or randomized code outcome

Software dependencies

A typical data science project can depend on a number of installations on your machine. To name a few of them

R *
R packages *
python *
python packages *
pip
git
Java
a C++ compiler
pandoc
latex
phantom js
database drivers

The most important being R and python and the underlying packages which usually shoulder the workload of your code.

System/Hardware dependencies

Then there is you machine in itself which has a specific get up:

OS (32bit, 64bit)
environment variable
Hardware (number of cores, RAM, GPU)

Connectivity dependencies

Data interface (database drivers, clients to connect to Big Data infrastructure, REST API calls)
Output interface (html reports, BI tools, git commit and push)

Strategies

Programming language-based solutions

There are a number of strategies to reproducibly preserve either your python or your R installation. For R there is packrat and checkpoint and for python there is the pip freeze command, which preserves all packages and version in a requirements.txt file.

However these solutions are focused on snapshotting the programming language installation and do not consider any of the other tools and system configurations that might be necessary to run your code.

Environment-based solutions (anaconda/conda)

conda environments use a bit of a more holistic approach and strive to encapsulate apps and programming languages including the packages. They provide a strategy for handling R and python simultaneously and they have a set of packages for which they offer their own support for. Meaning you can download the packages from a conda server and they are garanteed to be compatible with each other as long as they are being installed at the same time. However the conda environments are not garanteed to be platform independent. The list of supported packages depends on the OS. However anaconda will make an effort to replicate the environment as closely as possible.

Container-based solutions

The state of the art solution is a docker container, which containerizes everything (tools, drivers, environment variables, etc), this eases pushing code into procuction as explained here. There are even solutions for systems with specialized hardware configurations such as GPUs, as explained here

conda environments

conda environments are very popular among python users. python packages are distributed on Pypi and are uncompiled, thus installing the most common datascience packages can be quite tricky because there are a lot of things that can go wrong when compiling code. conda allows you to create different environments on your hard drive that are independent from each other and into which all kind of software can be installed and it is not limited to python. For software to be installed into a conda environments it needs to be available as a precompiled conda build for the OS at hand on one of the official conda servers. Before installing the new software conda will check whether all dependencies of the new package are already installed or available on the conda servers. It will also check whether there might a dependency conflict with software that is already installed. If all software that needed is available through conda sources the environment can easily be recreated on another system with the same operating system by simply exporting a list of all the software that is installed.

python packages

If python packages cannot be found on conda servers they can simply be installed via pip when called from within the activated conda environment. conda will use its internal compiler if the package needs compilation. This is a bit risky because the compilation step might not be as easily reproducible on another system.

R packages

We can install R packages if there are not available from conda sources by making our own conda builds. conda will create a build recipe based upon the information it finds on CRAN and then will use the internal compiler to create a conda build which then can be uploaded to a conda server from which it can be retrieved and installed. This is a bit tedious because for this to work we need to have already preinstalled all dependencies for a given packages. Thus we need to find the packages with no or few dependencies and work our way up. It might be frustrating to start this process but it will almost always work. You can find detailed instructions in the next post.

Moving from R to python - 7/7 - automated machine learning

Mon, 27 Aug 2018 00:00:00 +0000

Automated Machine Learning

We have seen in the previous post on advanced scikitlearn methods that using pipes in scikitlearn allows us to write pretty generalizable code, however we still need to customize our modelling pipeline to the algorithms that we want to use. However theoretically since scikitlearn uses a unified synthax there is no reason why we should not try all the modelling algorithms supported by scikitlearn. We can also combine the modelling algorithm with various feature selection and preprocessing steps. The first limiting factor is that theoretically we need to define the hyperparameter space that is being searched for each model even if we are using randomized search. Which requires some manual coding the second limiting factor is computational power it will simply take a very long time to go through all possible combinations of pipes that we could build.

Packages for automated machine learning have taken care of the manual work we would need to do to program the hyperparameter search and mitigate the problem of computational power by employing specific search strategies that allow us to preselect pipes that are likely to succeed and optimise hyperparameter search in a way that we do not have to test every single combinations.

`tpot`

tpot is a data science assistant that iteratively constructs sklearn pipelines and optimises them using genetic programming algorithms that are able to optimize multiple criteria simulaneously while minimizing complexity at the same time. It uses a package called deap

Supports regression and classification
Supports the usual performance metrics
Is meant to run for hours to days
We can inspect the process anytime and look at intermediate results
We can limit algorithms and hyperparameter space (not so usefull at the moment because we have to sepcifiy the whole pyrameter range and basically get stuck doing grid search)
tpot can generate python code to reconstruct the best models

Load data

We have prepared the data that we are going to use in the previous post on advanced scikitlearn methods. It is basically the titanic dataset with imputed numerical and categorical variables.

import feather

df = feather.read_dataframe('./data/mapped_df.feather')

y = df['y']
X = df.drop('y', axis = 1)\
 .as_matrix()

C:\anaconda\envs\py36r343\lib\site-packages\ipykernel\__main__.py:6: FutureWarning: Method .as_matrix will be removed in a future version. Use .values instead.

Run

We are using a limited version of tpot which uses only fast algorithms

from tpot import TPOTClassifier

pipeline_optimizer = TPOTClassifier(generations=2
                                    , population_size=2
                                    , offspring_size = 5
                                    ## TPOT will evaluate population_size 
                                    ## + generations × offspring_size = pipelines 
                                    ## in total.
                                    , cv=5
                                    , random_state=42 ##seed
                                    , verbosity=2 ## print progressbar
                                    , n_jobs = 4
                                    , warm_start = True ## allows us to restart
                                    , scoring = 'roc_auc'
                                    , config_dict = 'TPOT light' ## only uses fast algorithms
                                   )

pipeline_optimizer.fit(X,y)

HBox(children=(IntProgress(value=0, description='Optimization Progress', max=12), HTML(value='')))


Generation 1 - Current best internal CV score: 0.8616010162631975
Generation 2 - Current best internal CV score: 0.8628532835333793

Best pipeline: LogisticRegression(Normalizer(input_matrix, norm=l1), C=20.0, dual=False, penalty=l1)





TPOTClassifier(config_dict='TPOT light', crossover_rate=0.1, cv=5,
        disable_update_check=False, early_stop=None, generations=2,
        max_eval_time_mins=5, max_time_mins=None, memory=None,
        mutation_rate=0.9, n_jobs=4, offspring_size=5,
        periodic_checkpoint_folder=None, population_size=2,
        random_state=42, scoring='roc_auc', subsample=1.0, use_dask=False,
        verbosity=2, warm_start=True)

pipeline_optimizer.score(X,y)

0.8745406320902439

Export best modelling pipeline as python code

pipeline_optimizer.export('./data/pipe.py')

True

Get the best pipe

pipeline_optimizer.fitted_pipeline_

Pipeline(memory=None,
     steps=[('normalizer', Normalizer(copy=True, norm='l1')), ('logisticregression', LogisticRegression(C=20.0, class_weight=None, dual=False, fit_intercept=True,
          intercept_scaling=1, max_iter=100, multi_class='ovr', n_jobs=1,
          penalty='l1', random_state=None, solver='liblinear', tol=0.0001,
          verbose=0, warm_start=False))])

Get all tested pipes

pipeline_optimizer.evaluated_individuals_

{'DecisionTreeClassifier(input_matrix, DecisionTreeClassifier__criterion=entropy, DecisionTreeClassifier__max_depth=2, DecisionTreeClassifier__min_samples_leaf=12, DecisionTreeClassifier__min_samples_split=4)': {'crossover_count': 0,
  'generation': 'INVALID',
  'internal_cv_score': 0.8557279030479364,
  'mutation_count': 2,
  'operator_count': 1,
  'predecessor': ('DecisionTreeClassifier(input_matrix, DecisionTreeClassifier__criterion=entropy, DecisionTreeClassifier__max_depth=3, DecisionTreeClassifier__min_samples_leaf=12, DecisionTreeClassifier__min_samples_split=4)',)},
 'DecisionTreeClassifier(input_matrix, DecisionTreeClassifier__criterion=entropy, DecisionTreeClassifier__max_depth=3, DecisionTreeClassifier__min_samples_leaf=12, DecisionTreeClassifier__min_samples_split=4)': {'crossover_count': 0,
  'generation': 'INVALID',
  'internal_cv_score': 0.8616010162631975,
  'mutation_count': 1,
  'operator_count': 1,
  'predecessor': ('GaussianNB(input_matrix)',)},
 'GaussianNB(input_matrix)': {'crossover_count': 0,
  'generation': 0,
  'internal_cv_score': 0.816504621285001,
  'mutation_count': 0,
  'operator_count': 1,
  'predecessor': ('ROOT',)},
 'KNeighborsClassifier(BernoulliNB(input_matrix, BernoulliNB__alpha=10.0, BernoulliNB__fit_prior=True), KNeighborsClassifier__n_neighbors=21, KNeighborsClassifier__p=1, KNeighborsClassifier__weights=distance)': {'crossover_count': 0,
  'generation': 'INVALID',
  'internal_cv_score': 0.8499987059406567,
  'mutation_count': 1,
  'operator_count': 2,
  'predecessor': ('KNeighborsClassifier(input_matrix, KNeighborsClassifier__n_neighbors=21, KNeighborsClassifier__p=1, KNeighborsClassifier__weights=distance)',)},
 'KNeighborsClassifier(BernoulliNB(input_matrix, BernoulliNB__alpha=100.0, BernoulliNB__fit_prior=True), KNeighborsClassifier__n_neighbors=21, KNeighborsClassifier__p=1, KNeighborsClassifier__weights=distance)': {'crossover_count': 0,
  'generation': 'INVALID',
  'internal_cv_score': 0.8484891857167135,
  'mutation_count': 1,
  'operator_count': 2,
  'predecessor': ('KNeighborsClassifier(input_matrix, KNeighborsClassifier__n_neighbors=21, KNeighborsClassifier__p=1, KNeighborsClassifier__weights=distance)',)},
 'KNeighborsClassifier(input_matrix, KNeighborsClassifier__n_neighbors=21, KNeighborsClassifier__p=1, KNeighborsClassifier__weights=distance)': {'crossover_count': 0,
  'generation': 0,
  'internal_cv_score': 0.8470927552585381,
  'mutation_count': 0,
  'operator_count': 1,
  'predecessor': ('ROOT',)},
 'KNeighborsClassifier(input_matrix, KNeighborsClassifier__n_neighbors=22, KNeighborsClassifier__p=1, KNeighborsClassifier__weights=distance)': {'crossover_count': 0,
  'generation': 'INVALID',
  'internal_cv_score': 0.846680654239431,
  'mutation_count': 1,
  'operator_count': 1,
  'predecessor': ('KNeighborsClassifier(input_matrix, KNeighborsClassifier__n_neighbors=21, KNeighborsClassifier__p=1, KNeighborsClassifier__weights=distance)',)},
 'LogisticRegression(MinMaxScaler(input_matrix), LogisticRegression__C=20.0, LogisticRegression__dual=False, LogisticRegression__penalty=l1)': {'crossover_count': 0,
  'generation': 'INVALID',
  'internal_cv_score': 0.8584054700315054,
  'mutation_count': 2,
  'operator_count': 2,
  'predecessor': ('LogisticRegression(input_matrix, LogisticRegression__C=20.0, LogisticRegression__dual=False, LogisticRegression__penalty=l1)',)},
 'LogisticRegression(Normalizer(input_matrix, Normalizer__norm=l1), LogisticRegression__C=20.0, LogisticRegression__dual=False, LogisticRegression__penalty=l1)': {'crossover_count': 0,
  'generation': 'INVALID',
  'internal_cv_score': 0.8628532835333793,
  'mutation_count': 2,
  'operator_count': 2,
  'predecessor': ('LogisticRegression(input_matrix, LogisticRegression__C=20.0, LogisticRegression__dual=False, LogisticRegression__penalty=l1)',)},
 'LogisticRegression(input_matrix, LogisticRegression__C=20.0, LogisticRegression__dual=False, LogisticRegression__penalty=l1)': {'crossover_count': 0,
  'generation': 'INVALID',
  'internal_cv_score': 0.8584323502037432,
  'mutation_count': 1,
  'operator_count': 1,
  'predecessor': ('GaussianNB(input_matrix)',)},
 'LogisticRegression(input_matrix, LogisticRegression__C=20.0, LogisticRegression__dual=False, LogisticRegression__penalty=l2)': {'crossover_count': 0,
  'generation': 'INVALID',
  'internal_cv_score': 0.8586414616613588,
  'mutation_count': 2,
  'operator_count': 1,
  'predecessor': ('LogisticRegression(input_matrix, LogisticRegression__C=20.0, LogisticRegression__dual=False, LogisticRegression__penalty=l1)',)}}

`auto-sklearn`

auto-skelarn uses bayesian methods to optimize computing time. We will add an example in a later version of this post

Summary

Even though auto-sklearn still needs to be tested we could already obtain pretty decent results using tpot with a ROC score of 0.87 which is higher then our previous attempts. Normally I would follow the following strategy to select a model.

Test all models on the same cv pairs
Calculate mean and SEM for the performance metric of each variant
Look at the model with the lowest mean
Select the simplest model whose mean is still in the range of the overall lowest mean + SEM

However tpot does not give us the SEM values thus we cannot select the model which it presents us to be the best and compare it to simpler ones it might have fitted. Given that the tpot algorithm is already minimizing the complexity we should simply accept the best model it returns. We should however then compare it to simpler models we can come up with to have a frame of reference to compare it to and of course we should check the tpot model for plausibility.

Moving from R to python - 6/7 - advanced scikitlearn

Sun, 26 Aug 2018 00:00:00 +0000

Advanced scikitlearn

In the last post, we have seen some advantages of scikitlearn. Most notably the seamless integration of parallel processing. I was struggeling a bit with the fact that scikitlearn only accepts numpy arrays as input and I was missing the recipes package which makes initial data transformation in R so much easier. Then I stumbled upon sklearn-pandas which seamlessly integrates pandas with sklearn without having to worry about numpy arrays and it supports a pipe based workflow, which is a sklearn feaure I have not started to explore yet.

Apart from sklearn-pandas there are a number of projects that use the synthax and structure of scikit learn, a collection of them can be found at

-http://contrib.scikit-learn.org/imbalanced-learn/stable/index.html

-http://scikit-learn.org/stable/related_projects.html

`sklearn-pandas`

github

Core of this package is the DataFrameMapper class which maps scikit learn Transformer classes to specific columns of a dataframe and outputs either a numpy array or dataframe.

Additionally it provides a CategoricalImputer which accepts categorical data, which I had to write myself before in the last post.

import seaborn as sns
import numpy as np
import pandas as pd
import sklearn

from sklearn_pandas import DataFrameMapper, CategoricalImputer, gen_features

df = sns.load_dataset('titanic')

X = df.copy().drop(['alive','survived'], axis = 'columns')
y = df.survived

# we need to set up transformations for numerical and categorical columns
col_categorical = list( X.select_dtypes(exclude=np.number) )
col_numerical   = list( X.select_dtypes(include=np.number) )

#we need to convert to list of lists
col_categorical = [ [x] for x in col_categorical ]
col_numerical   = [ [x] for x in col_numerical ]

# we have two ways of passing the classes as a simple list or as list of dicts if we need to pass
# arguments as well
classes_categorical = [ CategoricalImputer, sklearn.preprocessing.LabelBinarizer ]
classes_numerical = [ {'class':sklearn.preprocessing.Imputer, 'strategy' : 'median'}
                    , sklearn.preprocessing.StandardScaler
                    ]

# now that we have defined the columns and the classes of transformers we can use gen_features
# in order to generate a list of tuples suitable for DataFrameMapper

feature_def = gen_features(
    columns = col_categorical
    , classes = classes_categorical
)

feature_def_numerical = gen_features(
    columns = col_numerical
    , classes = classes_numerical
)

feature_def.extend(feature_def_numerical)

# when constructing the mapper we can specify whether we want a dataframe or a numpy array as output

mapper_df = DataFrameMapper( feature_def , df_out = True )

mapper_np = DataFrameMapper( feature_def , df_out = False )

mapped_df = mapper_df.fit_transform( df.copy() )

mapped_np = mapper_np.fit_transform( df.copy() )

print( mapped_np[1:10,1:20] )

mapped_df.head(10)

[[1. 0. 0. 1. 0. 0. 0. 0. 1. 0. 0. 0. 1. 0. 0. 0. 0. 1. 0.]
 [0. 0. 1. 0. 0. 1. 0. 0. 1. 0. 0. 0. 1. 0. 0. 0. 0. 0. 0.]
 [0. 0. 1. 1. 0. 0. 0. 0. 1. 0. 0. 0. 1. 0. 0. 0. 0. 0. 0.]
 [0. 0. 1. 0. 0. 1. 0. 1. 0. 1. 0. 0. 1. 0. 0. 0. 0. 0. 0.]
 [0. 1. 0. 0. 0. 1. 0. 1. 0. 1. 0. 0. 1. 0. 0. 0. 0. 0. 1.]
 [0. 0. 1. 1. 0. 0. 0. 1. 0. 1. 0. 0. 0. 0. 1. 0. 0. 0. 0.]
 [0. 0. 1. 0. 0. 1. 1. 0. 0. 0. 0. 0. 1. 0. 0. 0. 0. 0. 0.]
 [0. 0. 1. 0. 0. 1. 0. 0. 1. 0. 0. 0. 1. 0. 0. 0. 0. 0. 0.]
 [1. 0. 0. 0. 1. 0. 1. 0. 0. 0. 0. 0. 1. 0. 0. 0. 0. 1. 0.]]

	sex	embarked_C	embarked_Q	embarked_S	class_First	class_Second	class_Third	who_child	who_man	who_woman	...	embark_town_Cherbourg	embark_town_Queenstown	embark_town_Southampton	alone	pclass	age	sibsp	parch	fare
0	1.0	0.0	0.0	1.0	0.0	0.0	1.0	0.0	1.0	0.0	...	0.0	0.0	1.0	0.0	0.827377	-0.565736	0.432793	-0.473674	-0.502445
1	0.0	1.0	0.0	0.0	1.0	0.0	0.0	0.0	0.0	1.0	...	1.0	0.0	0.0	0.0	-1.566107	0.663861	0.432793	-0.473674	0.786845
2	0.0	0.0	0.0	1.0	0.0	0.0	1.0	0.0	0.0	1.0	...	0.0	0.0	1.0	1.0	0.827377	-0.258337	-0.474545	-0.473674	-0.488854
3	0.0	0.0	0.0	1.0	1.0	0.0	0.0	0.0	0.0	1.0	...	0.0	0.0	1.0	0.0	-1.566107	0.433312	0.432793	-0.473674	0.420730
4	1.0	0.0	0.0	1.0	0.0	0.0	1.0	0.0	1.0	0.0	...	0.0	0.0	1.0	1.0	0.827377	0.433312	-0.474545	-0.473674	-0.486337
5	1.0	0.0	1.0	0.0	0.0	0.0	1.0	0.0	1.0	0.0	...	0.0	1.0	0.0	1.0	0.827377	-0.104637	-0.474545	-0.473674	-0.478116
6	1.0	0.0	0.0	1.0	1.0	0.0	0.0	0.0	1.0	0.0	...	0.0	0.0	1.0	1.0	-1.566107	1.893459	-0.474545	-0.473674	0.395814
7	1.0	0.0	0.0	1.0	0.0	0.0	1.0	1.0	0.0	0.0	...	0.0	0.0	1.0	0.0	0.827377	-2.102733	2.247470	0.767630	-0.224083
8	0.0	0.0	0.0	1.0	0.0	0.0	1.0	0.0	0.0	1.0	...	0.0	0.0	1.0	0.0	0.827377	-0.181487	-0.474545	2.008933	-0.424256
9	0.0	1.0	0.0	0.0	0.0	1.0	0.0	1.0	0.0	0.0	...	1.0	0.0	0.0	0.0	-0.369365	-1.180535	0.432793	-0.473674	-0.042956

10 rows × 27 columns

the results are looking really good, its almost as good as recipes. However if we wanted to apply a boxcox transformation on top of it we would have to write our own scikit-learn like transformer. However the transformer will be added in a future version so I would not bother with that at the moment.

To sparse or not to sparse

In the python data world data is considered to be sparse or dense. Which adresses the number of zeros in a matrix wiki. sparse means that you have a lot of them while dense means the opposite. There is no particular threshold but we should be aware that some data transformatios like dummy encoding make our data more sparse. A sparse matrix can be stored in a more memory efficient format such similar as a compressed image file and some algorithms can computationally leaverage this format to reduce computing time. lasso and boosting gradient style algorithms seem to be able to profit from the sparse data format while others neural nets, knn do not, and some like randomForest require the regular dense format and will otherwise raise an error. We can use SciPy to transform matrices to a dense format. We can measure the sparcity ratio as follows## Sparcity ratio

Sparcity Ratio

def sparsity_ratio(X):
    return 1.0 - np.count_nonzero(X) / float(X.shape[0] * X.shape[1])

print('sparcity ratio original data:', round( sparsity_ratio(X), 2) )
print('sparcity ratio tranformed data:', round( sparsity_ratio(mapped_np), 2) )

sparcity ratio original data: 0.17
sparcity ratio tranformed data: 0.56

The transformation have resulted in a matrix with a high sparcity thus we will test whether we might benefit from converting to a sparse matrix format

from scipy import sparse
from time import time
from sklearn.tree import DecisionTreeClassifier


X_sparse = sparse.coo_matrix(mapped_np)

clf_sparse = DecisionTreeClassifier()
clf_dense = DecisionTreeClassifier()

t0 = time()
clf_sparse.fit(X_sparse, y)
print('exec time sparse:', round( time() - t0,3 ) )


t0 = time()
clf_dense.fit(mapped_np, y)
print('exec time dense :', round( time() - t0,3 ) )

exec time sparse: 0.019
exec time dense : 0.008

We can see that our decision tree classifiert does not benefit from a sparse data format.

Pipelines

Pipelines are constructs that chain scikit preprocessing steps together and attaching an optional classifier or a regressor to the end.

We can then use the pipe as we would use a regular model we can fit it and get predictions, we could get crossvalidated performance scores or perform parameter tuning. This has a couple of advantages.

The code becomes more compact and readable
Instead of saving multiple transformers (scaling, boxcox ) we can simply store one to apply to future data
We can tune several steps of the pipeline in one go (for example feature selector + model tuning parameters)

We are going to contruct two pipes one for preprocessing and one for model fitting. It makes sense to seperate these two because we the first one contains a defined sequence of steps and the last pipe we are going to use to tune certain parameters via cross validation.

When performning the cross validation the transformers and estimators in the pipe will be applied after splitting the data into cross validation pairs. Cross validation is computationally expensive and we only want to use it for steps which are likely to introduce bias and can lead to overfitting such as feature selection and hyperparameter tuning.

Preprocessing Pipeline

We are going to apply the sklearn-pandas dataframe mapper and a low variance feature filter.

from sklearn.model_selection import RandomizedSearchCV
from sklearn.model_selection import RepeatedKFold
from sklearn.tree import DecisionTreeClassifier
from sklearn.feature_selection import VarianceThreshold
from scipy import stats
import os


pipe_pre_process = sklearn.pipeline.Pipeline([
    ('mapper', mapper_np ) 
    , ('feats', VarianceThreshold() )
])


pipe_pre_process

Pipeline(memory=None,
     steps=[('mapper', DataFrameMapper(default=False, df_out=False,
        features=[(['sex'], [CategoricalImputer(copy=True, missing_values='NaN'), LabelBinarizer(neg_label=0, pos_label=1, sparse_output=False)]), (['embarked'], [CategoricalImputer(copy=True, missing_values='NaN'), LabelBinarizer(neg_la...h_std=True)])],
        input_df=False, sparse=False)), ('feats', VarianceThreshold(threshold=0.0))])

pipe_pre_process.named_steps

{'feats': VarianceThreshold(threshold=0.0),
 'mapper': DataFrameMapper(default=False, df_out=False,
         features=[(['sex'], [CategoricalImputer(copy=True, missing_values='NaN'), LabelBinarizer(neg_label=0, pos_label=1, sparse_output=False)]), (['embarked'], [CategoricalImputer(copy=True, missing_values='NaN'), LabelBinarizer(neg_label=0, pos_label=1, sparse_output=False)]), (['class'], [CategoricalImp...es='NaN', strategy='median', verbose=0), StandardScaler(copy=True, with_mean=True, with_std=True)])],
         input_df=False, sparse=False)}

The parameters are saved as follows in a nested dictionary and are named after the following principle step_name + '__' + argument

pipe_pre_process.get_params()

{'feats': VarianceThreshold(threshold=0.0),
 'feats__threshold': 0.0,
 'mapper': DataFrameMapper(default=False, df_out=False,
         features=[(['sex'], [CategoricalImputer(copy=True, missing_values='NaN'), LabelBinarizer(neg_label=0, pos_label=1, sparse_output=False)]), (['embarked'], [CategoricalImputer(copy=True, missing_values='NaN'), LabelBinarizer(neg_label=0, pos_label=1, sparse_output=False)]), (['class'], [CategoricalImp...es='NaN', strategy='median', verbose=0), StandardScaler(copy=True, with_mean=True, with_std=True)])],
         input_df=False, sparse=False),
 'mapper__default': False,
 'mapper__df_out': False,
 'mapper__features': [(['sex'],
   [CategoricalImputer(copy=True, missing_values='NaN'),
    LabelBinarizer(neg_label=0, pos_label=1, sparse_output=False)]),
  (['embarked'],
   [CategoricalImputer(copy=True, missing_values='NaN'),
    LabelBinarizer(neg_label=0, pos_label=1, sparse_output=False)]),
  (['class'],
   [CategoricalImputer(copy=True, missing_values='NaN'),
    LabelBinarizer(neg_label=0, pos_label=1, sparse_output=False)]),
  (['who'],
   [CategoricalImputer(copy=True, missing_values='NaN'),
    LabelBinarizer(neg_label=0, pos_label=1, sparse_output=False)]),
  (['adult_male'],
   [CategoricalImputer(copy=True, missing_values='NaN'),
    LabelBinarizer(neg_label=0, pos_label=1, sparse_output=False)]),
  (['deck'],
   [CategoricalImputer(copy=True, missing_values='NaN'),
    LabelBinarizer(neg_label=0, pos_label=1, sparse_output=False)]),
  (['embark_town'],
   [CategoricalImputer(copy=True, missing_values='NaN'),
    LabelBinarizer(neg_label=0, pos_label=1, sparse_output=False)]),
  (['alone'],
   [CategoricalImputer(copy=True, missing_values='NaN'),
    LabelBinarizer(neg_label=0, pos_label=1, sparse_output=False)]),
  (['pclass'],
   [Imputer(axis=0, copy=True, missing_values='NaN', strategy='median', verbose=0),
    StandardScaler(copy=True, with_mean=True, with_std=True)]),
  (['age'],
   [Imputer(axis=0, copy=True, missing_values='NaN', strategy='median', verbose=0),
    StandardScaler(copy=True, with_mean=True, with_std=True)]),
  (['sibsp'],
   [Imputer(axis=0, copy=True, missing_values='NaN', strategy='median', verbose=0),
    StandardScaler(copy=True, with_mean=True, with_std=True)]),
  (['parch'],
   [Imputer(axis=0, copy=True, missing_values='NaN', strategy='median', verbose=0),
    StandardScaler(copy=True, with_mean=True, with_std=True)]),
  (['fare'],
   [Imputer(axis=0, copy=True, missing_values='NaN', strategy='median', verbose=0),
    StandardScaler(copy=True, with_mean=True, with_std=True)])],
 'mapper__input_df': False,
 'mapper__sparse': False,
 'memory': None,
 'steps': [('mapper', DataFrameMapper(default=False, df_out=False,
           features=[(['sex'], [CategoricalImputer(copy=True, missing_values='NaN'), LabelBinarizer(neg_label=0, pos_label=1, sparse_output=False)]), (['embarked'], [CategoricalImputer(copy=True, missing_values='NaN'), LabelBinarizer(neg_label=0, pos_label=1, sparse_output=False)]), (['class'], [CategoricalImp...es='NaN', strategy='median', verbose=0), StandardScaler(copy=True, with_mean=True, with_std=True)])],
           input_df=False, sparse=False)),
  ('feats', VarianceThreshold(threshold=0.0))]}

We can set a parameter

pipe_pre_process.set_params(feats__threshold = 0.05)
pipe_pre_process.named_steps.feats

VarianceThreshold(threshold=0.05)

Then we fit the preprocessing pipe to the data

pipe_pre_process.fit(X)
X_proc = pipe_pre_process.fit_transform(X)

X_proc

array([[ 1.        ,  0.        ,  0.        , ...,  0.43279337,
        -0.47367361, -0.50244517],
       [ 0.        ,  1.        ,  0.        , ...,  0.43279337,
        -0.47367361,  0.78684529],
       [ 0.        ,  0.        ,  0.        , ..., -0.4745452 ,
        -0.47367361, -0.48885426],
       ...,
       [ 0.        ,  0.        ,  0.        , ...,  0.43279337,
         2.00893337, -0.17626324],
       [ 1.        ,  1.        ,  0.        , ..., -0.4745452 ,
        -0.47367361, -0.04438104],
       [ 1.        ,  0.        ,  1.        , ..., -0.4745452 ,
        -0.47367361, -0.49237783]])

We will be using the pre processed data in another post so we are saving it to disc. We are storing it in feather format which is basically hdfs which has much faster in terms of reading and writing from and to disc.

import feather
import os

if not os.path.isdir('./data'):
    os.mkdir('./data')


df_feather = mapped_df.\
    assign( y = y )

feather.write_dataframe(df_feather, './data/mapped_df.feather')

Modelling Pipeline

We will add a feature selection step, which choses variables based on a univariate test such as a chisquare test (which we cannot use here because it does not accept negative values) and ANOVA and then fit a decision tree.

pipe_mod = sklearn.pipeline.Pipeline([
    ('feats', sklearn.feature_selection.SelectKBest( k = 10) ) 
    , ('tree', sklearn.tree.DecisionTreeClassifier() )
])

We can apply the same ‘__’ synthax as we used for setting the parameters of the pipe for constructing the dictionary for the sandomized hyperparameter search

param_dist = dict( tree__min_samples_split = stats.randint(2,250)
                 , tree__min_samples_leaf = stats.randint(1,500)
                 , tree__min_impurity_decrease = stats.uniform(0,1)
                 , tree__max_features = stats.uniform(0,1)
                 , feats__score_func = [sklearn.feature_selection.f_classif ## Anova
                                       , sklearn.feature_selection.mutual_info_classif] ) ## nearest n

n_iter = 500

random_search = RandomizedSearchCV(pipe_mod
                                   , param_dist
                                   , n_iter = n_iter
                                   , scoring = 'roc_auc'
                                   , cv = RepeatedKFold( n_splits = 5, n_repeats = 3 )
                                   , verbose = True
                                   , n_jobs = 4 ## parallel processing
                                   , return_train_score = True
                                  )


random_search.fit(X = X_proc, y =  df.survived )

Fitting 15 folds for each of 500 candidates, totalling 7500 fits


[Parallel(n_jobs=4)]: Done  49 tasks      | elapsed:    5.8s
[Parallel(n_jobs=4)]: Done 740 tasks      | elapsed:   34.9s
[Parallel(n_jobs=4)]: Done 2005 tasks      | elapsed:  1.4min
[Parallel(n_jobs=4)]: Done 3737 tasks      | elapsed:  2.6min
[Parallel(n_jobs=4)]: Done 5556 tasks      | elapsed:  4.3min
[Parallel(n_jobs=4)]: Done 7241 tasks      | elapsed:  5.9min
[Parallel(n_jobs=4)]: Done 7493 out of 7500 | elapsed:  6.1min remaining:    0.2s
[Parallel(n_jobs=4)]: Done 7500 out of 7500 | elapsed:  6.1min finished





RandomizedSearchCV(cv=<sklearn.model_selection._split.RepeatedKFold object at 0x000001916A6DC9B0>,
          error_score='raise',
          estimator=Pipeline(memory=None,
     steps=[('feats', SelectKBest(k=10, score_func=<function f_classif at 0x000001916A6ABF28>)), ('tree', DecisionTreeClassifier(class_weight=None, criterion='gini', max_depth=None,
            max_features=None, max_leaf_nodes=None,
            min_impurity_decrease=0.0, min_impurity_split=None,
            min_samples_leaf=1, min_samples_split=2,
            min_weight_fraction_leaf=0.0, presort=False, random_state=None,
            splitter='best'))]),
          fit_params=None, iid=True, n_iter=500, n_jobs=4,
          param_distributions={'tree__min_impurity_decrease': <scipy.stats._distn_infrastructure.rv_frozen object at 0x000001916A6DC160>, 'feats__score_func': [<function f_classif at 0x000001916A6ABF28>, <function mutual_info_classif at 0x000001916A6CD2F0>], 'tree__max_features': <scipy.stats._distn_infrastru...tree__min_samples_leaf': <scipy.stats._distn_infrastructure.rv_frozen object at 0x000001916A6D9FD0>},
          pre_dispatch='2*n_jobs', random_state=None, refit=True,
          return_train_score=True, scoring='roc_auc', verbose=True)

random_search.best_estimator_

Pipeline(memory=None,
     steps=[('feats', SelectKBest(k=10,
      score_func=<function mutual_info_classif at 0x000001916A6CD2F0>)), ('tree', DecisionTreeClassifier(class_weight=None, criterion='gini', max_depth=None,
            max_features=0.6995334988533182, max_leaf_nodes=None,
            min_impurity_decrease=0.00253...t=47, min_weight_fraction_leaf=0.0,
            presort=False, random_state=None, splitter='best'))])

res = pd.DataFrame( random_search.cv_results_ )

res.sort_values('rank_test_score').head(10)

	mean_fit_time	mean_score_time	mean_test_score	mean_train_score	param_feats__score_func	param_tree__max_features	param_tree__min_impurity_decrease	param_tree__min_samples_leaf	param_tree__min_samples_split	params	...	split7_test_score	split7_train_score	split8_test_score	split8_train_score	split9_test_score	split9_train_score	std_fit_time	std_score_time	std_test_score	std_train_score
206	0.360021	0.001642	0.851727	0.862858	<function mutual_info_classif at 0x000001916A6...	0.699533	0.00253909	33	47	{'feats__score_func': <function mutual_info_cl...	...	0.772863	0.866083	0.847184	0.881330	0.867859	0.867060	0.031329	0.003972	0.036028	0.016553
88	0.004166	0.001308	0.829953	0.838292	<function f_classif at 0x000001916A6ABF28>	0.87121	0.0133541	89	210	{'feats__score_func': <function f_classif at 0...	...	0.736742	0.809940	0.845372	0.858085	0.798939	0.825771	0.006909	0.003953	0.034927	0.019111
194	0.298661	0.000000	0.811322	0.811516	<function mutual_info_classif at 0x000001916A6...	0.813777	0.0138638	124	79	{'feats__score_func': <function mutual_info_cl...	...	0.713745	0.779844	0.815275	0.821707	0.798939	0.825771	0.029102	0.000000	0.032071	0.018513
230	0.435979	0.003441	0.777916	0.776460	<function mutual_info_classif at 0x000001916A6...	0.407913	0.127602	3	215	{'feats__score_func': <function mutual_info_cl...	...	0.754735	0.786423	0.768997	0.766081	0.750393	0.787890	0.268832	0.005945	0.019844	0.009008
285	0.312650	0.001333	0.777642	0.779836	<function mutual_info_classif at 0x000001916A6...	0.95935	0.0960747	234	36	{'feats__score_func': <function mutual_info_cl...	...	0.713745	0.779844	0.779288	0.780731	0.750393	0.787890	0.020375	0.001885	0.025972	0.005002
347	0.003999	0.001600	0.777642	0.779836	<function f_classif at 0x000001916A6ABF28>	0.722103	0.0547579	104	224	{'feats__score_func': <function f_classif at 0...	...	0.713745	0.779844	0.779288	0.780731	0.750393	0.787890	0.002529	0.001959	0.025972	0.005002
263	0.004570	0.001416	0.777642	0.779836	<function f_classif at 0x000001916A6ABF28>	0.83097	0.0618748	211	14	{'feats__score_func': <function f_classif at 0...	...	0.713745	0.779844	0.779288	0.780731	0.750393	0.787890	0.006060	0.002616	0.025972	0.005002
459	0.005208	0.000000	0.777642	0.779836	<function f_classif at 0x000001916A6ABF28>	0.93767	0.0945291	11	96	{'feats__score_func': <function f_classif at 0...	...	0.713745	0.779844	0.779288	0.780731	0.750393	0.787890	0.009316	0.000000	0.025972	0.005002
224	0.002137	0.001575	0.773051	0.774232	<function f_classif at 0x000001916A6ABF28>	0.509988	0.0569047	74	12	{'feats__score_func': <function f_classif at 0...	...	0.754735	0.786423	0.779288	0.780731	0.750393	0.787890	0.001999	0.003991	0.021037	0.015873
472	0.004166	0.002083	0.771509	0.774650	<function f_classif at 0x000001916A6ABF28>	0.555193	0.0792222	173	195	{'feats__score_func': <function f_classif at 0...	...	0.713745	0.779844	0.779288	0.780731	0.750393	0.787890	0.006909	0.005311	0.027898	0.013231

10 rows × 45 columns

Summary

We can see that our maximum ROC score 0.86 is similar to what we obtained in the last post (0.85) where we took a more manual approach. However using sklearn-pandas and pipes we were able to write code that is more generalizable and is less dependent on the actual dataset. We have more or less written a generalizable code for the preprocessing pipe however the code for the modelling pipe is quite specific for the model that we used. I f we wanted to train more models of a different type we would have to manually write pipes for them as well.

Moving from R to python - 5/7 - scikitlearn

Sat, 25 Aug 2018 00:00:00 +0000

scikitlearn

As I am starting out to read some scikitlearn tutorials I immedialtely spot some differences between scikitlearn and modelling in R.

for scikitlearn data needs to be numerical, so all categorical data needs to be converted to dummy variables first.
predictor and response variable have to be given in “matrix input”, there is no such thing as the formula input in R
the nomenclature for the predictor matrix is X and for the response y

Here we would like to perform a rather complex chain of steps.

Feature Engineeering
- Impute missing data
- Normalize numerical data
- Create dummy variables for categorical data

Modelling
- Fit a cross validated CART tree
- Use randomized parameter search to tune the tree
- Visualize the tree with the lowest error
- Visualize the ROC curve with SEM based on cv results

Sample Data

We have to provide the data in x,y format and have to convert all categoricals before hand. There are some sample datasets that come with scikitlearn but they are already pre-processed and contain no categorical variables. Here is an example

from sklearn import datasets

boston = datasets.load_boston()

print(boston.data)
print(boston.feature_names)

[[6.3200e-03 1.8000e+01 2.3100e+00 ... 1.5300e+01 3.9690e+02 4.9800e+00]
 [2.7310e-02 0.0000e+00 7.0700e+00 ... 1.7800e+01 3.9690e+02 9.1400e+00]
 [2.7290e-02 0.0000e+00 7.0700e+00 ... 1.7800e+01 3.9283e+02 4.0300e+00]
 ...
 [6.0760e-02 0.0000e+00 1.1930e+01 ... 2.1000e+01 3.9690e+02 5.6400e+00]
 [1.0959e-01 0.0000e+00 1.1930e+01 ... 2.1000e+01 3.9345e+02 6.4800e+00]
 [4.7410e-02 0.0000e+00 1.1930e+01 ... 2.1000e+01 3.9690e+02 7.8800e+00]]
['CRIM' 'ZN' 'INDUS' 'CHAS' 'NOX' 'RM' 'AGE' 'DIS' 'RAD' 'TAX' 'PTRATIO'
 'B' 'LSTAT']

Usually our datasets will not come that neatly prepared and we wont have numpy arrays but pandas dataframes. So alternatively we will get our datasets from seaborn

import seaborn as sns

df = sns.load_dataset('titanic')

df.head()

	survived	pclass	sex	age	sibsp	fare	embarked	class	who	adult_male	deck	embark_town	alive	alone
0	0	3	male	22.0	1	7.2500	S	Third	man	True	NaN	Southampton	no	False
1	1	1	female	38.0	1	71.2833	C	First	woman	False	C	Cherbourg	yes	False
2	1	3	female	26.0	0	7.9250	S	Third	woman	False	NaN	Southampton	yes	True
3	1	1	female	35.0	1	53.1000	S	First	woman	False	C	Southampton	yes	False
4	0	3	male	35.0	0	8.0500	S	Third	man	True	NaN	Southampton	no	True

Investigating Data Set

df.dtypes

survived          int64
pclass            int64
sex              object
age             float64
sibsp             int64
parch             int64
fare            float64
embarked         object
class          category
who              object
adult_male         bool
deck           category
embark_town      object
alive            object
alone              bool
dtype: object

In R we would use summary to look at the number of levels of each factor variable. In python we would have to iterate over the categorical column names and use pd.Series.value_counts() which is a bit cumbersome. However this approach also gives us a bit more control than we have with summary() in R.

import pandas as pd
import numpy as np

def summary(df):
    
    print('categorical variables--------------------------------')
    
    for cat_var in df.select_dtypes(exclude = np.number).columns:

        counts = df[cat_var] \
            .value_counts( dropna= False ) \
            .to_frame()
        perc = df[cat_var] \
            .value_counts( dropna= False, normalize = True ) \
            .to_frame()
            
        print( df[cat_var].dtypes )
        print( counts.join(perc, lsuffix = '_n', rsuffix = '_perc' ) )
        print('')
    
    print('numerical variables----------------------------------')
    
    print( df.describe() )
          
summary(df)

categorical variables--------------------------------
object
        sex_n  sex_perc
male      577  0.647587
female    314  0.352413

object
     embarked_n  embarked_perc
S           644       0.722783
C           168       0.188552
Q            77       0.086420
NaN           2       0.002245

category
        class_n  class_perc
Third       491    0.551066
First       216    0.242424
Second      184    0.206510

object
       who_n  who_perc
man      537  0.602694
woman    271  0.304153
child     83  0.093154

bool
       adult_male_n  adult_male_perc
True            537         0.602694
False           354         0.397306

category
     deck_n  deck_perc
NaN     688   0.772166
C        59   0.066218
B        47   0.052750
D        33   0.037037
E        32   0.035915
A        15   0.016835
F        13   0.014590
G         4   0.004489

object
             embark_town_n  embark_town_perc
Southampton            644          0.722783
Cherbourg              168          0.188552
Queenstown              77          0.086420
NaN                      2          0.002245

object
     alive_n  alive_perc
no       549    0.616162
yes      342    0.383838

bool
       alone_n  alone_perc
True       537    0.602694
False      354    0.397306

numerical variables----------------------------------
         survived      pclass         age       sibsp       parch        fare
count  891.000000  891.000000  714.000000  891.000000  891.000000  891.000000
mean     0.383838    2.308642   29.699118    0.523008    0.381594   32.204208
std      0.486592    0.836071   14.526497    1.102743    0.806057   49.693429
min      0.000000    1.000000    0.420000    0.000000    0.000000    0.000000
25%      0.000000    2.000000   20.125000    0.000000    0.000000    7.910400
50%      0.000000    3.000000   28.000000    0.000000    0.000000   14.454200
75%      1.000000    3.000000   38.000000    1.000000    0.000000   31.000000
max      1.000000    3.000000   80.000000    8.000000    6.000000  512.329200

Some variables do have missing values which we have to impute.

Feature Engineering

Impute missing values

scikit-learn has some standard imputation methods like mean and median. There is a package called fancyimpute which can do knn imputing but has a huge list of required packages a lot of which require C++ compilation. We will therefore just use scikti-learn to start with. Like everything in scikitlearn we can only use it for numerical data.

Encode categorical variables

The imputation methods included in scikitlearn require numerical data. In order to use them for categorical data we have to assign a number to each level, apply the imputation method and then convert the numbers back to their corresponding levels. In the development version of scikitlearn we can find sklearn.preprocessing.CategoricalEncoder which apparently allows you to do easy onestep encoding and decoding. Then there is the package sklearn-pandas which also has a CategoricalEncoder and bridges both packages and is recommended on the pandas documentation homepage.

For exercise purposes however we will build our own Categorical Encoder. We will use pd.factorize() to convert the categorical columns to numerical, it returns a numerical array and an index which allows us to convert the array back to the categories. However there are some issues for this function.

NaN will be represented with -1 in the array but dropped from the index in none dtype == 'category' columns. Which makes recoding awkward
There is a bug for columns of dtype == 'category' which only returns a numerical index and makes it impossible to recode back to categories from it. This bug will be fixed in pandas 0.23 (as I am writing this the release version is pandas 0.19). This means we have to implement an ugly fix into our Encoder Class :-(. bugreport.
NaN for columns of dtype == 'category' will not be encoded with a random integer within the range of the number of unique values. We need a consistent NaN integer for imputation.

Convert all none-numericals to dtype category

for col in df.select_dtypes(exclude = np.number).columns:
    df[col] = df[col].astype('object')

Categorical Encoder

class CategoricalEncoder:
    
    columns = list()
    dtypes = list()
    indeces = dict()
    
    
    def encode(self, df):
        
        # dont want the input object to change
        df = df.copy()
        
        self.columns = df.columns
        self.dtypes = df.dtypes
        
        assert len( df.select_dtypes(exclude = [np.number, 'object']).columns ) == 0 \
        , 'convert all none-numerical columns to object first'
                
        for col in df.select_dtypes(exclude = np.number):
            df[col], self.indeces[col] = pd.factorize(df[col])
            #df[col] = df[col].astype('int') ## array is returned as float :-(
            
        return df
            
    def recode(self, df):
        
        df = df.copy()
        
        assert any( df.columns == self.columns), 'columns do not match original dataframe'
        
        for col, ind in self.indeces.items():
            df[col] = [ np.nan if x == -1 else x for x in df[col] ] ## numpy converts array to float
            df[col] = [ ind[ int(x) ] if not np.isnan(x) else x for x in df[col] ] ## we need to convert back to int 
            
        df = df.loc[:,self.columns]
            
        for col, dtype in zip(df.columns, self.dtypes):
            df[col] = df[col].astype(dtype.name)
                     
        return df

Test Categorical Encoder

Encoder = CategoricalEncoder()

df_enc = Encoder.encode(df)

df_rec = Encoder.recode(df_enc)

assert df.equals(df_rec), 'Encoder does not recode correctly'

Impute

We will impute categroical with most frequent category and numericals with mean

from sklearn.preprocessing import Imputer

Encoder = CategoricalEncoder()

df_enc = Encoder.encode(df)

df_imp = df_enc.copy()

# numericals
col_num = df.select_dtypes(include = np.number).columns
Imputer_mean = Imputer(strategy = 'mean')
df_imp.loc[:, col_num] = Imputer_mean.fit_transform( df_imp.loc[:, col_num] )

# categoricals
col_cat = df.select_dtypes(exclude = np.number).columns
Imputer_freq = Imputer(strategy = 'most_frequent', missing_values = -1)
df_imp.loc[:, col_cat]  = Imputer_freq.fit_transform( df_imp.loc[:, col_cat] )

df_imp_rec = Encoder.recode(df_imp)
 
assert not df_imp_rec.isna().as_matrix().any()
assert df_imp_rec.shape == df.shape

c:\anaconda\envs\py36r343\lib\site-packages\ipykernel\__main__.py:21: FutureWarning: Method .as_matrix will be removed in a future version. Use .values instead.

Transforming numerical variables

Boxcox

Investigate distributions

from matplotlib import pyplot as plt
%matplotlib inline


def plot_hist_grid(df, x, y ):
    
    fig = plt.figure(figsize=(14, 12))

    for i, col in enumerate( df.select_dtypes( include = np.number).columns ):
        ax = fig.add_subplot(x,y,i+1)
        sns.distplot( df[col].dropna() )
        ax.set_title(col + ' distribution')

    fig.tight_layout() ## we need this so the histogram titles do not overlap

    
plot_hist_grid(df_imp_rec, 4, 2)

c:\anaconda\envs\py36r343\lib\site-packages\matplotlib\axes\_axes.py:6462: UserWarning: The 'normed' kwarg is deprecated, and has been replaced by the 'density' kwarg.
  warnings.warn("The 'normed' kwarg is deprecated, and has been "
c:\anaconda\envs\py36r343\lib\site-packages\matplotlib\axes\_axes.py:6462: UserWarning: The 'normed' kwarg is deprecated, and has been replaced by the 'density' kwarg.
  warnings.warn("The 'normed' kwarg is deprecated, and has been "
c:\anaconda\envs\py36r343\lib\site-packages\matplotlib\axes\_axes.py:6462: UserWarning: The 'normed' kwarg is deprecated, and has been replaced by the 'density' kwarg.
  warnings.warn("The 'normed' kwarg is deprecated, and has been "
c:\anaconda\envs\py36r343\lib\site-packages\matplotlib\axes\_axes.py:6462: UserWarning: The 'normed' kwarg is deprecated, and has been replaced by the 'density' kwarg.
  warnings.warn("The 'normed' kwarg is deprecated, and has been "
c:\anaconda\envs\py36r343\lib\site-packages\matplotlib\axes\_axes.py:6462: UserWarning: The 'normed' kwarg is deprecated, and has been replaced by the 'density' kwarg.
  warnings.warn("The 'normed' kwarg is deprecated, and has been "
c:\anaconda\envs\py36r343\lib\site-packages\matplotlib\axes\_axes.py:6462: UserWarning: The 'normed' kwarg is deprecated, and has been replaced by the 'density' kwarg.
  warnings.warn("The 'normed' kwarg is deprecated, and has been "

none of the numerical variables have a normal distribution, the best option here would be to use a Boxcox or a Yeo Johnson transformation if we plan on using a parametric model. Both algorithms return a lambda value that allows us to apply the same transformation to new data. Unfortunately the python implementations are a bit limited at the moment. There is sklearn.preprocessing.PowerTransformer in the newest development version of scikit-learn whis supports Boxcox transformations. Then there is scipy.stats.boxcox which is a bit cumbersome and requires a lot of manual work. Also Boxcox is a bit subborn and requires positive values. Probably feature processing is something you want to keep doing in R using recipes or caret.

Apply Boxcox transformation

from scipy.stats import boxcox

df_trans = df_imp_rec.copy()

# boxcox needs values > 0
for col in df_imp_rec.select_dtypes(include = np.number).columns:
    df_trans[col] = df_trans[col] + 0.01

# scipy.stats implementaion cannot handle NA values
# df_trans = df_trans.dropna()

lambdas = dict()

for col in df_imp_rec.select_dtypes(include = np.number).columns:
    df_trans[col], lambdas[col] = boxcox(df_trans[col])
    
print( pd.Series(lambdas) )

plot_hist_grid(df_trans, 4, 2)

df_trans.describe()

age         0.822999
fare        0.180913
parch      -0.767354
pclass      1.774717
sibsp      -0.484927
survived   -0.312346
dtype: float64


c:\anaconda\envs\py36r343\lib\site-packages\matplotlib\axes\_axes.py:6462: UserWarning: The 'normed' kwarg is deprecated, and has been replaced by the 'density' kwarg.
  warnings.warn("The 'normed' kwarg is deprecated, and has been "
c:\anaconda\envs\py36r343\lib\site-packages\matplotlib\axes\_axes.py:6462: UserWarning: The 'normed' kwarg is deprecated, and has been replaced by the 'density' kwarg.
  warnings.warn("The 'normed' kwarg is deprecated, and has been "
c:\anaconda\envs\py36r343\lib\site-packages\matplotlib\axes\_axes.py:6462: UserWarning: The 'normed' kwarg is deprecated, and has been replaced by the 'density' kwarg.
  warnings.warn("The 'normed' kwarg is deprecated, and has been "
c:\anaconda\envs\py36r343\lib\site-packages\matplotlib\axes\_axes.py:6462: UserWarning: The 'normed' kwarg is deprecated, and has been replaced by the 'density' kwarg.
  warnings.warn("The 'normed' kwarg is deprecated, and has been "
c:\anaconda\envs\py36r343\lib\site-packages\matplotlib\axes\_axes.py:6462: UserWarning: The 'normed' kwarg is deprecated, and has been replaced by the 'density' kwarg.
  warnings.warn("The 'normed' kwarg is deprecated, and has been "
c:\anaconda\envs\py36r343\lib\site-packages\matplotlib\axes\_axes.py:6462: UserWarning: The 'normed' kwarg is deprecated, and has been replaced by the 'density' kwarg.
  warnings.warn("The 'normed' kwarg is deprecated, and has been "

	survived	pclass	age	sibsp	parch	fare
count	891.000000	891.000000	891.000000	891.000000	891.000000	891.000000
mean	-6.336364	2.172058	18.275863	-11.647712	-32.911718	3.910416
std	5.011771	1.456663	7.261755	8.111499	18.608375	1.965039
min	-10.289796	0.010039	-0.608408	-17.176613	-43.335522	-3.124792
25%	-10.289796	1.381702	14.257979	-17.176613	-43.335522	2.510059
50%	-10.289796	3.419353	18.590518	-17.176613	-43.335522	3.435259
75%	0.009935	3.419353	21.455870	0.009926	-43.335522	4.761225
max	0.009935	3.419353	43.544598	1.310322	0.974077	11.561796

Scale

from sklearn.preprocessing import StandardScaler

Scaler = StandardScaler()

cols_num = df_trans.select_dtypes(include = np.number).columns
df_trans.loc[:,cols_num] = Scaler.fit_transform( df_trans.loc[:,cols_num] )

plot_hist_grid(df_trans, 4, 2)

c:\anaconda\envs\py36r343\lib\site-packages\matplotlib\axes\_axes.py:6462: UserWarning: The 'normed' kwarg is deprecated, and has been replaced by the 'density' kwarg.
  warnings.warn("The 'normed' kwarg is deprecated, and has been "
c:\anaconda\envs\py36r343\lib\site-packages\matplotlib\axes\_axes.py:6462: UserWarning: The 'normed' kwarg is deprecated, and has been replaced by the 'density' kwarg.
  warnings.warn("The 'normed' kwarg is deprecated, and has been "
c:\anaconda\envs\py36r343\lib\site-packages\matplotlib\axes\_axes.py:6462: UserWarning: The 'normed' kwarg is deprecated, and has been replaced by the 'density' kwarg.
  warnings.warn("The 'normed' kwarg is deprecated, and has been "
c:\anaconda\envs\py36r343\lib\site-packages\matplotlib\axes\_axes.py:6462: UserWarning: The 'normed' kwarg is deprecated, and has been replaced by the 'density' kwarg.
  warnings.warn("The 'normed' kwarg is deprecated, and has been "
c:\anaconda\envs\py36r343\lib\site-packages\matplotlib\axes\_axes.py:6462: UserWarning: The 'normed' kwarg is deprecated, and has been replaced by the 'density' kwarg.
  warnings.warn("The 'normed' kwarg is deprecated, and has been "
c:\anaconda\envs\py36r343\lib\site-packages\matplotlib\axes\_axes.py:6462: UserWarning: The 'normed' kwarg is deprecated, and has been replaced by the 'density' kwarg.
  warnings.warn("The 'normed' kwarg is deprecated, and has been "

Final feature selection

Finally we have some duplicate information in our dataframe which we will drop.

df_fin = df_trans.drop(['survived','pclass'], axis = 1)

Encoding Categorical variables

In R we did not have to worry much about encoding categorical data it would usually be taken care of by most modelling algorithms. In python we have to do this manually.

There is an excellent guide from which I will try to replicate some of the examples. Digging into the topic a bit I also learned that there are more encoding techniques for categorical variabels than just the regular dummy encoding which is used by R as the gold standard. There is also one hot encoding which creates for a categorical variable with k categories k binary columns (compared to k-1 columns for dummy encoding). Beyond those two methods there are plenty more as described in this article. For these types of encodings the categorical values will be replaced with the summarized values of the response variable of all observations from the same category such as the sum or the mean. This is similar to the weight of evidence encoding which is commonly used when developing credit risk score cards with logistic regression.

Returning to the samply data we can see that we have duplicated information such as the columns sex, who, and adult_male. Here we will select only one of each of those and prefer categorical string encoding over variables that already have numerical or binary encoding.

Create dummy variables

There is no algorithm in scikitlearn that creates dummy variables we therefore need to borrow this functionality from pandas.

df_dum = pd.get_dummies(df_fin
               , drop_first = True ## k-1 dummy variables
              )

df_dum.head()

	age	sibsp	parch	fare	sex_male	embarked_S	class_Third	who_man	...	deck_C	embark_town_Southampton	alive_yes	alone_True
0	-0.553605	1.437981	-0.560482	-0.776991	1	1	1	1	...	1	1	0	0
1	0.656833	1.437981	-0.560482	1.284747	0	0	0	0	...	1	0	1	0
2	-0.239527	-0.681996	-0.560482	-0.711671	0	1	1	0	...	1	1	1	1
3	0.438158	1.437981	-0.560482	0.968817	0	1	0	0	...	1	1	1	0
4	0.438158	-0.681996	-0.560482	-0.700078	1	1	1	1	...	1	1	0	1

5 rows × 22 columns

Fitting a decision tree

We will fit an examplatory decision tree to the data. Not because it is the best model to use here but because decision trees can easily be visualised graphically and it is a good exercise to try that out. We will perform a 10 x 10-fold cross validation and a randomized parameter search.

Hyperparameter Tuning

Traditionally one would use a grid search of all possible hyperparameter combinations in order to optimize model performance. Recently a number of more efficient algorithms have been developed.

The submodel trick: For some ensemble methods one of the tuning parameters usually reflects the number of contrbuting models such as the number of trees in a random forest. In order to train a forest with 1000 trees we have in the process also to train models for all numbers of trees between 1:1000. The submodel trick simpoly implies that we are saving these intermediary models for evaluation. The submodel trick is used by many model implementations in the caret package. Usually the implementation of the submodel trick outweighs the benefits of the other hyperparameter optimizations strategies.
Adaptive Resampling: In order to validate model performance we have to use k-fold cross validation, k usually depends on the size and variance in the data. Sometimes variance in the data is so high that each k-fold split of the data gives us different results, so we have to perform x times k-fold cross validaztion. For most of the hyperparameter combinations in a grid search however we can probably already predict after analysing just a few cross validation pairs that they will not produce better results than the best combination that we have found so far. Max Kuhn has presented to techniques for prediciting model performance after only a few resampling rounds in his 2014 paper which have been experimentally implemented in caret.
Randomized Search: Experience in hyperparamter tuning has shown that only a few of the tunable parameters of a model actually have an influence on model performance. Which those parameters are however is largely influenced by the dataset. In a case where the model performance is largely dominated by a single parameter a randomized search covers a larger range of that parameter than a grid search as demonstrated in this [paper] and exemplified in the illustration below. (http://www.jmlr.org/papers/volume13/bergstra12a/bergstra12a.pdf). Randomized search is implemented in caret as well as in scikitlearn

Randomized parameter search

Instead of specifiying a range for certain parameters we will provide a distribution to sample from an the number of iterations the algorithm should use. We can get the distributions from the scipy.stats package. Since we have no prior knowledge about which distributions to chose we simply chose stats.randint for discrete values and stats.uniform for contineous values.

from sklearn.tree import DecisionTreeClassifier
from sklearn.model_selection import RandomizedSearchCV
from sklearn.model_selection import RepeatedKFold
from scipy import stats


clf = DecisionTreeClassifier()

param_dist = {'min_samples_split': stats.randint(2,250)
             , 'min_samples_leaf': stats.randint(1,500)
             , 'min_impurity_decrease' : stats.uniform(0,1)
             , 'max_features': stats.uniform(0,1) }

n_iter = 2500

random_search = RandomizedSearchCV(clf
                                   , param_dist
                                   , n_iter = n_iter
                                   , scoring = 'roc_auc'
                                   , cv = RepeatedKFold( n_splits = 10, n_repeats = 10 )
                                   , verbose = True
                                   , n_jobs = 4 ## parallel processing
                                   , return_train_score = True
                                  )

x = df_dum.drop('alive_yes', axis = 1)
y = df_dum['alive_yes']

random_search.fit(x,y)

Fitting 100 folds for each of 2500 candidates, totalling 250000 fits


[Parallel(n_jobs=4)]: Done 142 tasks      | elapsed:    4.4s
[Parallel(n_jobs=4)]: Done 7538 tasks      | elapsed:   20.7s
[Parallel(n_jobs=4)]: Done 20038 tasks      | elapsed:   50.3s
[Parallel(n_jobs=4)]: Done 37538 tasks      | elapsed:  1.4min
[Parallel(n_jobs=4)]: Done 60038 tasks      | elapsed:  2.3min
[Parallel(n_jobs=4)]: Done 87538 tasks      | elapsed:  3.1min
[Parallel(n_jobs=4)]: Done 120038 tasks      | elapsed:  4.2min
[Parallel(n_jobs=4)]: Done 157538 tasks      | elapsed:  5.3min
[Parallel(n_jobs=4)]: Done 200038 tasks      | elapsed:  6.7min
[Parallel(n_jobs=4)]: Done 247538 tasks      | elapsed:  8.2min
[Parallel(n_jobs=4)]: Done 250000 out of 250000 | elapsed:  8.3min finished





RandomizedSearchCV(cv=<sklearn.model_selection._split.RepeatedKFold object at 0x0000026252BAB048>,
          error_score='raise',
          estimator=DecisionTreeClassifier(class_weight=None, criterion='gini', max_depth=None,
            max_features=None, max_leaf_nodes=None,
            min_impurity_decrease=0.0, min_impurity_split=None,
            min_samples_leaf=1, min_samples_split=2,
            min_weight_fraction_leaf=0.0, presort=False, random_state=None,
            splitter='best'),
          fit_params=None, iid=True, n_iter=2500, n_jobs=4,
          param_distributions={'max_features': <scipy.stats._distn_infrastructure.rv_frozen object at 0x0000026252BB9EB8>, 'min_samples_leaf': <scipy.stats._distn_infrastructure.rv_frozen object at 0x0000026252B4B898>, 'min_samples_split': <scipy.stats._distn_infrastructure.rv_frozen object at 0x00000262515C0208>, 'min_impurity_decrease': <scipy.stats._distn_infrastructure.rv_frozen object at 0x0000026252BB9BE0>},
          pre_dispatch='2*n_jobs', random_state=None, refit=True,
          return_train_score=True, scoring='roc_auc', verbose=True)

res = pd.DataFrame( random_search.cv_results_ )

res.sort_values('rank_test_score').head(10)

	mean_fit_time	mean_score_time	mean_test_score	mean_train_score	param_max_features	param_min_impurity_decrease	param_min_samples_leaf	param_min_samples_split	params	rank_test_score	...	split98_test_score	split98_train_score	split99_test_score	split99_train_score	split9_test_score	split9_train_score	std_fit_time	std_score_time	std_test_score	std_train_score
1128	0.003643	0.001576	0.849557	0.850829	0.922112	0.00837461	83	31	{'max_features': 0.9221122085261761, 'min_samp...	1	...	0.828734	0.819121	0.901695	0.850536	0.863777	0.854140	0.006607	0.004447	0.041007	0.011566
1633	0.003828	0.001679	0.847263	0.851479	0.768034	0.006899	29	222	{'max_features': 0.7680338558114431, 'min_samp...	2	...	0.885823	0.849771	0.888136	0.839672	0.846749	0.834493	0.002111	0.002052	0.037894	0.010166
2212	0.003988	0.001859	0.844536	0.849014	0.93337	0.0106538	83	63	{'max_features': 0.9333697771766865, 'min_samp...	3	...	0.882846	0.851963	0.901695	0.850536	0.863777	0.854140	0.001951	0.002024	0.043665	0.014672
753	0.003812	0.001781	0.824468	0.835190	0.454209	0.00670731	54	112	{'max_features': 0.4542091923263467, 'min_samp...	4	...	0.882846	0.857641	0.854237	0.798901	0.865067	0.859434	0.007824	0.004666	0.051183	0.024695
1984	0.004388	0.001939	0.824068	0.829957	0.625724	0.000519658	150	142	{'max_features': 0.6257243210055624, 'min_samp...	5	...	0.875541	0.848625	0.877119	0.836702	0.870485	0.816932	0.003914	0.002773	0.045516	0.022024
19	0.003757	0.001928	0.821358	0.830195	0.749645	0.0125087	74	176	{'max_features': 0.7496448239892235, 'min_samp...	6	...	0.828734	0.819121	0.897740	0.847374	0.793344	0.778700	0.006965	0.005535	0.052542	0.023273
1201	0.003417	0.001224	0.811420	0.813680	0.854926	0.0129389	135	171	{'max_features': 0.8549262726597407, 'min_samp...	7	...	0.828734	0.819121	0.866102	0.815483	0.837461	0.818296	0.006255	0.003975	0.048909	0.017295
841	0.002967	0.001803	0.810736	0.812231	0.837255	0.0214463	96	61	{'max_features': 0.8372554895640392, 'min_samp...	8	...	0.828734	0.819121	0.832203	0.774712	0.837461	0.818296	0.006010	0.004641	0.044853	0.017689
998	0.003285	0.001589	0.807049	0.808691	0.792215	0.0331625	47	234	{'max_features': 0.7922151495137242, 'min_samp...	9	...	0.828734	0.819121	0.866102	0.815483	0.793344	0.778700	0.006297	0.004970	0.047764	0.018487
1892	0.004287	0.001516	0.805288	0.806958	0.729024	0.0344067	126	116	{'max_features': 0.7290237550895209, 'min_samp...	10	...	0.828734	0.819121	0.866102	0.815483	0.837461	0.818296	0.008426	0.004454	0.052977	0.018888

10 rows × 214 columns

from matplotlib import cm

params = ['param_max_features'
         , 'param_min_impurity_decrease'
         , 'param_min_samples_split']


cmap = cm.get_cmap('Dark2')

fig = plt.figure( figsize=(14, 12) )

for i, param in enumerate(params):

    ax = fig.add_subplot(2,2,i+1)
    
    sns.regplot( x = param
               , y = 'mean_test_score'
               , data = res # res.query('mean_test_score > 0.5') 
               , scatter_kws = { 'color' :cmap(i) }
               , fit_reg = False
             )
    
    
    
    ax.set_title(param)

  
fig.tight_layout() ## we need this so the histogram titles do not overlap

We can see that we only have a very narrow range for which min_impurity_decrease is optimal, the param_max_features value probably should be kept at maximum and min_samples_split probably does not have a large influence on performance.

Visualize Tree

Scikitlearn allows us to export a decision tree graphic in GraphViz dot language format. We can interpret this format using PyDotPlus. In order for this to work we need to download and install GraphViz and put the installation folder into the PATH variable as well as pip installing the graphviz python package. See the documentation for installation instructions. For this tree we loose some of the interpretability because of the scaling and the boxcox transformation.

tree = random_search.best_estimator_

from sklearn.externals.six import StringIO  
from IPython.display import Image  
from sklearn.tree import export_graphviz
import pydotplus

dot_data = StringIO()

export_graphviz(tree
                , out_file = dot_data
                , filled = True
                , rounded = True
                , special_characters = True
                , feature_names = x.columns
                , class_names = ['alive', 'dead'] )

graph = pydotplus.graph_from_dot_data( dot_data.getvalue() )  

Image( graph.create_png() )

Feature Importance

pd.DataFrame({ 'features' : x.columns, 'importance': tree.feature_importances_}) \
    .sort_values('importance', ascending = False)

	features	importance
11	adult_male_True	0.730129
3	fare	0.136980
8	class_Third	0.132890
0	age	0.000000
12	deck_B	0.000000
19	embark_town_Southampton	0.000000
18	embark_town_Queenstown	0.000000
17	deck_G	0.000000
16	deck_F	0.000000
15	deck_E	0.000000
14	deck_D	0.000000
13	deck_C	0.000000
10	who_woman	0.000000
1	sibsp	0.000000
9	who_man	0.000000
7	class_Second	0.000000
6	embarked_S	0.000000
5	embarked_Q	0.000000
4	sex_male	0.000000
2	parch	0.000000
20	alone_True	0.000000

ROC Curve

Lets visualize a ROC curve for the tree with the best parameters and all 10x10x cross validation sets. Loosely inspired by this example code

Get tpr, fpr values for cv pairs

from sklearn.model_selection import cross_val_score
import sklearn

cv = sklearn.model_selection.RepeatedKFold(10,10)

tree = random_search.best_estimator_

results_df = pd.DataFrame( columns = ['fold', 'fpr', 'tpr', 'thresh', 'auc'] )


for i, split in enumerate(cv.split(x,y)):
    
    train, test = split
    
    tree = tree.fit(x.loc[train,:], y[train])
    
    pred_arr =  tree.predict_proba( x.loc[test,:] )
    # predict outputs probability for positive and negative outcome
    pred =  pd.DataFrame(pred_arr).loc[:,1]
    
    real = y[test]
    
    fpr, tpr, thresh = sklearn.metrics.roc_curve( y_true = real, y_score = pred)
    
    auc = sklearn.metrics.auc(fpr, tpr)
    
    rocs = pd.DataFrame({'fold': i, 'fpr': fpr, 'tpr': tpr , 'thresh': thresh, 'auc': auc})
    
    results_df = pd.concat([results_df, rocs], axis = 0)
    
    results_df_reind = results_df.reset_index( inplace = False ) \
        .rename(columns = {'index':'seq'})

results_df_reind.head(20)

c:\anaconda\envs\py36r343\lib\site-packages\ipykernel\__main__.py:30: FutureWarning: Sorting because non-concatenation axis is not aligned. A future version
of pandas will change to not sort by default.

To accept the future behavior, pass 'sort=False'.

To retain the current behavior and silence the warning, pass 'sort=True'.

	seq	auc	fold	fpr	thresh	tpr
0	0	0.800735	0	0.000000	1.957576	0.000000
1	1	0.800735	0	0.032787	0.957576	0.517241
2	2	0.800735	0	0.229508	0.490323	0.689655
3	3	0.800735	0	0.426230	0.352459	0.827586
4	4	0.800735	0	1.000000	0.100279	1.000000
5	0	0.877193	1	0.000000	0.945455	0.531250
6	1	0.877193	1	0.105263	0.475309	0.656250
7	2	0.877193	1	0.245614	0.325203	0.875000
8	3	0.877193	1	1.000000	0.105114	1.000000
9	0	0.887881	2	0.000000	0.946746	0.464286
10	1	0.887881	2	0.213115	0.472973	0.857143
11	2	0.887881	2	0.377049	0.357143	0.928571
12	3	0.887881	2	1.000000	0.108635	1.000000
13	0	0.845894	3	0.000000	1.951515	0.000000
14	1	0.845894	3	0.019231	0.951515	0.432432
15	2	0.845894	3	0.115385	0.452229	0.702703
16	3	0.845894	3	0.288462	0.338710	0.837838
17	4	0.845894	3	1.000000	0.098315	1.000000
18	0	0.916837	4	0.000000	0.944099	0.525000
19	1	0.916837	4	0.081633	0.442308	0.825000

results_gr = results_df_reind.groupby('seq') \
    .agg({'tpr':['mean', 'sem']
          , 'fpr':['mean', 'sem']
          , 'thresh':'mean' 
          } )  
    
results_gr

	tpr	fpr	thresh
	mean	sem	mean	sem	mean
seq
0	0.178960	0.024876	0.000000	0.000000	1.577290
1	0.571897	0.016556	0.074479	0.007452	0.794128
2	0.785816	0.012450	0.266459	0.018996	0.430423
3	0.926658	0.008574	0.650176	0.033806	0.244318
4	0.993480	0.003889	0.965127	0.019782	0.116393
5	1.000000	0.000000	1.000000	0.000000	0.104326

Plot ROC Curve

cmap = cm.get_cmap('Dark2')

fig = plt.figure( figsize=(5, 5) )


plt.plot( results_gr.fpr['mean'], results_gr.tpr['mean']
         , color = 'steelblue'
         , lw = 4 
         , label = 'mean')

plt.plot( [0,1],[0,1]
         , color = 'lightgrey'
         , linestyle='--' ) 

plt.fill_between( results_gr.fpr['mean']
                 , results_gr.tpr['mean'] - 2 * results_gr.tpr['sem']
                 , results_gr.tpr['mean'] + 2 * results_gr.tpr['sem']
                 , alpha = 0.5 
                 , label = 'CI95' )

plt.xlabel('False positive rate (fpr)')
plt.ylabel('True positive rate (tpr)')
plt.legend( loc = 'lower right')
plt.title('ROC Curve, AUC:{}'.format( results_df_reind.auc.unique().mean().round(3) ))

plt.show()

Moving from R to python - 4/7 - plotly

Fri, 24 Aug 2018 00:00:00 +0000

plotly

plotly can either render interactive graphs inside a jupyter notebook or save plots as html and open them inside a browser.

we import two plot functions from plotly.offline, plot for offline plotting and iplot for online plotting

Imports

# plotly
import plotly.plotly as py
import plotly.graph_objs as go
import plotly.tools as tls 
from plotly.offline import download_plotlyjs, init_notebook_mode, plot, iplot, iplot_mpl

# matplotlib, seaborn
import seaborn as sns
from matplotlib import cm
from matplotlib import pyplot as plt

Minimal Example

init_notebook_mode(connected = True)

trace = { 'x':[1,2], 'y':[1,2] }

data = [trace]

fig = go.Figure( data = data, layout = {} )

iplot(fig)

The code above would be sufficient to generate show an interactive java script graph in a jupyter notebook. However java script get lost when notebooks are converted first to .md and then to .html therefore we use an iframe to embedd the graph instead.

from IPython.display import HTML
HTML('<iframe width="900" height="800" frameborder="0" scrolling="no" src="//plot.ly/~datistics/1.embed"></iframe>')

Scatterplot

as in matplotlib we have to add each group of elements. This time we use a for loop to iterate ofer the unique species and then store the traces in the data list. For the colors we get the Brewer palettes from matplotlib importing cm (color maps). plotly excepts either named colors (‘red’, ‘green’, etc), HEX strings (‘#FF0000’) or rgba/rgb strings ‘rgba(255,0,0,1)’ as colors. Note that in python 3 the old % format operator for strings is deprecated.

df = sns.load_dataset('iris')

species = list( df.species.unique() )

colors_rgba = list( cm.Dark2( range(0,len(species),1) ) )
colors_str = [ 'rgba({},{},{},{})'.format(r,g,b,a) for r,g,b,a in colors_rgba ]

data = []

for i, spec  in enumerate( species, 0 ) :
    
    df_spec = df.loc[ df['species'] == spec, : ]
    
    trace = go.Scatter( x = df_spec.petal_length
                      , y = df_spec.petal_width
                      , mode = 'markers'
                      , name = spec
                      , marker = dict( color = colors_str[i] )
                      )    
    data.append(trace)
    

fig = go.Figure( data = data, layout = {} )

iplot(fig)

HTML('<iframe width="900" height="800" frameborder="0" scrolling="no" src="//plot.ly/~datistics/3.embed"></iframe>')

Convert `matplotlib` object to `plotly` object

In R we can convert most ggplot2 plots easily to plotly plots. We can do something similar in python.

there are a few tweaks to consider which we cannot cover all here, but check out this (tutorial)[http://nbviewer.jupyter.org/github/plotly/python-user-guide/blob/master/s6_matplotlylib/s6_matplotlylib.ipynb]

Minimal Scatterplot

fig = plt.figure()

plt.plot(list( df.petal_length ), list(df.petal_width), 'o' )

init_notebook_mode()

py_fig = tls.mpl_to_plotly(fig)

iplot_mpl(fig)

HTML('<iframe width="400" height="300" frameborder="0" scrolling="no" src="//plot.ly/~datistics/5.embed"></iframe>')

Scatterplot iteratively constructed

fig = plt.figure()

for i, spec  in enumerate( species, 0 ) :
    
    df_spec = df.loc[ df['species'] == spec, : ]
    
    plt.plot( list( df_spec.petal_length ), list(df_spec.petal_width), 'o' )


init_notebook_mode()

py_fig = tls.mpl_to_plotly(fig)

iplot_mpl(fig)

HTML('<iframe width="400" height="300" frameborder="0" scrolling="no" src="//plot.ly/~datistics/7.embed"></iframe>')

Scatterplot via `pandas`

Here we also add a legend, but the legend does not translate well to the plotly object, which we would have to edit manually to correct it.

# old school

fig, ax = plt.subplots()

df.loc[ df['species'] == 'setosa', : ].plot.scatter('petal_length', 'petal_width', label = 'setosa', color = 'blue', ax = ax)

# functional indexing
df.query('species == "versicolor"') \
    .plot.scatter( 'petal_length', 'petal_width'
                  , label = 'versicolor'
                  , color = 'orange' 
                  , ax = ax )
    
df.query('species == "virginica"') \
    .plot.scatter( 'petal_length', 'petal_width'
                  , label = 'virginica'
                  , color = 'green' 
                  , ax = ax ) 
    
init_notebook_mode()

py_fig = tls.mpl_to_plotly(fig)

# remove matplotlib default styling
iplot_mpl(fig, strip_style= True)

# keep matplotlib default styling
iplot_mpl(fig, strip_style= False)

C:\anaconda3\lib\site-packages\plotly\matplotlylib\renderer.py:445: UserWarning:

Dang! That path collection is out of this world. I totally don't know what to do with it yet! Plotly can only import path collections linked to 'data' coordinates

C:\anaconda3\lib\site-packages\plotly\matplotlylib\renderer.py:481: UserWarning:

I found a path object that I don't think is part of a bar chart. Ignoring.

HTML('<iframe width="400" height="300" frameborder="0" scrolling="no" src="//plot.ly/~datistics/9.embed"></iframe>')

HTML('<iframe width="400" height="300" frameborder="0" scrolling="no" src="//plot.ly/~datistics/9.embed"></iframe>')

Scatterplot via `seaborn`

Nice, but we loose the legend

sns.lmplot(x = 'petal_length', y = 'petal_width', data = df
           , hue = 'species'
           , fit_reg = False)

init_notebook_mode()

# we need to get the figure like this for some reason
fig = plt.gcf()

py_fig = tls.mpl_to_plotly(fig)

iplot_mpl(fig, strip_style= False)

HTML('<iframe width="400" height="400" frameborder="0" scrolling="no" src="//plot.ly/~datistics/13.embed"></iframe>')

Boxplot via `seaborn` from wide format

we loose the boxes

sns.boxplot(data=df)

init_notebook_mode()

# we need to get the figure like this for some reason
fig = plt.gcf()

py_fig = tls.mpl_to_plotly(fig)

iplot_mpl(fig, strip_style= False)

HTML('<iframe width="400" height="800" frameborder="0" scrolling="no" src="//plot.ly/~datistics/15.embed"></iframe>')

Boxplot via `seaborn` from long format

we still loose the boxes

df_melt = df.melt(value_vars=['sepal_length', 'sepal_width', 'petal_length', 'petal_width']
                 , id_vars = 'species')


sns.boxplot('variable', 'value', data = df_melt, hue = 'species')

init_notebook_mode()

# we need to get the figure like this for some reason
fig = plt.gcf()

py_fig = tls.mpl_to_plotly(fig)

iplot_mpl(fig, strip_style= False)

C:\anaconda3\lib\site-packages\plotly\matplotlylib\renderer.py:481: UserWarning:

I found a path object that I don't think is part of a bar chart. Ignoring.

HTML('<iframe width="400" height="300" frameborder="0" scrolling="no" src="//plot.ly/~datistics/17.embed"></iframe>')

Violin plots via `seaborn`

Does not work

# sns.violinplot('variable', 'value', data = df_melt
#               , hue = 'species'
#               , inner = None ## removes inner boxes
#               , zorder = 1
#              )
#
# init_notebook_mode()
#
# # we need to get the figure like this for some reason
# fig = plt.gcf()
#
# py_fig = tls.mpl_to_plotly(fig)
#
# iplot_mpl(fig, strip_style= False)

Factor Plot via seaborn

ax = sns.factorplot('variable', 'value', data = df_melt
              , hue = 'species'
              , col = 'species'
              , kind = 'box' )

ax.set_xticklabels(rotation = -45)

init_notebook_mode()

# we need to get the figure like this for some reason
fig = plt.gcf()

py_fig = tls.mpl_to_plotly(fig)

iplot_mpl(fig, strip_style= False)

C:\anaconda3\lib\site-packages\plotly\matplotlylib\renderer.py:516: UserWarning:

Looks like the annotation(s) you are trying 
to draw lies/lay outside the given figure size.

Therefore, the resulting Plotly figure may not be 
large enough to view the full text. To adjust 
the size of the figure, use the 'width' and 
'height' keys in the Layout object. Alternatively,
use the Margin object to adjust the figure's margins.

C:\anaconda3\lib\site-packages\plotly\matplotlylib\renderer.py:481: UserWarning:

I found a path object that I don't think is part of a bar chart. Ignoring.

HTML('<iframe width="900" height="300" frameborder="0" scrolling="no" src="//plot.ly/~datistics/19.embed"></iframe>')

Summary

plotly plots look great if we use the original synthax. Converting matplotlib objects to plotly format is not worth it. They plotly and the matplotlib synthax have in common that they are quite cumbersome and that we need to use loops or very long repetitive code to pupulate the graphs. seaborn tackles this by reducing looping and providing excellent default settings. However we will occasionally encounter glitches that we need to tackle by iteratively reconfiguring attributes of plot elements in matplotlib.

Moving from R to python - 3/7 - matplotlib and seaborn

Thu, 23 Aug 2018 00:00:00 +0000

Visualisations in `python`

In R I am used to work with a combination of ggplot2 and plotly. It seems that in python you have matplotlib which is fully integrated into pandas and you have seaborn which provides some pretty default setting for most of matplotlib’s standard graph types.

The main difference of matplotlib to ggplot2 is that it is optimised for wide formatted data tables while ggplot2 is optimised for data in the long format. In matplotlib we we woul iterate over every column that we would want to add to our plot while in ggplot we would define x and y measurements and then select a grouping or facetting variable.

`seaborn`

seaborn is built on top of matplotlib it provides some pretty decent defaults for matplotlib and has a stunning example gallery. seaborn supports long and wide format as input.

tutorial

import pandas as pd
from matplotlib import pyplot as plt
%matplotlib inline
import seaborn as sns

df = sns.load_dataset('iris')

Scatter Plots

`sns.lmplot()`

This is in fact a scatter plot function, we just have to turn of the regression fit.

sns.lmplot(x = 'petal_length', y = 'petal_width', data = df
           , hue = 'species'
           , fit_reg = False)

<seaborn.axisgrid.FacetGrid at 0x1fbd57e16a0>

Compare to `matplotlib` method `plt.scatter()`

is a lot more complicated, we have to add each species manually to an axes supplot object. This is very inconvenient.

# old school
ax = df.loc[ df['species'] == 'setosa', : ].plot.scatter('petal_length', 'petal_width', label = 'setosa', color = 'blue')

# functional indexing
ax = df.query('species == "versicolor"') \
    .plot.scatter( 'petal_length', 'petal_width'
                  , label = 'versicolor'
                  , color = 'orange' 
                  , ax = ax )
    
ax = df.query('species == "virginica"') \
    .plot.scatter( 'petal_length', 'petal_width'
                  , label = 'virginica'
                  , color = 'green' 
                  , ax = ax )

Boxplots

From wide format

here we cannot use hue to assign groups to colors

sns.boxplot(data=df)

<matplotlib.axes._subplots.AxesSubplot at 0x1fbd0345b00>

From short format

df_melt = df.melt(value_vars=['sepal_length', 'sepal_width', 'petal_length', 'petal_width']
                 , id_vars = 'species')


sns.boxplot('variable', 'value', data = df_melt, hue = 'species')

<matplotlib.axes._subplots.AxesSubplot at 0x1fbd4e51b00>

Overlay Plots

We can easily overlay plots as follows. The problem is that nevertheless the plot order is a bot messed up and there is no option to change the color of the box outline to black. Probably in order to fix this we would need to iterate over the box outlines and set their color attribute to ‘black’ which is a bit of a pain in the ass.

sns.violinplot('variable', 'value', data = df_melt
               , hue = 'species'
               , inner = None ## removes inner boxes
               , zorder = 1
              )

sns.boxplot('variable', 'value', data = df_melt
            , hue = 'species'
            , palette = ['#FFFFFF','#FFFFFF','#FFFFFF']
            , saturation = 1
            , zorder = -1 ## send boxplot to background
           )

<matplotlib.axes._subplots.AxesSubplot at 0x1fbd4fcb588>

Factor Plots (facetting)

ax = sns.factorplot('variable', 'value', data = df_melt
              , hue = 'species'
              , col = 'species'
              , kind = 'box' )

ax.set_xticklabels(rotation = -45)

<seaborn.axisgrid.FacetGrid at 0x1fbce3f4eb8>

Customize Plots with `matplotlib`

All seaborn plots can be tweaked and edited using matplolib, for example we can add a title and limit the range of the x-axis.

sns.lmplot(x = 'petal_length', y = 'petal_width', data = df
           , hue = 'species'
           , fit_reg = False)

plt.xlim(0,5)
plt.title('Look at my custom plot')

Text(0.5,1,'Look at my custom plot')

We can also fix the overlay plot from before

# instantiate axis and figure
fig, ax = plt.subplots()

ax = sns.violinplot('variable', 'value', data = df_melt
               , hue = 'species'
               , inner = None ## removes inner boxes
               , ax = ax
               , legend_out = True
              )

ax = sns.boxplot('variable', 'value', data = df_melt
            , hue = 'species'
            , palette = ['#FFFFFF','#FFFFFF','#FFFFFF']
            , saturation = 1
            , ax = ax
           )

# the boxes are drawn onto the axis as artist objects
for artist in ax.artists:
    artist.set_edgecolor('black')
    artist.set_zorder(1)
    
# the caps and whiskers as line objects
for line in ax.lines:
    line.set_color('black')

# get legend handles and labels before drawing legend
# use only 3 of them for legend
handles, labels = ax.get_legend_handles_labels()
plt.legend(handles[0:3], labels[0:3]
          , bbox_to_anchor=(1.05, 1), loc=2, borderaxespad=0.)

<matplotlib.legend.Legend at 0x1fbd5510ba8>

Multiple Plots

Having multiple plot as output from one code chunk in markdown is a bit tricky, in jupyter notebooks it is not.

sns.violinplot('variable', 'value', data = df_melt
               , hue = 'species'
               , inner = None ## removes inner boxes
              )
plt.show()

sns.boxplot('variable', 'value', data = df_melt
            , hue = 'species'
            , saturation = 1
           )

plt.show()

Summary

Personally I find pure matplotlib very cumbersome. However seaborn provides some nice defaults and supports the long data format. However if you want to plot something a bit more complicated then their showcase examples you get stuck tweaking the plots in matplotlib. There is a python version of the ggplot which I hear is quite popular and a newr package called altair which is also meant to work on long format. However there does not seem anything in the python world that beats pure ggplot2. I will rather keep using the original, in a later post I will show you how you can mix up R and python code in a single jupyter notebook and how to pass variables between the two environments.

Moving from R to python - 2/7 - pandas

Wed, 22 Aug 2018 00:00:00 +0000

`pandas` vs. tidyverse

In base R matrices and dataframes have row name indexes which in my opinion are a bit annoying, because they add another layer of complexity to your data transformation. You naturally have to keep your column names in order and they sort of make you care about maintain sensible row names as well. So in the tidyverse row names have been declared a deprecated feature.

In pandas on the other hand indexing is brought to another level and they let you have multiple layers of row and column indexes. As far as I can tell most data reshaping methods such as melt(), stack(), unstack() and pivot() expect that you assign a unique index to each row.

The advantage of multi indexing is apparently that it is easier to dice your data when you have more than 2 dimensions in you dataframe. However, I have been using R for almost two years now and never needed more than 2 dimensions in my dataframe.

Talking to data scientists that are well-experienced with pandas I learned that hardly no-one seems to be using multi-indexes.

The tidyverse is all about functional programming, pandas not so much. Nevertheless there are some possibilities which I will get into in this post.

pandas documentation

There is a comparison of the pandas and the R synthax in the pandas documentation

Sample Data

When looking at pandas example code. The example usually starts by generating a dtaframe with random values sampled from a normal distribution. Coming from R I am used to use acutal sample data like the iris data set which are part of base R. We can use pydataset to get similar sample data sets in python.

import seaborn as sns
import pandas as pd
import numpy as np

df = sns.load_dataset('iris')

print( df.head() )

   sepal_length  sepal_width  petal_length  petal_width species
0           5.1          3.5           1.4          0.2  setosa
1           4.9          3.0           1.4          0.2  setosa
2           4.7          3.2           1.3          0.2  setosa
3           4.6          3.1           1.5          0.2  setosa
4           5.0          3.6           1.4          0.2  setosa

Indexing

We have a numerical row index and the categorical variable Species with three unique values. In R we would convert this to a factor variable and there is something similar in python but it does not seem to be very pythonic to me.

df.index

RangeIndex(start=0, stop=150, step=1)

df.species.unique()

array(['setosa', 'versicolor', 'virginica'], dtype=object)

Let’s move Species to the index

df.set_index('species'
             , inplace = True ## modifies existing object
             , append = True ## keeps exisiting index
             )

df.head()

		sepal_length	sepal_width	petal_length	petal_width
	species
0	setosa	5.1	3.5	1.4	0.2
1	setosa	4.9	3.0	1.4	0.2
2	setosa	4.7	3.2	1.3	0.2
3	setosa	4.6	3.1	1.5	0.2
4	setosa	5.0	3.6	1.4	0.2

Let’s move Species back to the columns

df.reset_index( inplace = True
               , level = 'species' ## only reset Species
              )

df.head()

	species	sepal_length	sepal_width	petal_length	petal_width
0	setosa	5.1	3.5	1.4	0.2
1	setosa	4.9	3.0	1.4	0.2
2	setosa	4.7	3.2	1.3	0.2
3	setosa	4.6	3.1	1.5	0.2
4	setosa	5.0	3.6	1.4	0.2

Reshape Data

`stack()` and `unstack()`

Once we set the index we can bring the dataframe from long to wide format

df.set_index('species'
             , inplace = True ## modifies existing object
             , append = True ## keeps exisiting index
             )

df_short = df.stack()  

df_short.head()

   species              
0  setosa   sepal_length    5.1
            sepal_width     3.5
            petal_length    1.4
            petal_width     0.2
1  setosa   sepal_length    4.9
dtype: float64

df_long = df_short.unstack()

df_long.head()

		sepal_length	sepal_width	petal_length	petal_width
	species
0	setosa	5.1	3.5	1.4	0.2
1	setosa	4.9	3.0	1.4	0.2
2	setosa	4.7	3.2	1.3	0.2
3	setosa	4.6	3.1	1.5	0.2
4	setosa	5.0	3.6	1.4	0.2

`melt()` and `pivot_table()`

We can use melt() to select which columns we want to move into the long format. However, in the case of our dataset without an ID column we loose the information which value belongs to which row or individual plant.

df.reset_index( inplace = True
              , level = 'species') 

df_melt = df.melt( id_vars = 'species' )

df_melt.head()

	species	variable	value
0	setosa	sepal_length	5.1
1	setosa	sepal_length	4.9
2	setosa	sepal_length	4.7
3	setosa	sepal_length	4.6
4	setosa	sepal_length	5.0

df['ID'] = list( range( len(df) ) )

df.head()

	species	sepal_length	sepal_width	petal_length	petal_width	ID
0	setosa	5.1	3.5	1.4	0.2	0
1	setosa	4.9	3.0	1.4	0.2	1
2	setosa	4.7	3.2	1.3	0.2	2
3	setosa	4.6	3.1	1.5	0.2	3
4	setosa	5.0	3.6	1.4	0.2	4

df_melt = df.melt( id_vars = ['ID', 'species'] )

df_melt.head()

	ID	species	variable	value
0	0	setosa	sepal_length	5.1
1	1	setosa	sepal_length	4.9
2	2	setosa	sepal_length	4.7
3	3	setosa	sepal_length	4.6
4	4	setosa	sepal_length	5.0

df_pivot_table = df_melt.pivot_table(columns='variable'
                                        , values ='value'
                                        , index = [ 'ID', 'species']
                                        )

df_pivot_table.head()

	variable	petal_length	petal_width	sepal_length	sepal_width
ID	species
0	setosa	1.4	0.2	5.1	3.5
1	setosa	1.4	0.2	4.9	3.0
2	setosa	1.3	0.2	4.7	3.2
3	setosa	1.5	0.2	4.6	3.1
4	setosa	1.4	0.2	5.0	3.6

Functional programming with pandas

Functional prgramming in R for me has two main components. That is the pipe %>% operator that let’s you string a number of functions together without having to come up with names for all the intermediate steps and the purrr package which iterates over columns in a dataframe using them as arguments for a preassigned function whose results are stringed together to form a new column in the same dataframe.

Functional Programming in python is a bit frowned upon and in general it seems to be preferred to build new columns using iterations using for loops. Nevertheless functions like map, filter and apply exist and I find no problem in using them to a similar extend like I would with R

dot `.` and line breaks `\` can be used similar to the R pipe operator `%>%`

There are some implementations for pipes in python but to me they are really ugly because they require you to put the whole pipe sequence in brackets which kind of breaks up the whole python coding style which usually avoids having to put matching openeing and closing brackets spanning over multiple lines. However using the . operator and code line breaks \ signifier we can do something very similar to the pipes in R.

Let’s string together some commands we find in the pandas documentation R vs dplyr section.

df_trans = df.loc[ : , ['species', 'sepal_length', 'sepal_width']] \
    .query('sepal_length >= 4.7') \
    .groupby('species') \
    .mean() \
    .rename( axis = 'columns'
           , mapper = lambda x: 'mean_' + x ) \
    .assign( sepal_ratio_of_means = lambda x: x['mean_sepal_length'] / x['mean_sepal_width'] )
    
df_trans

	mean_sepal_length	mean_sepal_width	sepal_ratio_of_means
species
setosa	5.119512	3.504878	1.460682
versicolor	5.936000	2.770000	2.142960
virginica	6.588000	2.974000	2.215198

I think this reads really beautifully much better than the awkward pipe operator in R. There are some setbacks to this approach though.

there is no ‘.’ operator that allows you to reference the piped object from within the pipe
we have to use the full df[‘column’] reference to call a column vector and cannot use the unquoted column name as in dplyr
if we want to reference a column that has only been created inside the pipe we need to use a lambda function to reference it or start a new pipe.

Using multiple columns to calculate a new one

Using vectorized calculations

df_trans = df \
    .assign( petal_ratio = df['petal_width'] / df['petal_length']
           , sepal_ratio = df['sepal_width'] / df['petal_length']
           ) \
    .assign( overall_ratio = lambda x: x['petal_ratio'] / x['sepal_ratio'] )
    
    
df_trans.head()

	species	sepal_length	sepal_width	petal_length	petal_width	ID	petal_ratio	sepal_ratio	overall_ratio
0	setosa	5.1	3.5	1.4	0.2	0	0.142857	2.500000	0.057143
1	setosa	4.9	3.0	1.4	0.2	1	0.142857	2.142857	0.066667
2	setosa	4.7	3.2	1.3	0.2	2	0.153846	2.461538	0.062500
3	setosa	4.6	3.1	1.5	0.2	3	0.133333	2.066667	0.064516
4	setosa	5.0	3.6	1.4	0.2	4	0.142857	2.571429	0.055556

Using none-vectorized calculations

These would be cases in which we would use either map() or pmap() from the purrr package.

single column

We select the Series we want to transform and use the apply() method.

def range_sepal_length(x):
    if x > 5:
        return 'high'
    elif x > 4.6:
        return 'medium'
    else:
        return 'low'

df_trans = df \
    .assign( sepal_length_ranges = df['sepal_length'].apply(range_sepal_length) )
    
df_trans.head()

	species	sepal_length	sepal_width	petal_length	petal_width	ID	sepal_length_ranges
0	setosa	5.1	3.5	1.4	0.2	0	high
1	setosa	4.9	3.0	1.4	0.2	1	medium
2	setosa	4.7	3.2	1.3	0.2	2	medium
3	setosa	4.6	3.1	1.5	0.2	3	low
4	setosa	5.0	3.6	1.4	0.2	4	medium

multiple columns

We select from the dataframe only the columns that we want to use as arguments to our function call. We use apply() again but this time we change axis to row (axis = 1) which means that it provides all values from a row as arguments to a function call.

df_trans = df \
    .assign( smallest_value = df.loc[:,['sepal_length','sepal_width','petal_length','petal_width']]\
                               .apply( min, axis = 1) )
    
df_trans.head()

	species	sepal_length	sepal_width	petal_length	petal_width	ID	smallest_value
0	setosa	5.1	3.5	1.4	0.2	0	0.2
1	setosa	4.9	3.0	1.4	0.2	1	0.2
2	setosa	4.7	3.2	1.3	0.2	2	0.2
3	setosa	4.6	3.1	1.5	0.2	3	0.2
4	setosa	5.0	3.6	1.4	0.2	4	0.2

Aggregating, Grouping, Summarizing

One of the most commen things to do when working with tables is grouping and summarizing data. In dplyr and also in SQL we define our set of grouping columns and then define a set of new columns that contain aggregates of some of the old columns. There are two ways to do this in pandas

use a single window function on all none-grouped dataframe columns (see exapmple above)
use a set of different window functions on a limited set of columns (one window function per column)

One window function per column

We can either change existing column or create new ones which we have to add as empty columns via assign first. We can use whatever window function is implemented in pandas which we pass as strings in a dictionary or we can write lambda functions.

df_gr = df.loc[ : , ['species', 'sepal_length', 'sepal_width']]  \
    .assign( set_of_lengths = df['sepal_length'] ) \
    .groupby('species') \
    .aggregate( dict( sepal_length = 'mean'
                     , sepal_width = 'median'
                     , set_of_lengths = lambda x: set( round(x, 0) ) ) )
    
df_gr

	sepal_length	sepal_width	set_of_lengths
species
setosa	5.006	3.4	{4.0, 5.0, 6.0}
versicolor	5.936	2.8	{5.0, 6.0, 7.0}
virginica	6.588	3.0	{8.0, 5.0, 6.0, 7.0}

Note that the grouping column is automatically moved to the index, we can revert this as follows:

df_gr.reset_index()

	species	sepal_length	sepal_width	set_of_lengths
0	setosa	5.006	3.4	{4.0, 5.0, 6.0}
1	versicolor	5.936	2.8	{5.0, 6.0, 7.0}
2	virginica	6.588	3.0	{8.0, 5.0, 6.0, 7.0}

Other Data Transformation

There is a comparison of the pandas and the R synthax in the pandas documentation

query()

query() can be used like filter() in R. Alternatively we could use boolean indexing but that gets a bit cumbersome if you want to filter on more than one column.

However the string expression does not tolerate ‘.’ in the column names thus we replace them before.

better_columns = df.columns.str.replace('\.', '_')

better_columns

df.columns = better_columns

df.head()

df.query('petal_width > 0.2 \
          & sepal_length < 5')

	species	sepal_length	sepal_width	petal_length	petal_width	ID
6	setosa	4.6	3.4	1.4	0.3	6
41	setosa	4.5	2.3	1.3	0.3	41
45	setosa	4.8	3.0	1.4	0.3	45
57	versicolor	4.9	2.4	3.3	1.0	57
106	virginica	4.9	2.5	4.5	1.7	106

transform()

transform can be used like the group_by() - mutate() combination in R

df = df.assign( max_petal_len_species = lambda x: x.groupby('species').transform('max')['petal_length'] )
df.head()

	species	sepal_length	sepal_width	petal_length	petal_width	ID	max_petal_len_species
0	setosa	5.1	3.5	1.4	0.2	0	1.9
1	setosa	4.9	3.0	1.4	0.2	1	1.9
2	setosa	4.7	3.2	1.3	0.2	2	1.9
3	setosa	4.6	3.1	1.5	0.2	3	1.9
4	setosa	5.0	3.6	1.4	0.2	4	1.9

df.tail()

	species	sepal_length	sepal_width	petal_length	petal_width	ID	max_petal_len_species
145	virginica	6.7	3.0	5.2	2.3	145	6.9
146	virginica	6.3	2.5	5.0	1.9	146	6.9
147	virginica	6.5	3.0	5.2	2.0	147	6.9
148	virginica	6.2	3.4	5.4	2.3	148	6.9
149	virginica	5.9	3.0	5.1	1.8	149	6.9

reindex()

reindex() can be used to mimic the complete() function in R which can be used to expose implicitly missing values. We can use reindex to write a python version of complete()

def complete(df, cols):
        
    assert all( [ col in df.columns for col in cols] )

    df = df.set_index( cols, append = False )

    df_reset = df.reset_index()

    for i, name in enumerate(df.index.names):
        
        if i == 0:
            df_cross = pd.DataFrame( { name : df_reset[name].unique() } ) \
                .assign( key = 0 )
                
        else:
            df_cross_name = pd.DataFrame( { name : df_reset[name].unique() } ) \
                .assign( key = 0 )
                
            df_cross = df_cross.merge(df_cross_name, on = 'key')

    df_cross = df_cross.drop('key', axis = 1) \
        .set_index( df.index.names )
        
    df = df.reindex( df_cross.index )

    return df

df = pd.DataFrame( dict( numbers = [1,1,2,2,3,3,4,5]
                        , letters = ['A','B','A','B','A','B','A','B']) ) \
    .assign( value = np.random.randn(8) )

df

	numbers	letters	value
0	1	A	-0.866225
1	1	B	0.086730
2	2	A	-1.385008
3	2	B	1.729923
4	3	A	2.299604
5	3	B	0.271672
6	4	A	0.608976
7	5	B	-0.055641

complete(df, ['numbers', 'letters'])

		value
numbers	letters
1	A	-0.866225
B	0.086730
2	A	-1.385008
B	1.729923
3	A	2.299604
B	0.271672
4	A	0.608976
B	NaN
5	A	NaN
B	-0.055641

Moving from R to python - 1/7 - IDE

Tue, 21 Aug 2018 00:00:00 +0000

Introduction

Before I started with R I used to do quite a lot of python coding, however back in the days I was still using python 2.7 and was not really using a bona-fide data-centric workflow. In this series of notebooks I would like to document how my best-practices from using R can be carried over to the python universe.

IDE

R has with RStudio one obvious candidate for the best IDE to use with R. It has been developed just like R especially for maintaining a data-centric workflow. We have

plotting
interactive variable exploration
git integration
code completion
code documentation
package building
unit testing
markdown support
package and reproducibility management
execution of python code

python on the other hand has not been primarily developed for data science applications but has some great add-onn packages that can be used for scientific computation. There are a couple of python IDE that mimick the RStudio or the Matlab interface such as spyder and rodeo they support plotting and interactive variable exploration and have great code completion but they lack git and markdown support. The multi-purpose IDE pycharm however seems to support also the other features that RStudio is capable of. The professional version offers a scientific mode that also mimicks the RStudiointerface to some degree and that provides a decent project structure.

Here we will walk through the features mentioned above and see how they are implemented in pycharm

Ploting and interactive variable exploration

This requirement is fullfilled by all IDEs.

`git` integration

git integration is pretty straight forward with more options than in RStudio

Code Completion

Code completion in RStudio is pretty straight forward if you press Tab your namespace is sensibly searched for variables and functions that you might be typing. When you are typing a function it automatically displays the function documentation and which parameters the function is accepting. When you are defining the parameters of a function and you hit Tab RStudio will show you a list of all parameters of the function that you have not defined yet. You can then select the parameter from the list In python code completion is done by packages like jedi which seems to be what all the IDEs are using however code completion feels a bit different. spyder’s code completion looks and works exactly like the one of RStdio. pycharm has code completion but it tends to be cluttered with irrelevant object and method names when it does not find anything in the local namespace. In order to get the parameters of the function we also have to use an additional shortcut Ctrl + P (on windows). This only displays the parameter but we cannot select anything and thus have to type it ourselves.

Code Documentation

In R we can only document functions properly when writing a package using roxygen2 comments. We can call the documentation of a function using ? for example: ?myfunction(). This will display nicely as html in an additional viewer window. In order to generate consistent roxygen2 comments we can use the sinew package which will generate a sensible template from a finished function. Code examples can be copy pasted into the console or can be called via example()

In python we can use help(myfunction) or my_function.__doc__ to call the docstring associated with a function as console output. In pycharm we can place the caret inside the name of any function and press ctrl + Q in order to obtain a more well formated pop-up window containing the docstring.

The docstring in python can be written for any function and also makes sense outside of package writing. In pycharm we can insert a docstring template in any definition of a function by placing the caret in the function name of the definition and hit alt + enter to get to a menu in which one option is to insert a docstring template based on the parameters of the function.

There is a google style sheet for writing docstrings. link

Example code in the docstring should be started with >>>> and the line below should reflect the return value


>>>> len('foo')
3

Those examples can be run as unit tests by packages such as doctest, nose or unittests

see this blogpost

Package Building

package building and installation is very well integrated in RStudio, there is a steep learning curve but we can compile doumentation run tests and check all from within Rstudio and we have several option to create latex,pdf or html documentation.

In python package building seems to be pretty straight forward. you basically just need a __init__.py file in your directory and you have a package.

But there are some standards and nomenclature best practices that are described here.

Unit Testing

In R we use testthat and the integrated RStudio build tools to write and execute unit tests. In python the standard package seems to be unittest while there are a number of different packages for unit testing with a simpler synthax such as py.test. As already mentioned doctest will run python examples in your docstring.

See this blogpost for more information.

Package Management and Code Reproducibility

Code reproducibililty and portability is a big issue in R since there are so many packages that are constantly updated it is hard to track the dependencies for a specific analysis. Rstudio relies on packrat to ensure reproducibilty by saving all packages with each analysis or project which greatly increases the diskspace needed for a project. To tackle this I have actually written a package called (updateR)[https://github.com/erblast/updateR] resorting to a workflow where I archive R and all packages installed at this timepoint 4 times a year.

In python we seem to have different options. We can use pip freeze to create a requirements.txt file. We can use an anaconda environment which we can share with our analyis or we can use docker. All three options seem to be well supported by pycharm.

Markdown Support

RStudio and markdown go hand in hand. .Rmd are similar to .md files and can contain executable code chunks in either R or python and can be rendered into numereous formats such as word, slides, dashboards, html, ebooks, pdf and blogposts. .Rmd files are simple text files that contain a YAML header that defines the rendering options. RStudio even supports one click publishing of html content to Rpubs a publication platform for R code.

The python equivalent is jupyter notebook which uses the .ipynb format which is basically a json file. The json format does not easily display in a text editor so we always have to use an IDE of some sort to edit those files. The best method is to start a jupyter notebook kernel from the command line and connect to it via a web browser. This starts an easy to use webinterface that allows for editing .ipynb files and feels a bit like a .Rmd editing in RStudio. We have different cells and we can define the content of this cell as either being markdown or code of a variety of languages and we can see the output of the code being console output or a plot right below the cells. Pretty much the same as it is with RStudio.

The difference is in the file format, the Rmd format does not save any code output inside the file while .ipynb even stores binary information inside the document. This makes the changes in .ipynb files difficult to track for git and practically disqualifies them from being part of an entire analysis or deployment process. We can use Rmd files as actual bulding blocks of an entire analysis for which we can have html reporting for each steps that can be legible to none-coders. The use-case for jupyter notebook seems to be documentation of data exploration, tutorials or proof of concepts.

As far as I can tell we can edit .ipynb files inside pycharm but I had difficulties saving the changes that I had made to the notebooks and ended up loosing a lot of work. It seems as if in pycharm we need at least one code cell to save the file. I am more comfortable now working with the jupyter notebook webinterface.

Execution of foreign code

In RStudio we can use the reticulate package to execute python code and to convert python into R objects. We can also define python chunks inside Rmd documents. However we can only get python code completion or interactive variable exploration when we convert the python objects to R objects.

Both pycharm and jupyter notebook support R. We can probably use feather to pass dataframes between R and python.

Use jupyter notebooks to add posts to hugo blog

Sat, 11 Aug 2018 00:00:00 +0000

The file paths mentioned in this post only apply when the following configuration is set in your ‘.toml’ file:


[permalinks]
    post = "/:year/:month/:slug/"

hugo_jupyter

Starting this blog with blogdown and RStudio was pretty straight forward. I did not need to learn much about hugo which is the static website generator that I used and the project is well-documented. However I would also like to add posts from juypter notebooks which seems to be possible but let’s say less accessible. The tool I tried is hugo_jupyter which is supposed to work similar to blogdown. It runs a local server of the website which automatically rerenders the site if changes are made in relevant folders. The same can also be achieved if executing this simple hugo command inside the parent folder of your site (You have to open your browser and copy paste the displayed local host address though).


hugo server

hugo_jupyter will additionally watch a ./notebooks for changes in any jupyter notebooks it contains and convert them into .md to ./content/posts. For this you have to manually add the front-matter parameters title, date, slug, subtitle to the json metadata of your notebook using the jupyter GUI. Any other parameter that you add will not be passed to the .md file of your post. Any graphical output produced by any of your cells will be dropped and replaced by a link in the markdown format ![image_description](image_path). Then hugo will render your .md to .html automatically adding to the image path it finds in the markdown synthax like this yyyy/mm/slug/image_path. In order for this link to work we would need to place the image in ./static/yyyy/mm/slug.

All in all this would require a lot of manual steps after conversion of the notebook to .md format that I decided to only use the code of hugo_jupyter that converts the notebook to .md and make some changes to it so it also extracts images and places them in the appropriate ./static/yyyy/mm/slug path.

Feature	blogdown	hugo_jupyter
serve locally	yes	yes
encode front-matter parameters	yes	only 4
render graphical code output	yes	no
shortcode	as function	yes
markdown support	pandoc	hugo

(table generated with https://www.tablesgenerator.com/)

Modified workflow

I use the hugo server command in the terminal
I added a .python folder with the render_notebooks.py file that contains the code added below which I modified from hugo_jupyter to (i) render all output plots and put the .png files in the appropriate paths and (ii) add front-matter parameters by passing them as kwargs to the render function.
I can view all changes on my localhost server.
Upload changes to github
Netlify is linked to my github and automatically renders the whole page


from nbconvert import MarkdownExporter
from nbconvert.preprocessors import Preprocessor
from pathlib import Path
from traitlets.config import Config

import nbformat
import re

path = r'./notebooks/adding_posts_with_juypter.ipynb'

# here I customize some functions of the fabfile.py of the hugo_jupyter package

class CustomPreprocessor(Preprocessor):
    """Remove blank code cells and unnecessary whitespace."""2

    def preprocess(self, nb, resources):
        """
        Remove blank cells
        """
        for index, cell in enumerate(nb.cells):
            if cell.cell_type == 'code' and not cell.source:
                nb.cells.pop(index)
            else:
                nb.cells[index], resources = self.preprocess_cell(cell, resources, index)
        return nb, resources

    def preprocess_cell(self, cell, resources, cell_index):
        """
        Remove extraneous whitespace from code cells' source code
        """
        if cell.cell_type == 'code':
            cell.source = cell.source.strip()

        return cell, resources


def doctor(string: str) -> str:
    """Get rid of all the wacky newlines nbconvert adds to markdown output and return result."""
    post_code_newlines_patt = re.compile(r'(```)(\n+)')
    inter_output_newlines_patt = re.compile(r'(\s{4}\S+)(\n+)(\s{4})')

    post_code_filtered = re.sub(post_code_newlines_patt, r'\1\n\n', string)
    inter_output_filtered = re.sub(inter_output_newlines_patt, r'\1\n\3', post_code_filtered)

    return inter_output_filtered

def make_yaml_header(**kwargs):

    header = '---\n'

    for key, value in kwargs.items():
        if type(value) in [str, int , float ] :
            header += '{} : {}\n'.format(key, value)
        else:
            header += '{}: \n'.format(key)
            for item in value:
                header += '  - {}\n'.format(item)

    header += '---\n'

    return header


def notebook_to_markdown( path, date, slug, **kwargs ):
    """
    Convert notebook to Markdown format

    Args:
        path: str, path to notebook
        date: datestring in YYYY-MM-DD format
        slug: str, front-matter parameter, used to compose adress of blogpost
        kwargs: str, float, int, list, tuple, other front-matter parameters recommended to pass title

    """
    path_nb = Path(path)
    path_out = path_nb.parents[1] / 'static'/ date.split('-')[0] / date.split('-')[1] / slug
    path_post = path_nb.parents[1] / 'content/post/' / ( date + '-' + slug + '.md' )



    assert path_nb.exists()
    assert path_post.parent.exists()
    assert bool( re.match('[0-9]{4}-[0-1][0-9]-[0-3][0-9]', date) ), 'Incorrect date format, need YYYY-MM-DD'

    # convert notebook to .md----------------------------------------------------

    with Path(path).open() as fp:
        notebook = nbformat.read(fp, as_version=4)

    c = Config()
    c.MarkdownExporter.preprocessors = [CustomPreprocessor]
    markdown_exporter = MarkdownExporter(config=c)

    markdown, resources = markdown_exporter.from_notebook_node(notebook)
    md = doctor(markdown)

    yaml = make_yaml_header(  date = date
                             , slug = slug
                             , **kwargs)

    md = yaml + md

    with path_post.open('w') as f:
        f.write(md)
    # write outputs as png --------------------------------------------------------

    if 'outputs' in resources.keys():
        if not path_out.exists():
            path_out.mkdir(parents=True)
        for key in resources['outputs'].keys():
            with (path_out / key).open('wb') as f:
                f.write( resources['outputs'][key] )



if __name__ == "__main__":

    path = r'../notebooks/adding_posts_with_juypter.ipynb'

    notebook_to_markdown( path = r'../notebooks/adding_posts_with_juypter.ipynb'
                          , date = '2018-08-11'
                          , slug = 'post_with_jupyter'
                          , title = 'Adding posts as jupyter notebooks'
                          , author = 'Bjoern Koneswarakantha'
                          , categories = ['R vs. python','blogging']
                          , tags = ['R vs. python','hugo', 'python', 'R', 'hugo', 'hugo_jupyer']
                          , summary = 'Blogging with jupyter notebooks, hugo_jupyter and some tweaking. Comparison to\
                           R and blogdown'
                          , thumbnailImagePosition = 'left'
                          , thumbnailImage = 'https://gitlab.eurecom.fr/zoe-apps/pytorch/avatar'
                         )

POC Graphical output

from matplotlib import pyplot as plt
%matplotlib inline
import seaborn as sns

df = sns.load_dataset('iris')


sns.lmplot(x = 'petal_length', y = 'petal_width', data = df
           , hue = 'species'
           , fit_reg = False)

<seaborn.axisgrid.FacetGrid at 0x251a9439518>

POC shortcode

Look we can use shortcode to wrap text in tags

or higlight text

Joyplot Logo

Fri, 03 Aug 2018 00:00:00 +0000

Welcome to my data science blog datistics where I will gradually post all the vignettes and programming POC’s that I have written over the past two years. Most of them can be already found in my github repository.

I am using blogdown to create this blog and using R and RStudio. However I have recently taken up python programming for work again, so my first challenge will be to also add posts in the form of jupyter notebooks.

As for my first post I will add the code that I use to generate my page logo in R.

Tweedie distributions

We often encounter distributions that are not normal, I often encounter poisson and gamma distributions as well as distributions with an inflated zero value all of which belong to the family of tweedie distributions. When changing the parameter $p$ which can take values between 0 and 2 ( p == 0 gaussian, p == 1 poisson, p == 2 gamma) we can sample the different tweedie distributions.

the tweedie package only supports values for 1 <= p <= 2

suppressWarnings({
  suppressPackageStartupMessages({
    require(tidyverse)
    require(tweedie)
    require(ggridges)
  })
})

df = tibble( p = seq(1,2,0.1) ) %>%
  mutate( data = map(p, function(p) rtweedie(n = 500
                                             , mu = 1
                                             , phi = 1
                                             , power = p )  ) ) %>%
  unnest(data)

df %>%
  ggplot( aes(x = data) )+
    geom_histogram(bins = 100, fill = '#77773c') +
    facet_wrap(~p, scales = 'free_y')

Joyplot

We will now transform these distributions into a joyplot in the style of the Joy Divisions album Unknown Pleasurs cover art.

![](https://www.officialmerchandise.com/assets/products/57683/large/joy-division-unknown-pleasures-poster-p8(1).jpg)

We will use ggridges formerly known as ggjoy.

joyplot = function(df){

  p = df %>%
    ggplot(aes(x = data, y = as.factor(p), fill = ..x.. ) ) +
      geom_density_ridges_gradient( color = 'white'
                                   , size = 0.5
                                   , scale = 3) +
      theme( panel.background = element_rect(fill = 'white')
             , panel.grid = element_blank()
             , aspect.ratio = 1
             , axis.title = element_blank()
             , axis.text = element_blank()
             , axis.ticks = element_blank()
             , legend.position = 'none') +
     xlim(-1,5) +
     scale_fill_viridis_c(option = "inferno") 
  
  return(p)

}

joyplot(df)

## Picking joint bandwidth of 0.236

I order to distribute them a bit better over the x-axis we will transform them using a sine wave pattern.

df = tibble( p = seq(1,2,0.05)
             , rwn = row_number(p)
             , sin = sin(rwn) ) %>%
  mutate( data = map(p, function(p) rtweedie(500
                                             , mu = 1
                                             , phi = 1
                                             , power = p)  ) ) %>%
  unnest(data) %>%
  filter( data <= 4) %>%
  mutate( data = ( 4 * abs( sin(rwn) ) ) - data )


joyplot(df)

## Picking joint bandwidth of 0.205

Mon, 01 Jan 0001 00:00:00 +0000

Cheat Sheet

docker CLI

The official tutorial is very dev-ops heavy most of it is not so important for datascience extracts from official tutorial

This R docker tutorial is much better

List Docker CLI commands

docker
docker container --help

Display Docker version and info

docker --version
docker version
docker info

Execute Docker image

docker run hello-world
docker run --rm -it sample_image /bin/bash # run in interactive mode and quit container when exiting attach shell
docker run --rm -it -v local_path:container_path sample_image /bin/bash  # attach volume

List Docker images

docker image ls

List Docker containers (running, all, all in quiet mode)

docker container ls
docker container ls --all
docker container ls -aq

Managing Images and running containers

docker build -t friendlyhello .  # Create image using this directory's Dockerfile
docker run -p 4000:80 friendlyhello  # Run "friendlyhello" mapping port 4000 to 80
docker run -d -p 4000:80 friendlyhello         # Same thing, but in detached mode
docker container ls                                # List all running containers
docker container ls -a             # List all containers, even those not running
docker container stop <hash>           # Gracefully stop the specified container
docker container kill <hash>         # Force shutdown of the specified container
docker container rm <hash>        # Remove specified container from this machine
docker container rm $(docker container ls -a -q)         # Remove all containers
docker image ls -a                             # List all images on this machine
docker image rm <image id>            # Remove specified image from this machine
docker image rm $(docker image ls -a -q)   # Remove all images from this machine
docker login             # Log in this CLI session using your Docker credentials
docker tag <image> username/repository:tag  # Tag <image> for upload to registry
docker push username/repository:tag            # Upload tagged image to registry
docker run username/repository:tag                   # Run image from a registry

Dockerfile

Install linux modules

&& chains two commands
\ continue command on next line
-y passes yes to user input RUN apt-get update && \ apt-get -y install build-essential && \ apt-get -y install openssh-client

Install into conda environment

FROM continuumio/miniconda3:latest #conda/miniconda3 does not work

# install ssh and compilers
RUN apt-get update && \
    apt-get -y install build-essential && \
    apt-get -y install openssh-client

RUN conda update -n base -c defaults conda
RUN conda install git

RUN conda create --name my_env python=3.6
RUN conda install -n my_env pyarrow=0.11.1
ENV PATH /opt/conda/envs/my_env/bin:$PATH
RUN /bin/bash -c "source activate idwimpala"
RUN pip install hdfs==2.1.0

RUN, CMD, ENTRYPOINT

RUN executes line, execution can be stored in image
ENTRYPOINT executes when container starts up
CMD default command when container starts up, can be overwritten

blogpost

Run RStudio

-p 8787:8787 defines port
-e PASSWORD='123' sets environmen variable PASSWORD before running container
-d detached mode, runs in background
/init initiates RStudio docker run --rm -it -p 8787:8787 -v local_path:/home/rstudio/container_path -e PASSWORD='123' -d rocker/verse /init

Run jupyter notebook

Deploy Services

specifications such as remote image location, ressource allocation and number of instances can be specified in docker-compose.yml

docker swarm init         # needs to be executed in order to deploy the services
docker stack ls                                            # List stacks or apps
docker stack deploy -c <composefile> <appname>  # Run the specified Compose file
docker service ls                 # List running services associated with an app
docker service ps <service>                  # List tasks associated with an app
docker inspect <task or container>                   # Inspect task or container
docker container ls -q                                      # List container IDs
docker stack rm <appname>                             # Tear down an application
docker swarm leave --force      # Take down a single node swarm from the manager

Mon, 01 Jan 0001 00:00:00 +0000

Level of detail expressions

It happens often that you want to create calculated fields that aggregate data but you need them to be independent of the dimensions in your figure. You can do this by using the level of detail expressions.

Fixed

Use a fixed set of dimensions

Total population per country:

{FIXED continent, country : SUM(population) }

Exclude

Ignore a specific dimension in the vis

Total population per country:

{EXCLUDE city : SUM(population)}

Include

Add a specific dimension in the vis

Total population per country:

{INCLUDE country : SUM(population)}

Min(1) trick

http://datapsientist.blogspot.com/2014/10/tableau-trick-for-work-min1.html

Creating a Parameter Control to Sort By Dimension

https://kb.tableau.com/articles/howto/creating-a-parameter-control-to-sort-by-dimension

Send parameters from workbook to workbook via URL

https://community.tableau.com/thread/202493

Workaround for Nested Containers

https://community.tableau.com/thread/178426