diff --git a/ccn2019.rev3.Rmd b/ccn2019.rev3.Rmd index f44f094..ba1b312 100644 --- a/ccn2019.rev3.Rmd +++ b/ccn2019.rev3.Rmd @@ -47,16 +47,17 @@ group_by(participant, block, condition) %>% mutate(n = ifelse(condition=='2-back',2,3)) %>% mutate(stimulus_type = with_lures(stimulus, stimulus_type, n)) %>% - mutate(tl = slide2_dbl(stimulus_type, rt, ~length(which(lag(.x)=='target'))/length(which(!is.na(lag(.y)))), .partial=T,.size=window_size), - ll = slide2_dbl(stimulus_type, rt, ~length(which(lag(.x)=='lure'))/length(which(!is.na(lag(.y)))), .partial=T, .size=window_size), - sl = slide_dbl(stimulus_type, ~sum(sort(table(lag(.x)), decreasing = T)[1:2]) - 1, .partial=T, .size=window_size), - ul = slide_dbl(stimulus, ~max(table(lag(.)))-1, .partial=T, .size=window_size), - vl = slide_dbl(stimulus, ~length(unique(lag(.))), .partial=T, .size=window_size), - al = slide2_dbl(correct, rt, ~length(which(lag(.x)))/length(which(!is.na(lag(.y)))), .partial=T, .size=window_size), - sl = ifelse(is.na(sl), 0, sl), + mutate(tl = slide2_dbl(lag(stimulus_type), lag(rt), ~length(which(.x=='target'))/length(which(!is.na(.y))), .partial=T,.size=window_size), + ll = slide2_dbl(lag(stimulus_type), lag(rt), ~length(which(.x=='lure'))/length(which(!is.na(.y))), .partial=T, .size=window_size), + sl = slide_dbl(lag(stimulus_type), ~sum(sort(table(.x), decreasing = T)[1:2]) - 1, .partial=T, .size=window_size), + ul = slide_dbl(lag(stimulus), ~max(table(.x))-1, .partial=T, .size=window_size), + vl = slide_dbl(lag(stimulus), ~n_distinct(.x,na.rm=T), .partial=T, .size=window_size), + al = slide2_dbl(correct, rt, ~length(which(.x))/length(which(!is.na(.y))), .partial=T, .size=window_size), + sl = ifelse(is.na(sl), NA, sl), tl = ifelse(is.na(tl), NA, tl), ll = ifelse(is.na(ll), NA, ll), - al = ifelse(is.na(al), NA, al) + al = ifelse(is.na(al), NA, al), + ul = ifelse(is.na(ul) | is.infinite(ul), NA, ul) ) %>% nest(.key='local_stats') %>% #mutate(stimuli = map(local_stats, ~paste0(.x$stimulus,collapse = ''))) %>% @@ -65,22 +66,28 @@ mutate(l = map_dbl(local_stats, ~length(which(.x$stimulus_type=='lure')))) %>% mutate(s = map_dbl(local_stats, ~sum(sort(table(.x$stimulus), decreasing = T)[1:2]) - 1)) %>% mutate(v = map_dbl(local_stats, ~length(unique(.x$stimulus)))) %>% - mutate(dp = map_dbl(local_stats, - ~length(which(.x$stimulus_type=="target" & .x$correct)) - - length(which(.x$stimulus_type!="target" & !.x$correct)))) %>% - mutate(cr = map_dbl(local_stats, - ~-(length(which(.x$stimulus_type=="target" & .x$correct==T)) + - length(which(.x$stimulus_type!="target" & .x$correct==F)))/2)) %>% + # mutate(dp = map_dbl(local_stats, + # ~length(which(.x$stimulus_type=="target" & .x$correct)) - + # length(which(.x$stimulus_type!="target" & !.x$correct)))) %>% + # mutate(cr = map_dbl(local_stats, + # ~-(length(which(.x$stimulus_type=="target" & .x$correct==T)) + + # length(which(.x$stimulus_type!="target" & .x$correct==F)))/2)) %>% mutate(local_stats = map(local_stats, ~.x %>% select(-trial,-choice))) %>% #mutate(local_stats = map(local_stats, ~.x %>% select(-trial,-stimulus,-choice))) %>% ungroup() %>% select(-participant,-block,-condition) %>% - unnest(local_stats) + unnest(local_stats) %>% + mutate(correct = factor(as.numeric(correct), labels=c("NO","YES"))) %>% + mutate(stimulus = factor(stimulus)) %>% + mutate(stimulus_type = factor(stimulus_type)) + +save(seqs,file=here("notebooks/data/nback_seqs.Rd")) #! =============================================== #! visualize correlations #DEBUG inspect_cor(seqs, show_plot = T) -save(seqs,file=here("notebooks/data/nback_seqs.Rd")) + + ``` ```{r remove_highly_correlated_predictors} diff --git a/ccn2019.rev3.Rmd b/ccn2019.rev3.Rmd index f44f094..ba1b312 100644 --- a/ccn2019.rev3.Rmd +++ b/ccn2019.rev3.Rmd @@ -47,16 +47,17 @@ group_by(participant, block, condition) %>% mutate(n = ifelse(condition=='2-back',2,3)) %>% mutate(stimulus_type = with_lures(stimulus, stimulus_type, n)) %>% - mutate(tl = slide2_dbl(stimulus_type, rt, ~length(which(lag(.x)=='target'))/length(which(!is.na(lag(.y)))), .partial=T,.size=window_size), - ll = slide2_dbl(stimulus_type, rt, ~length(which(lag(.x)=='lure'))/length(which(!is.na(lag(.y)))), .partial=T, .size=window_size), - sl = slide_dbl(stimulus_type, ~sum(sort(table(lag(.x)), decreasing = T)[1:2]) - 1, .partial=T, .size=window_size), - ul = slide_dbl(stimulus, ~max(table(lag(.)))-1, .partial=T, .size=window_size), - vl = slide_dbl(stimulus, ~length(unique(lag(.))), .partial=T, .size=window_size), - al = slide2_dbl(correct, rt, ~length(which(lag(.x)))/length(which(!is.na(lag(.y)))), .partial=T, .size=window_size), - sl = ifelse(is.na(sl), 0, sl), + mutate(tl = slide2_dbl(lag(stimulus_type), lag(rt), ~length(which(.x=='target'))/length(which(!is.na(.y))), .partial=T,.size=window_size), + ll = slide2_dbl(lag(stimulus_type), lag(rt), ~length(which(.x=='lure'))/length(which(!is.na(.y))), .partial=T, .size=window_size), + sl = slide_dbl(lag(stimulus_type), ~sum(sort(table(.x), decreasing = T)[1:2]) - 1, .partial=T, .size=window_size), + ul = slide_dbl(lag(stimulus), ~max(table(.x))-1, .partial=T, .size=window_size), + vl = slide_dbl(lag(stimulus), ~n_distinct(.x,na.rm=T), .partial=T, .size=window_size), + al = slide2_dbl(correct, rt, ~length(which(.x))/length(which(!is.na(.y))), .partial=T, .size=window_size), + sl = ifelse(is.na(sl), NA, sl), tl = ifelse(is.na(tl), NA, tl), ll = ifelse(is.na(ll), NA, ll), - al = ifelse(is.na(al), NA, al) + al = ifelse(is.na(al), NA, al), + ul = ifelse(is.na(ul) | is.infinite(ul), NA, ul) ) %>% nest(.key='local_stats') %>% #mutate(stimuli = map(local_stats, ~paste0(.x$stimulus,collapse = ''))) %>% @@ -65,22 +66,28 @@ mutate(l = map_dbl(local_stats, ~length(which(.x$stimulus_type=='lure')))) %>% mutate(s = map_dbl(local_stats, ~sum(sort(table(.x$stimulus), decreasing = T)[1:2]) - 1)) %>% mutate(v = map_dbl(local_stats, ~length(unique(.x$stimulus)))) %>% - mutate(dp = map_dbl(local_stats, - ~length(which(.x$stimulus_type=="target" & .x$correct)) - - length(which(.x$stimulus_type!="target" & !.x$correct)))) %>% - mutate(cr = map_dbl(local_stats, - ~-(length(which(.x$stimulus_type=="target" & .x$correct==T)) + - length(which(.x$stimulus_type!="target" & .x$correct==F)))/2)) %>% + # mutate(dp = map_dbl(local_stats, + # ~length(which(.x$stimulus_type=="target" & .x$correct)) - + # length(which(.x$stimulus_type!="target" & !.x$correct)))) %>% + # mutate(cr = map_dbl(local_stats, + # ~-(length(which(.x$stimulus_type=="target" & .x$correct==T)) + + # length(which(.x$stimulus_type!="target" & .x$correct==F)))/2)) %>% mutate(local_stats = map(local_stats, ~.x %>% select(-trial,-choice))) %>% #mutate(local_stats = map(local_stats, ~.x %>% select(-trial,-stimulus,-choice))) %>% ungroup() %>% select(-participant,-block,-condition) %>% - unnest(local_stats) + unnest(local_stats) %>% + mutate(correct = factor(as.numeric(correct), labels=c("NO","YES"))) %>% + mutate(stimulus = factor(stimulus)) %>% + mutate(stimulus_type = factor(stimulus_type)) + +save(seqs,file=here("notebooks/data/nback_seqs.Rd")) #! =============================================== #! visualize correlations #DEBUG inspect_cor(seqs, show_plot = T) -save(seqs,file=here("notebooks/data/nback_seqs.Rd")) + + ``` ```{r remove_highly_correlated_predictors} diff --git a/data/nback_seqs.Rd b/data/nback_seqs.Rd index a1112bb..50e4b86 100644 --- a/data/nback_seqs.Rd +++ b/data/nback_seqs.Rd Binary files differ diff --git a/ccn2019.rev3.Rmd b/ccn2019.rev3.Rmd index f44f094..ba1b312 100644 --- a/ccn2019.rev3.Rmd +++ b/ccn2019.rev3.Rmd @@ -47,16 +47,17 @@ group_by(participant, block, condition) %>% mutate(n = ifelse(condition=='2-back',2,3)) %>% mutate(stimulus_type = with_lures(stimulus, stimulus_type, n)) %>% - mutate(tl = slide2_dbl(stimulus_type, rt, ~length(which(lag(.x)=='target'))/length(which(!is.na(lag(.y)))), .partial=T,.size=window_size), - ll = slide2_dbl(stimulus_type, rt, ~length(which(lag(.x)=='lure'))/length(which(!is.na(lag(.y)))), .partial=T, .size=window_size), - sl = slide_dbl(stimulus_type, ~sum(sort(table(lag(.x)), decreasing = T)[1:2]) - 1, .partial=T, .size=window_size), - ul = slide_dbl(stimulus, ~max(table(lag(.)))-1, .partial=T, .size=window_size), - vl = slide_dbl(stimulus, ~length(unique(lag(.))), .partial=T, .size=window_size), - al = slide2_dbl(correct, rt, ~length(which(lag(.x)))/length(which(!is.na(lag(.y)))), .partial=T, .size=window_size), - sl = ifelse(is.na(sl), 0, sl), + mutate(tl = slide2_dbl(lag(stimulus_type), lag(rt), ~length(which(.x=='target'))/length(which(!is.na(.y))), .partial=T,.size=window_size), + ll = slide2_dbl(lag(stimulus_type), lag(rt), ~length(which(.x=='lure'))/length(which(!is.na(.y))), .partial=T, .size=window_size), + sl = slide_dbl(lag(stimulus_type), ~sum(sort(table(.x), decreasing = T)[1:2]) - 1, .partial=T, .size=window_size), + ul = slide_dbl(lag(stimulus), ~max(table(.x))-1, .partial=T, .size=window_size), + vl = slide_dbl(lag(stimulus), ~n_distinct(.x,na.rm=T), .partial=T, .size=window_size), + al = slide2_dbl(correct, rt, ~length(which(.x))/length(which(!is.na(.y))), .partial=T, .size=window_size), + sl = ifelse(is.na(sl), NA, sl), tl = ifelse(is.na(tl), NA, tl), ll = ifelse(is.na(ll), NA, ll), - al = ifelse(is.na(al), NA, al) + al = ifelse(is.na(al), NA, al), + ul = ifelse(is.na(ul) | is.infinite(ul), NA, ul) ) %>% nest(.key='local_stats') %>% #mutate(stimuli = map(local_stats, ~paste0(.x$stimulus,collapse = ''))) %>% @@ -65,22 +66,28 @@ mutate(l = map_dbl(local_stats, ~length(which(.x$stimulus_type=='lure')))) %>% mutate(s = map_dbl(local_stats, ~sum(sort(table(.x$stimulus), decreasing = T)[1:2]) - 1)) %>% mutate(v = map_dbl(local_stats, ~length(unique(.x$stimulus)))) %>% - mutate(dp = map_dbl(local_stats, - ~length(which(.x$stimulus_type=="target" & .x$correct)) - - length(which(.x$stimulus_type!="target" & !.x$correct)))) %>% - mutate(cr = map_dbl(local_stats, - ~-(length(which(.x$stimulus_type=="target" & .x$correct==T)) + - length(which(.x$stimulus_type!="target" & .x$correct==F)))/2)) %>% + # mutate(dp = map_dbl(local_stats, + # ~length(which(.x$stimulus_type=="target" & .x$correct)) - + # length(which(.x$stimulus_type!="target" & !.x$correct)))) %>% + # mutate(cr = map_dbl(local_stats, + # ~-(length(which(.x$stimulus_type=="target" & .x$correct==T)) + + # length(which(.x$stimulus_type!="target" & .x$correct==F)))/2)) %>% mutate(local_stats = map(local_stats, ~.x %>% select(-trial,-choice))) %>% #mutate(local_stats = map(local_stats, ~.x %>% select(-trial,-stimulus,-choice))) %>% ungroup() %>% select(-participant,-block,-condition) %>% - unnest(local_stats) + unnest(local_stats) %>% + mutate(correct = factor(as.numeric(correct), labels=c("NO","YES"))) %>% + mutate(stimulus = factor(stimulus)) %>% + mutate(stimulus_type = factor(stimulus_type)) + +save(seqs,file=here("notebooks/data/nback_seqs.Rd")) #! =============================================== #! visualize correlations #DEBUG inspect_cor(seqs, show_plot = T) -save(seqs,file=here("notebooks/data/nback_seqs.Rd")) + + ``` ```{r remove_highly_correlated_predictors} diff --git a/data/nback_seqs.Rd b/data/nback_seqs.Rd index a1112bb..50e4b86 100644 --- a/data/nback_seqs.Rd +++ b/data/nback_seqs.Rd Binary files differ diff --git a/dummy-vars-playground.R b/dummy-vars-playground.R index f51a52f..3cdb681 100644 --- a/dummy-vars-playground.R +++ b/dummy-vars-playground.R @@ -16,12 +16,7 @@ # INPUTS : seqs # OUTPUTS: seqs.dmy -seqs <- seqs %>% - filter(!is.na(correct) & !is.na(rt)) %>% - mutate(correct = factor(as.numeric(correct), labels=c("NO","YES"))) %>% - mutate(stimulus = factor(stimulus)) %>% - mutate(stimulus_type = factor(stimulus_type)) - +seqs <- seqs %>% filter(!is.na(correct) & !is.na(rt)) #