Eksperiment

1 PA Decline/00master.R

@@ -46,7 +46,7 @@ source("data_format.R")
 library(tidyverse)
 library(glue)
 library(patchwork)
-library(ggdendro)
+# library(ggdendro)
 library(corrplot)
 library(gt)
 library(gtsummary)
@@ -106,7 +106,6 @@ ls<-lapply(1:ncol(X_tbl_f),function(x){
 
 ts_e<-tbl_summary(X_tbl,
                   missing = "no",
-                  # label = ls[-length(ls)], ## Removing the last, as this is output
                   value = list(where(is.factor) ~ "2"),
                   type = list(mrs_0 ~ "categorical",
                               mrs_1 ~ "categorical"),
@@ -124,6 +123,55 @@ ts_rtf <- file("table1_overall.RTF", "w")
 writeLines(ts%>%as_rtf(), ts_rtf)
 close(ts_rtf)
 
+## ====================================================================
+# Baseline table - by PASE group
+## ====================================================================
+
+ts_q <- X_tbl |> 
+  select(vars) |> 
+  mutate(pase_0_cut = factor(quantile_cut(pase_0, groups = 4)[[1]],ordered = TRUE)) |> 
+  select(-pase_6,-pase_0) |> 
+  tbl_summary(missing = "no",
+                  by="pase_0_cut",
+                  value = list(where(is.factor) ~ "2"),
+                  type = list(mrs_0 ~ "categorical"),
+                  statistic = list(all_continuous() ~ "{median} ({p25};{p75}) [{min},{max}]")
+) |> 
+  add_overall() |> 
+  add_n
+
+ts_q
+
+
+
+## ====================================================================
+# Six months PASE: Bivariate and multivariate analyses
+## ====================================================================
+
+dta_lmreg <- X_tbl |> 
+  select(vars) |> 
+  mutate(mrs_0=factor(ifelse(mrs_0==1,1,2))) 
+
+Hmisc::label(dta_lmreg$mrs_0) <- "Pre-stroke mRS >0"
+
+uv_reg <- tbl_uvregression(data=dta_lmreg, 
+                           method=lm, 
+                           y="pase_6",
+                           show_single_row = where(is.factor),
+                           estimate_fun = ~style_sigfig(.x,digits = 3),
+                           pvalue_fun = ~style_pvalue(.x, digits = 3)
+)
+
+mu_reg <- dta_lmreg |>
+  lm(formula=pase_6~.,data=_) |> 
+  tbl_regression(show_single_row = where(is.factor),
+                 estimate_fun = ~style_sigfig(.x,digits = 3),
+                 pvalue_fun = ~style_pvalue(.x, digits = 3)
+  )|> 
+  add_n()
+
+tbl_merge(list(uv_reg,mu_reg))
+
 
 ## ====================================================================
 ## 
@@ -192,6 +240,7 @@ writeLines(com_coef_tbl%>%as_rtf(), com_coef_rtf)
 close(com_coef_rtf)
 
 
+
 ## ====================================================================
 ## 
 ## Model performance

1 PA Decline/data_format.R

@@ -71,35 +71,33 @@ dta <- export %>%
 # Step 5: Ordering variables
 ## ====================================================================
 
+vars <- c("age",
+          "male_sex",
+          "civil",
+          "pase_0",
+          "smoker",
+          "alc",
+          "afli",
+          "hypertension",
+          "diabetes",
+          "pad",
+          "ami",
+          "tci",
+          "mrs_0",
+          "nihss_c",
+          "any_rep",
+          "rtreat",
+          "pase_6")
 
-dta<-select(dta,c(age,
+dta<-select(dta,c(vars, 
-                  male_sex,
+                  "mrs_1",
-                  civil,
+                  "mfi_gen_1",
-                  pase_0,
+                  "mfi_phys_1",
-                  smoker,
+                  "mfi_act_1",
-                  # smoker_prev,
+                  "mfi_mot_1",
-                  alc,
+                  "mfi_men_1",
-                  afli,
+                  "mdi_1", 
-                  hypertension,
+                  "who5_score_1"
-                  diabetes,
-                  pad,
-                  ami,
-                  tci,
-                  mrs_0,
-                  nihss_c,
-                  # thrombolysis,
-                  # thrombechtomy,
-                  any_rep,
-                  rtreat,
-                  pase_6, 
-                  mrs_1,
-                  mfi_gen_1,
-                  mfi_phys_1,
-                  mfi_act_1,
-                  mfi_mot_1,
-                  mfi_men_1,
-                  mdi_1, 
-                  who5_score_1
                   ))
 
 ## ====================================================================
@@ -114,10 +112,10 @@ var.labels = c(age="Age",
                smoker="Daily or occasinally smoking",
                # smoker_prev="Previous habbit of smoking",
                alc="More alcohol than recommendation",
-               afli="Known AFIB",
+               afli="AFIB",
-               hypertension="Known hypertension",
+               hypertension="Hypertension",
-               diabetes="Known diabetes",
+               diabetes="Diabetes",
-               pad="Known PAD",
+               pad="PAD",
                ami="Previous MI",
                tci="Previous TIA",
                mrs_0="Pre-stroke mRS  [-1]",
@@ -193,7 +191,7 @@ X_tbl <- X_tbl|>
                                  detail.lst=FALSE),
          pase_drop_fac=factor(ifelse(pase_6_cut==1&pase_0_cut!=1,"yes","no")))
 
-label(X_tbl) = as.list(var.labels[match(names(X_tbl), names(var.labels))])
+Hmisc::label(X_tbl) = as.list(var.labels[match(names(X_tbl), names(var.labels))])
 
 # Setting final primary output from "pout"
 if (pout=="decl_rel"){

2 Longterm/grotta_bars.R

@@ -20,3 +20,7 @@ grottaBar(x,groupName="Group",
 dta |> select(-c("mrs_0","mrs_1")) |> generic_stroke(group = "rtreat", score = "mrs_6", variables = c("hypertension","diabetes","civil"))
 
 library(stRoke)
+cc<-dta[complete.cases(dta),]
+talos <- cc[sample(1:nrow(cc),200),] |> select(-mrs_0)
+
+save(talos,file="talos.rda")