Posts

library(tidyverse)
library(fabricatr)      # to fabricate fake data

library(finalfit)       # to create final output tables
library(flextable)      # to create/modify/format tables for reporting and publications
library(ftExtra)        # extensions for flextable package
library(officer)        # to manipulate Word document        

set.seed(2022)
group_remdecivir <- fabricate(
  N = 279,
  age = round(rnorm(N, mean = 50, sd = 15)),
  bmi = round(rnorm(N, mean = 31.2, sd = 6.7), 1),
  dur_symptoms = round(runif(N, min = 1.5, max = 8)),
  dur_since_sirs = round(runif(N, min = 0, max = 4)),
  viral_load = round(rnorm(N, mean = 6.31, sd = 1.75), 3),
  sex = draw_binary(N = N, prob = 0.53),
  residence_usa = draw_binary(N = N, prob = .946),
  white = draw_binary(N = N, prob = 0.817),
  black = draw_binary(N = N, prob = 0.072),
  american_indian_native = draw_binary(N = N, prob = 0.054),
  asian_native = draw_binary(N = N, prob = 0.025),
  hispanic = draw_binary(N = N, prob = 0.441),
  other = draw_binary(N = N, prob = 0.011),
  diabetes = draw_binary(N = N, prob = .62),
  obesity = draw_binary(N = N, prob = .552),
  ht = draw_binary(N = N, prob = .495),
  lung = draw_binary(N = N, prob = .24),
  cancer = draw_binary(N = N, prob = .043),
  cardiac = draw_binary(N = N, prob = .072),
  immune = draw_binary(N = N, prob = .05),
  kidney = draw_binary(N = N, prob = .025),
  liver = draw_binary(N = N, prob = .004),
  residence_nursing = draw_binary(N = N, prob = 0.029),
  group = "Remdesivir") %>%
  as_tibble()


set.seed(2022)
group_placebo <- fabricate(
  N = 283,
  age = round(rnorm(N, mean = 51, sd = 15)),
  bmi = round(rnorm(N, mean = 30.8, sd = 5.8), 1),
  dur_symptoms = round(runif(N, min = 2, max = 8)),
  dur_since_sirs = round(runif(N, min = 0, max = 5)),
  viral_load = round(rnorm(N, mean = 6.28, sd = 1.79), 3),
  sex = draw_binary(N = N, prob = 0.512),
  residence_usa = draw_binary(N = N, prob = .943),
  white = draw_binary(N = N, prob = 0.792),
  black = draw_binary(N = N, prob = 0.078),
  american_indian_native = draw_binary(N = N, prob = 0.074),
  asian_native = draw_binary(N = N, prob = 0.025),
  hispanic = draw_binary(N = N, prob = 0.396),
  other = draw_binary(N = N, prob = 0.007),
  diabetes = draw_binary(N = N, prob = .611),
  obesity = draw_binary(N = N, prob = .551),
  ht = draw_binary(N = N, prob = .459),
  lung = draw_binary(N = N, prob = .24),
  cancer = draw_binary(N = N, prob = .064),
  cardiac = draw_binary(N = N, prob = .085),
  immune = draw_binary(N = N, prob = .032),
  kidney = draw_binary(N = N, prob = .039),
  liver = draw_binary(N = N, prob = .004),
  residence_nursing = draw_binary(N = N, prob = 0.025),
  group = "Placebo"
  ) %>%
  as_tibble() 





combined_dataset <- bind_rows(group_remdecivir, group_placebo)  %>% 
  mutate (patient_id = paste0("P_", row_number())) %>% 
  select(patient_id, group, everything(), -ID) %>% 
  mutate(group = fct_relevel(group, "Remdesivir", "Placebo"),
         age_category_over60 = factor(if_else(age >= 60, "yes", "no")),
         age_category_under18 = factor(if_else(age < 18, "yes", "no"))) %>% 
  mutate_if(is.integer, as.factor) %>% 
  mutate(sex = fct_recode(sex, "female" = "0", "male" = "1")) %>% 
  mutate(across((residence_usa:residence_nursing), ~ fct_recode(., "no" = "0", "yes" = "1"))) %>% 
  add_column(age_category = "yes",      # I added three columns. This is my trick to add empty rows into the table. We can merge them in flextable step. 
             race_ethnic = "yes",       
             comorbidities = "yes")     

explanatory <-  combined_dataset %>% 
  select(age, age_category, age_category_over60, age_category_under18, sex, residence_usa, race_ethnic, white:other, bmi,comorbidities, diabetes:residence_nursing, dur_symptoms:viral_load) %>% 
  names()

dependent <- "group"

finalfit_table <- combined_dataset %>% 
  mutate(across(c(age_category_over60, age_category_under18, residence_usa:residence_nursing), ~fct_relevel(., "yes", "no"))) %>%       # This is my trick to remove "no" rows in the flextable step.
  summary_factorlist(dependent = dependent, 
                     explanatory = explanatory,
                     p = FALSE,
                     cont_nonpara = c(26, 27),
                     total_col = TRUE,
                     add_col_totals = TRUE,
                     include_col_totals_percent = FALSE,
                     col_totals_prefix = "N=")

finalfit_table %>% 
        knitr::kable() %>% kableExtra::kable_styling()

