Back to Index

Scale

• Normalize data

x <- c(1, 3, 4, NA, 9, 11, 5, 2, 3, 4)
y <- c(2, 5, 3, 5, NA, 0, NA, 2, 3, 9)
dt <- data.table(x, y)

sdt <- scale(dt)

sdt %>% prt()

dt2 <- cbind(dt, sdt)
colnames(dt2) <- c("x", "y", "x_scaled", "y_scaled")

dt2 %>% prt() %>%
    add_footnote(paste0("Center: ", paste0(attr(sdt, "scaled:center"), collapse = ", "), "\n"
                      , "Scale: ", paste0(attr(sdt, "scaled:scale"), collapse = ", ")))

Single Impute Continuous Variables

• Add a variable flagging if it is missing (indicator of imputed values)

add_isna <- function(x) {
  invisible(factor(ifelse(is.na(x), 0, 1), levels = c(0, 1)))
}


missing_indicator <- function(data, name){
  name_imputed <- paste0(name, "_imputed")
  name_is_impuated <- paste0(name, "_is_impuated")
  data[[name_imputed]] <- Wu::single_impute(data[[name]])
  data[[name_is_impuated]] <- factor(is.na(data[[name]]), levels = c(FALSE, TRUE), labels = c(0, 1))
  invisible(data)
}


dt3 <- missing_indicator(dt, "x")

imp_median <- function(x){
  y <- x
  ## y[is.na(y)] <- mean(x, na.rm = TRUE)
  y[is.na(y)] <- median(x, na.rm = TRUE)
  invisible(y)
}


dt3 %>% prt()

Add Missing Indicator to Categorical Variables

dt <- data.table(var1 = factor(sample(c("A", "B", as.character(NA)), size = 20, replace = TRUE), levels = c("A", "B")))

addno <- function(x, na_ind = "Not Obtained"){
  y <- factor(ifelse(is.na(x), na_ind, as.character(x)), levels = c(levels(x), na_ind))
}


dt <- dt[, var1_addno := addno(var1)]

dt %>% prt()

Model Matrix

n <- 10
dt <- data.table(var1 = rnorm(n)
               , var2 = rnorm(n)
               , var3 = sample(c("A", "B", "C"), size = n, replace = TRUE))

Predictors <- c("var1", "var2", "var3")
frml <- Wu::wu_formula(outcome = "", predictors = Predictors)
mmx <- model.matrix.lm(frml, data = dt, na.action = "na.pass")

mmx %>% prt()

set.seed(123456)
seq1 <- sample(c("Train", "Test"), size = nrow(dt), replace = TRUE, prob = c(0.8, 0.2))

Multiple Imputation

x <- c(1, 3, 4, NA, 9, 11, 5, 2, 3, 4)
y <- c(2, 5, 3, 5, NA, 0, NA, 2, 3, 9)
dt <- data.table(x, y, noise1 = rnorm(10), noise2 = rnorm(10))
dt <- dt[, x2 := x * (2 + noise1 / 5)
         ][, y2 := y * 2 + noise2 / 3]

library(mice)
set.seed(123456)
dt_im <- mice(dt, m = 2, method = "pmm")

iter imp variable 1 1 x y x2 y2 1 2 x y x2 y2 2 1 x y x2 y2 2 2 x y x2 y2 3 1 x y x2 y2 3 2 x y x2 y2 4 1 x y x2 y2 4 2 x y x2 y2 5 1 x y x2 y2 5 2 x y x2 y2

dm <- complete(dt_im, "long")

dm %>% prt()

R sessionInfo

sessionInfo()

R version 4.2.0 (2022-04-22) Platform: x86_64-pc-linux-gnu (64-bit) Running under: Ubuntu 20.04.3 LTS

Matrix products: default BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0 LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0

locale: [1] LC_CTYPE=C.UTF-8 LC_NUMERIC=C LC_TIME=C.UTF-8
[4] LC_COLLATE=C.UTF-8 LC_MONETARY=C.UTF-8 LC_MESSAGES=C.UTF-8
[7] LC_PAPER=C.UTF-8 LC_NAME=C LC_ADDRESS=C
[10] LC_TELEPHONE=C LC_MEASUREMENT=C.UTF-8 LC_IDENTIFICATION=C

attached base packages: [1] stats graphics grDevices utils datasets methods base

other attached packages: [1] mice_3.14.0 Wu_0.0.0.9000 flexdashboard_0.6.0 [4] lme4_1.1-30 Matrix_1.4-0 mgcv_1.8-38
[7] nlme_3.1-152 png_0.1-7 scales_1.2.0
[10] nnet_7.3-16 labelled_2.9.1 kableExtra_1.3.4
[13] plotly_4.10.0 gridExtra_2.3 ggplot2_3.3.6
[16] DT_0.24 tableone_0.13.2 magrittr_2.0.3
[19] lubridate_1.8.0 dplyr_1.0.9 plyr_1.8.7
[22] data.table_1.14.2 rmdformats_1.0.4 knitr_1.39

loaded via a namespace (and not attached): [1] httr_1.4.4 sass_0.4.2 tidyr_1.2.0 jsonlite_1.8.0
[5] viridisLite_0.4.0 splines_4.2.0 bslib_0.4.0 assertthat_0.2.1 [9] highr_0.9 yaml_2.3.5 backports_1.4.1 pillar_1.8.1
[13] lattice_0.20-45 glue_1.6.2 digest_0.6.29 rvest_1.0.2
[17] minqa_1.2.4 colorspace_2.0-3 htmltools_0.5.3 survey_4.1-1
[21] pkgconfig_2.0.3 broom_1.0.0 haven_2.5.0 bookdown_0.28
[25] purrr_0.3.4 webshot_0.5.3 svglite_2.1.0 tibble_3.1.8
[29] generics_0.1.3 ellipsis_0.3.2 cachem_1.0.6 withr_2.5.0
[33] klippy_0.0.0.9500 lazyeval_0.2.2 cli_3.3.0 survival_3.2-13
[37] evaluate_0.16 fansi_1.0.3 MASS_7.3-54 forcats_0.5.1
[41] xml2_1.3.3 tools_4.2.0 hms_1.1.1 mitools_2.4
[45] lifecycle_1.0.1 stringr_1.4.0 munsell_0.5.0 compiler_4.2.0
[49] jquerylib_0.1.4 systemfonts_1.0.4 rlang_1.0.4 grid_4.2.0
[53] nloptr_2.0.3 rstudioapi_0.13 htmlwidgets_1.5.4 rmarkdown_2.14
[57] boot_1.3-28 gtable_0.3.0 DBI_1.1.3 R6_2.5.1
[61] fastmap_1.1.0 utf8_1.2.2 stringi_1.7.8 Rcpp_1.0.9
[65] vctrs_0.4.1 tidyselect_1.1.2 xfun_0.32