welch16
2019-09-10 fad2d50d4084cd610692123903bbe72cb6abc2fc
commit | author | age
fad2d5 1
W 2 library(magrittr)
3 library(tidyverse)
4
5 library(BiocParallel)
6
7 mp = MulticoreParam(workers = 8)
8
9 results_dr <- here::here("results/2019_08_15_Emca4_interactions/predictions")
10
11 all_files = results_dr %>% list.files(pattern = "rds", full.names = TRUE)
12
13
14 results <- tibble( file = all_files) %>% 
15     mutate(
16         aux = basename(all_files),
17         type = case_when(
18             str_detect(aux, "model_fit") ~ "model",
19             str_detect(aux, "train_metrics") ~ "train_metrics",
20             str_detect(aux, "test_metrics") ~ "test_metrics",
21             str_detect(aux, "train_prob") ~ "train_prob",
22             str_detect(aux, "test_prob") ~ "test_prob"
23         )) 
24
25 results %<>% 
26     mutate(
27         aim = if_else(str_detect(aux,"aim1"),"aim1","aim2"),
28         geno = if_else(str_detect(aux,"geno"),"genotype","risk_allele"),
29         cov = str_split(aux,"_cvfold") %>% map_chr(1) %>% 
30             str_split("\\_") %>% map_chr( ~ paste(.[-1],collapse = "_")),
31         adaptive = if_else(str_detect(file,"adaptive"),"yes","no"),
32         fit = case_when(
33             str_detect(aux,"decision") ~ "decision_trees",
34             str_detect(aux,"random") ~ "random_forests",
35             str_detect(aux,"logis") ~ "logistic_regression",
36             str_detect(aux,"elasti") ~ "elastic_nets",
37             str_detect(aux,"lasso") ~ "lasso_regression",
38             str_detect(aux,"ridge") ~ "ridge_regression"),
39         aux = str_split(aux,"\\_"),
40         time = map_chr(aux, ~ .[nchar(.) == 1]),
41         cv_fold = map_chr(aux, ~ .[nchar(.) == 2]))
42
43 results  %<>% select(-aux)  %>% spread(type,file)
44
45
46 read_filelist <- function(files,mp)
47 {
48     bplapply(files, readRDS, BPPARAM = mp)
49 }
50
51 results  %<>%   
52     mutate_at(vars(contains("prob")), list( ~ read_filelist(.,mp))) %>% 
53     mutate_at(vars(contains("metric")), list( ~ read_filelist(.,mp)))
54
55
56 auc <- function(prob_estimate,mp)
57 {
58     estimate_df <- bplapply(prob_estimate, 
59         function(x)yardstick::roc_auc(x,status,prob),BPPARAM = mp)
60     map_dbl(estimate_df,".estimate")
61 }
62
63 aupr <- function(prob_estimate,mp)
64 {
65     estimate_df <- bplapply(prob_estimate, 
66         function(x)yardstick::pr_auc(x,status,prob),BPPARAM = mp)
67     map_dbl(estimate_df,".estimate")
68 }
69
70 results %<>% 
71     mutate_at(vars(contains("prob")), 
72         list( ~ auc(.,mp),~ aupr(.,mp))) 
73
74
75 results  %>% saveRDS(file.path(dirname(results_dr),"2019_08_15_predictive_results.rds"))
76