modified_finalfit_table <- finalfit_table %>% 
  dplyr::mutate(across((Remdesivir:Total), ~ if_else(label == "Total N", paste0("(", . , ")"), .))) %>%   
  dplyr::mutate(across((Remdesivir:Total), ~ if_else(label %in% c("age", "bmi", "viral_load"), str_replace_all(., " \\(", "±"), . ))) %>% 
  dplyr::mutate(across((Remdesivir:Total), ~ if_else(label %in% c("age", "bmi", "viral_load"), str_replace_all(., "\\)", ""), . ))) %>% 
  filter(levels != "no") %>% 
  filter(levels != "male") %>% 
  mutate(levels = if_else(levels %in% c("Median (IQR)", "Mean (SD)"), " ", levels),
         across(Remdesivir:Total, ~str_replace_all(., " to ", "-")), # , "Total" were removed.
         across(Remdesivir:Total, ~str_replace_all(., "\\.0", "")), # , "Total" were removed.
         levels = str_remove_all(levels, "yes"),
         label = fct_recode(label,
                             "Characteristic" = "Total N",
                             "Age—yr" = "age",
                             "≥60 yr" = "age_category_over60",
                             "<18 yr" = "age_category_under18",
                             "Female sex — no. (%)" = "sex",
                             "Residence in the United States — no. (%)" = "residence_usa",
                             "White" = "white",
                             "Black" = "black",
                             "American Indian or Alaska Native" = "american_indian_native",
                             "Asian, Native Hawaiian, or Pacific Islander" = "asian_native",
                             "Hispanic or Latinx" = "hispanic",
                             "Other" = "other",
                             "Body-mass index" = "bmi",
                             "Diabetes mellitus" = "diabetes",
                             "Obesity" = "obesity",
                             "Hypertension" = "ht",
                             "Chronic lung disease" = "lung",
                             "Current cancer" = "cancer",
                             "Cardiovascular or cerebrovascular disease" = "cardiac",
                             "Immune compromise" = "immune",
                             "Chronic kidney disease, mild or moderate" = "kidney",
                             "Chronic liver disease" = "liver",
                             "Residence in skilled nursing facility — no. (%)" = "residence_nursing",
                             "Median duration of symptoms before first infusion (IQR) — days" = "dur_symptoms",
                             "Median time since RT-PCR confirmation of SARS-CoV-2 (IQR) — days" = "dur_since_sirs",
                             "Mean SARS-CoV-2 RNA nasopharyngeal viral load — log~10~ copies/ml" = "viral_load")) %>% 
  select(-levels)
  
modified_finalfit_table %>% 
        knitr::kable() %>% kableExtra::kable_styling()

set_flextable_defaults(
        font.family = "Open Sans",
        font.size = 10,
        padding.bottom = 3, 
        padding.top = 3,
        padding.left = 3,
        padding.right = 3)

table_1 <- modified_finalfit_table %>% 
  flextable() %>% 
  add_header_lines("[Table 1.]{color=#BD272E} Demographic and Clinical Characteristics of the Patients at Baseline.") %>% 
  align(part = "all", align = "center", j=2:ncol(modified_finalfit_table)) %>% 
  border_remove(.) %>% 
  hline(part="header", i = 1) %>% 
  hline_bottom(part="body", border = fp_border(color="black")) %>%
  hline_top(part="header", border = fp_border(color="black")) %>% 
  vline_left(border = fp_border(color="black")) %>%
  vline_right(border = fp_border(color="black")) %>% 
  bold(part="header", i = 1:2) %>% 
  bold(part="body", i = 1) %>% 
  padding( part = "body", j = 1, i = c(4,5,9:14,17:25), padding.left = 30) %>% 
  bg(bg = "#FFF8E7", part = "body", i=seq(2,nrow(modified_finalfit_table), 2)) %>% 
  bg(bg = "#F5EFE7", part = "header", i=1) %>% 
  colformat_md(j = 1,  part = "body") %>% 
  colformat_md(j = 1, part = "header") %>% 
  set_header_labels(i = 1, "label"=" ") %>% 
  compose(i = 3, j=1:ncol(modified_finalfit_table),  value = as_paragraph("Age category — no. (%)"), part = "body") %>% 
  merge_h (i = 3) %>% 
  compose(i = 8, j=1:ncol(modified_finalfit_table),  value = as_paragraph("Race or ethnic group — no. (%)"), part = "body") %>% 
  merge_h (i = 8) %>% 
  compose(i = 16, j=1:ncol(modified_finalfit_table),  value = as_paragraph("Coexisting conditions — no. (%)"), part = "body") %>% 
  merge_h (i = 16) %>% 
  footnote(part = "header", i = 1, value = as_paragraph("Plus–minus values are means ±SD. IQR denotes interquartile range, RT-PCR reverse transcriptase–polymerase chain reaction, and SARS-CoV-2 severe acute respiratory syndrome coronavirus 2."), ref_symbols = "\U2606") %>% 
  footnote(part = "body", i = 7, j = 1, value = as_paragraph("Race and ethnic group were reported by the patients. Patients could have had more than one race or ethnic group."), ref_symbols = "\U2020") %>% 
  footnote(part = "body", i = 29, j = 1, value = as_paragraph("Data are shown for the virologic analysis set, which is defined in the statistical analysis plan (available with the protocol at NEJM.org): 215 of 279 patients (77.1%) in the remdesivir group and 213 of 283 patients (75.3%) in the placebo group."), ref_symbols = "\U2021") %>% 
  hline_bottom(part="footer", border = fp_border(color="black")) %>% 
  width(j = 1, 8.6, "cm") %>% 
  width(j = 2:4, 3.6, "cm") %>% 
  fix_border_issues() 

# table_1

sect_properties_portrait <- prop_section(
  page_size = page_size(orient = "portrait",
    width = 11.7, height = 8.3),
  type = "nextPage",
  page_margins = page_mar()
)

save_as_docx(table_1,
             path = here::here("content", "blog", "2022-02-07-week-4",paste0("table_1", ".docx")),
              pr_section = sect_properties_portrait)