In novisci/stype: Statistical Types

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

library(stype)
library(dplyr)
library(riskimator)
set.seed(122)

Workflows as part of a data.frame

ctimes <- list(
   v_continuous_nonneg(c(5, 6, 10, Inf, 1, Inf, 19), 
                internal_name = "cA"),
   v_continuous_nonneg(c(4, 1, 15, Inf, Inf, Inf, 21), 
                internal_name = "cB")
)

otimes <- list(
  v_continuous_nonneg(c(2, 6, 11, 12, Inf, Inf, 25),
               internal_name = "oA"),
  v_continuous_nonneg(c(1, Inf, 10, Inf, Inf, Inf, 23), 
               internal_name = "oB")
)

est_cph <- function(x, df){
  cph <- survival::coxph(
    formula = as_Surv(x, censor_as_event = TRUE) ~ as_canonical(x3),
    data = df)
  exp(-predict(cph, type = "expected"))
}

weight_rcensored_outcomes <- function(dt){
  over_map(dt, rcensored_l %.% outcome_l, function(x) {
    over(x, data_summary_l, function(ds) { 
      c(ds, list(crisk = cumrisk(x, w = est_cph, df = dt)))
    })
  })
}

smd_covariates_by_treatments <- function(dt){

  # update data summary for each covariate tagged with baseline
  over_map(dt, covariate_l %.% tag_l("baseline"), function(z) {

    # compute SMD for each exposure variable in the dataset
    smds <- purrr::map(
      .x = view(dt, exposure_l),
      .f = ~ smd::smd(x = as_canonical(z), g = as_canonical(.x)) 
    )

    # update the data_summary
    over(z, data_summary_l, function(d) { c(d, smds = list(smds)) })
  })
}



df <- 
tibble(
  x1 = v_rcensored(outcomes = otimes, censors = ctimes, end_time = 15,
                  context  = context(purpose = purpose(study_role = "outcome"))),
  x2 = v_rcensored(outcomes = otimes[[1]], end_time = 15,
                   context  = context(purpose = purpose(study_role = "outcome"))),

  x3 = v_binary(as.logical(rbinom(7, 1, prob = 0.5)),
                context  = context(purpose = purpose(study_role = "covariate",
                                                     tags = "baseline"))),

  x4 = v_nominal(factor(LETTERS[rbinom(7, 1, prob = 0.5) + 1L]),
                context  = context(purpose = purpose(study_role = "exposure"))),

  x5 = v_binary(as.logical(rbinom(7, 1, prob = 0.5)),
                context  = context(purpose = purpose(study_role = "covariate",
                                                     tags = "baseline"))),

  x6 = v_nominal(factor(LETTERS[rbinom(7, 1, prob = 0.5) + 4L]),
                context  = context(purpose = purpose(study_role = "exposure"))),
)

dt <- analysis(
  df,
  modifiers = list(weight_rcensored_outcomes, smd_covariates_by_treatments)
)

dt %>% get_data_summary()
dt[1:6, ] %>% get_data_summary()

view(df$x1, data_summary_l)
view(dt$x1, data_summary_l)
view(dt[1:6, ]$x1, data_summary_l)
view(dt$x2, data_summary_l)
view(dt$x3, data_summary_l)
view(dt[1:5, ]$x5, data_summary_l)