post-covid-cvd-methods/analysis/generate_subsample/generate_subsample.R at main · opensafely/post-covid-cvd-methods · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
# ------------------------------------------------------------------------------
#
# generate_subsample.R
#
# This file generates a smaller cohort (10% of original sample size)
# for use when fitting computationally expensive models e.g. LASSO
#
# Arguments:
#  - cohort - string, defines which of three opensafely cohorts to describe
#             (prevax, vax, unvax)
#  - preex - boolean/string, defines preexisting conditions
#            for the replication preex = FALSE always
#            ("All", TRUE, or FALSE)
#
# Returns:
#  - dataframe of patient data, random 10% subsample of input data
#    (output/generate_subsample/input_{cohort}_subsample.rds)
#
# Authors: Emma Tarmey
#
# ------------------------------------------------------------------------------

# Refresh local R session ------------------------------------------------------
print("Refresh local R session")

rm(list=ls())


# Load libraries ---------------------------------------------------------------
print("Load libraries")

library(magrittr)
library(here)
library(dplyr)
library(fs)


# Define generate_subsample output folder ---------------------------------------
print("Creating output/generate_subsample output folder")

generate_subsample_dir <- "output/generate_subsample/"
dir_create(here::here(generate_subsample_dir))


# Source common functions ------------------------------------------------------
print("Source common functions")

source("analysis/utility.R")


# Specify arguments ------------------------------------------------------------
print("Specify arguments")

args <- commandArgs(trailingOnly = TRUE)
print(length(args))

if (length(args) == 0) {
  # default argument values
  cohort  <- "prevax"
  preex   <- "All"
} else {
  # YAML arguments
  cohort  <- args[[1]]

  # optional argument
  if (length(args) < 2) {
    preex <- "All"
  } else {
    preex <- args[[2]]
  } # allow an empty input for the preex variable
}


# Load data --------------------------------------------------------------------
print("Load data")

df <- readr::read_rds(paste0(
  "output/dataset_clean/input_",
  cohort,
  "_clean.rds"
))


# Sanity check all covariate data types ----------------------------------------
print("Sanity check all covariate data types")

df$cov_bin_ami   <- as.factor(df$cov_bin_ami)   # outcome
df$cov_bin_sahhs <- as.factor(df$cov_bin_sahhs) # outcome
df$cov_bin_covid <- as.factor(df$cov_bin_covid) # exposure

df$cov_num_age       <- as.numeric(df$cov_num_age)
df$cov_cat_sex       <- as.factor(df$cov_cat_sex)
df$cov_cat_ethnicity <- as.factor(df$cov_cat_ethnicity)
df$cov_cat_imd       <- as.factor(df$cov_cat_imd)
df$cov_cat_smoking   <- as.factor(df$cov_cat_smoking)

df$cov_bin_carehome      <- as.factor(df$cov_bin_carehome)
df$cov_bin_hcworker      <- as.factor(df$cov_bin_hcworker)
df$cov_bin_dementia      <- as.factor(df$cov_bin_dementia)
df$cov_bin_liver_disease <- as.factor(df$cov_bin_liver_disease)
df$cov_bin_ckd           <- as.factor(df$cov_bin_ckd)

df$cov_bin_cancer       <- as.factor(df$cov_bin_cancer)
df$cov_bin_hypertension <- as.factor(df$cov_bin_hypertension)
df$cov_bin_diabetes     <- as.factor(df$cov_bin_diabetes)
df$cov_bin_obesity      <- as.factor(df$cov_bin_obesity)
df$cov_bin_copd         <- as.factor(df$cov_bin_copd)

df$cov_bin_depression <- as.factor(df$cov_bin_depression)
df$cov_bin_stroke_all <- as.factor(df$cov_bin_stroke_all)
df$cov_bin_other_ae   <- as.factor(df$cov_bin_other_ae)
df$cov_bin_vte        <- as.factor(df$cov_bin_vte)
df$cov_bin_hf         <- as.factor(df$cov_bin_hf)

df$cov_bin_angina        <- as.factor(df$cov_bin_angina)
df$cov_bin_lipidmed      <- as.factor(df$cov_bin_lipidmed)
df$cov_bin_antiplatelet  <- as.factor(df$cov_bin_antiplatelet)
df$cov_bin_anticoagulant <- as.factor(df$cov_bin_anticoagulant)
df$cov_bin_cocp          <- as.factor(df$cov_bin_cocp)

df$cov_bin_hrt      <- as.factor(df$cov_bin_hrt)
df$strat_cat_region <- as.factor(df$strat_cat_region)


# Generate 10% subsample ------------------------------------------------------
print("Generate 10% subsample")

set.seed(2026) # fixed for reproducibility, no overlapping RNG sequences so fine to handle in this way
sample_size  <- nrow(df)
selection    <- sample(x = c(1:sample_size), size = ceiling(sample_size/10), replace = FALSE)
subsample_df <- df[selection, ]


# Save subsample --------------------------------------------------------------
print("Save subsample")

saveRDS(
  subsample_df,
  file = paste0(generate_subsample_dir, "input_", cohort, "_clean_subsample.rds"),
  compress = TRUE
)