+
Gaps
+
+- Unclear how to parameterize interesting variations for sequence generation
+- How do we model these multiple strategies (which requires identifying which sequence variations matter)
+
+- local vs. global properties, which one matters the most?
+- Local: lumpiness, short sequence patterns -> could be exploited by “reactive”/automaticity
+- Global: No lures, large vocabulary -> pattern repeats implies a target
+
+
+
+
+
+
+
+
load('./data/CL2015.RData')
+window_size <- 8
+
+
+
+
\(P=\{V,D,C,W\}\)
+
\(V=\{x_N,x_{T},x_{T,local},x_L,x_{L,local},x_V,x_U,x_S,x_{S,local},x_G\}\)
+
\(D=\{\}\)
+
+
+
+
with_lures <- function(stimulus, stimulus_type, n) {
+ sapply(1:length(stimulus), function(i) {
+ lures <- c(as.character(stimulus[i-n-1]), as.character(stimulus[i-n+1]))
+ are_valid_trials <- i>n && all(!is.na(c(lures,stimulus[i])))
+ ifelse(are_valid_trials && stimulus[i] %in% lures,
+ "lure",
+ as.character(stimulus_type[i]))
+ })
+}
+with_history <- function(stimuli, length=16, fixed=F) {
+ seq <- paste(stimuli, collapse = '')
+
+ sapply(1:length(stimuli), function(i) {
+ stri_reverse(str_sub(seq, max(1,i-length+1), i))
+ })
+ #ifelse(fixed, h[str_length(h)==size], h)
+}
+# $x_{s,local}$
+with_skewness <- function(history) {
+ sapply(history, function(h) {
+ freqs <- table(unlist(str_split(h,"")))
+ sum(sort(freqs, decreasing = T)[1:2]) - 1
+ })
+}
+# $x_{u,local}$
+with_lumpiness <- function(history) {
+ sapply(history, function(h) {
+ freqs <- table(unlist(str_split(h,"")))
+ max(freqs) - 1
+ })
+}
+with_targets_ratio <- function(stimulus_type, length=16) {
+ sapply(1:length(stimulus_type), function(i) {
+ trials <- stimulus_type[max(1,i-length):i]
+ length(trials[trials=="target"]) / length(trials)
+ })
+}
+with_lures_ratio <- function(stimulus_type, length=16) {
+ sapply(1:length(stimulus_type), function(i) {
+ trials <- stimulus_type[max(1,i-length):i]
+ length(trials[trials=="lure"]) / length(trials)
+ })
+}
+NB2 <- NB %>%
+ filter(participant=="P13") %>%
+ group_by(participant, condition, block) %>%
+ mutate(n = ifelse(condition=='2-back',2,3)) %>%
+ mutate(stimulus_type = with_lures(stimulus, stimulus_type, n)) %>%
+ mutate(history = with_history(stimulus, window_size)) %>%
+ mutate(x_sl = with_skewness(history)) %>%
+ mutate(x_ul = with_lumpiness(history)) %>%
+ mutate(x_t = with_targets_ratio(stimulus_type, window_size)) %>%
+ mutate(x_l = with_lures_ratio(stimulus_type, window_size)) %>%
+ ungroup()
+
+pca <- prcomp(~x_sl+x_ul+x_t+x_l, NB2, center = TRUE,scale. = TRUE, na.action=na.exclude)
+NB2 <- NB2 %>% mutate(pc1=pca$x[,'PC1'], pc2=pca$x[,'PC2'])
+# caret
+library(caret)
+# Compile cross-validation settings
+any(is.na(NB2))
+
+
+
[1] TRUE
+
+
+
NB2 <- na.omit(NB2)
+# set.seed(100)
+# trainingfold <- createMultiFolds(NB2@correct, k = 5, times = 10)
+#
+# # PLS
+# mod1 <- train(correct ~ ., data = NB2[,c("correct","x_sl","x_ul","x_t","x_l")],
+# method = "pls",
+# metric = "Accuracy",
+# tuneLength = 20,
+# trControl = trainControl("repeatedcv", index = trainingfold, selectionFunction = "oneSE"),
+# preProc = c("zv","center","scale"))
+#
+# # Check CV
+# plot(mod1)
+plsResult <- plsR(correct ~ ., data=NB2[,c("correct","x_sl","x_ul","x_t","x_l")],3)
+
+
+
____************************************************____
+____Component____ 1 ____
+____Component____ 2 ____
+____Component____ 3 ____
+____Predicting X without NA neither in X nor in Y____
+****________________________________________________****
+
+
+
plsResult
+
+
+
Number of required components:
+[1] 3
+Number of successfully computed components:
+[1] 3
+Coefficients:
+ [,1]
+Intercept 1.008159108
+x_sl -0.012385995
+x_ul 0.019020579
+x_t -0.009732895
+x_l 0.015588407
+Information criteria and Fit statistics:
+ AIC RSS_Y R2_Y R2_residY RSS_residY AIC.std DoF.dof
+Nb_Comp_0 -400.8879 0.9942529 NA NA 173.0000 496.7877 1.000000
+Nb_Comp_1 -399.2749 0.9920439 0.002221709 0.002221709 172.6156 498.4007 4.020014
+Nb_Comp_2 -397.5844 0.9902807 0.003995089 0.003995089 172.3088 500.0912 5.000000
+Nb_Comp_3 -396.2011 0.9867774 0.007518680 0.007518680 171.6993 501.4745 5.000000
+ sigmahat.dof AIC.dof BIC.dof GMDL.dof DoF.naive sigmahat.naive
+Nb_Comp_0 0.07580980 0.005780156 0.005884498 -441.1050 1 0.07580980
+Nb_Comp_1 0.07617155 0.005969500 0.006392969 -427.5293 2 0.07594536
+Nb_Comp_2 0.07632287 0.006026049 0.006554844 -423.3755 3 0.07609938
+Nb_Comp_3 0.07618775 0.006004731 0.006531655 -423.6749 4 0.07618775
+ AIC.naive BIC.naive GMDL.naive
+Nb_Comp_0 0.005780156 0.005884498 -441.1050
+Nb_Comp_1 0.005833993 0.006043423 -436.3376
+Nb_Comp_2 0.005890962 0.006206384 -431.7944
+Nb_Comp_3 0.005938011 0.006359551 -427.5722
+
+
+
LS0tCnRpdGxlOiAiU3RhdGlzdGljYWwgUHJvcGVydGllcyBvZiB0aGUgTi1CYWNrIFNlcXVlbmNlcyIKb3V0cHV0OgogIGh0bWxfbm90ZWJvb2s6IGRlZmF1bHQKICBwZGZfZG9jdW1lbnQ6IGRlZmF1bHQKLS0tCgojIFByb2JsZW1zCgpTdGF0aXN0aWNhbCBwcm9wZXJ0aWVzIG9mIG4tYmFjayBzZXF1ZW5jZXMgYmlhcyBiZWhhdmlvcnMuIFRoZXNlIGJpYXMsIHVuZGVyIHNwZWNpZmllZCBzdHJ1Y3R1cmUsIGFsbG93cyBtdWx0aXBsZSBjb2duaXRpdmUgc3RyYXRlZ2llcywgcHJvZHVjaW5nIGhldGVyb2dlbmVvdXMgYmVoYXZpb3IgaW4gYSAiZ29sZCBzdGFuZGFyZCIgY29nbml0aXZlIHRhc2suCgojIEdhcHMKCi0gVW5jbGVhciBob3cgdG8gcGFyYW1ldGVyaXplIGludGVyZXN0aW5nIHZhcmlhdGlvbnMgZm9yIHNlcXVlbmNlIGdlbmVyYXRpb24KLSBIb3cgZG8gd2UgbW9kZWwgdGhlc2UgbXVsdGlwbGUgc3RyYXRlZ2llcyAod2hpY2ggcmVxdWlyZXMgaWRlbnRpZnlpbmcgd2hpY2ggc2VxdWVuY2UgdmFyaWF0aW9ucyBtYXR0ZXIpIAogICAgLSBsb2NhbCB2cy4gZ2xvYmFsIHByb3BlcnRpZXMsIHdoaWNoIG9uZSBtYXR0ZXJzIHRoZSBtb3N0PwogICAgLSBMb2NhbDogIGx1bXBpbmVzcywgc2hvcnQgc2VxdWVuY2UgcGF0dGVybnMgLT4gY291bGQgYmUgZXhwbG9pdGVkIGJ5IOKAnHJlYWN0aXZl4oCdL2F1dG9tYXRpY2l0eSAKICAgIC0gR2xvYmFsOiAgTm8gbHVyZXMsIGxhcmdlIHZvY2FidWxhcnkgLT4gcGF0dGVybiByZXBlYXRzIGltcGxpZXMgYSB0YXJnZXQKCgpgYGB7ciBsaWJyYXJpZXMsIG1lc3NhZ2U9RkFMU0UsIGluY2x1ZGU9RkFMU0UsIHBhZ2VkLnByaW50PUZBTFNFfQpsaWJyYXJ5KGdncGxvdDIpCmxpYnJhcnkodGlkeXZlcnNlKQpsaWJyYXJ5KHN0cmluZ2kpCmxpYnJhcnkocGxzUmdsbSkKbGlicmFyeShwbHNkb2YpCmxpYnJhcnkoY2FyZXQpCmBgYAoKYGBge3IgcGFyYW1zfQpsb2FkKCcuL2RhdGEvQ0wyMDE1LlJEYXRhJykKCndpbmRvd19zaXplIDwtIDgKYGBgCgoKJFA9XHtWLEQsQyxXXH0kCgokVj1ce3hfTix4X3tUfSx4X3tULGxvY2FsfSx4X0wseF97TCxsb2NhbH0seF9WLHhfVSx4X1MseF97Uyxsb2NhbH0seF9HXH0kCgokRD1ce1x9JAoKCgpgYGB7ciBoaXN0b3J5fQoKd2l0aF9sdXJlcyA8LSBmdW5jdGlvbihzdGltdWx1cywgc3RpbXVsdXNfdHlwZSwgbikgewogIHNhcHBseSgxOmxlbmd0aChzdGltdWx1cyksIGZ1bmN0aW9uKGkpIHsKICAgIGx1cmVzIDwtIGMoYXMuY2hhcmFjdGVyKHN0aW11bHVzW2ktbi0xXSksIGFzLmNoYXJhY3RlcihzdGltdWx1c1tpLW4rMV0pKQogICAgYXJlX3ZhbGlkX3RyaWFscyA8LSBpPm4gJiYgYWxsKCFpcy5uYShjKGx1cmVzLHN0aW11bHVzW2ldKSkpCiAgICBpZmVsc2UoYXJlX3ZhbGlkX3RyaWFscyAmJiBzdGltdWx1c1tpXSAlaW4lIGx1cmVzLAogICAgICAgICAgICJsdXJlIiwgCiAgICAgICAgICAgYXMuY2hhcmFjdGVyKHN0aW11bHVzX3R5cGVbaV0pKQogIH0pCn0KCndpdGhfaGlzdG9yeSA8LSBmdW5jdGlvbihzdGltdWxpLCBsZW5ndGg9MTYsIGZpeGVkPUYpIHsKICBzZXEgPC0gcGFzdGUoc3RpbXVsaSwgY29sbGFwc2UgPSAnJykKICAKICBzYXBwbHkoMTpsZW5ndGgoc3RpbXVsaSksIGZ1bmN0aW9uKGkpIHsKICAgIHN0cmlfcmV2ZXJzZShzdHJfc3ViKHNlcSwgbWF4KDEsaS1sZW5ndGgrMSksIGkpKQogIH0pCiAgI2lmZWxzZShmaXhlZCwgaFtzdHJfbGVuZ3RoKGgpPT1zaXplXSwgaCkKfQoKIyAkeF97cyxsb2NhbH0kCndpdGhfc2tld25lc3MgPC0gZnVuY3Rpb24oaGlzdG9yeSkgewogIHNhcHBseShoaXN0b3J5LCBmdW5jdGlvbihoKSB7CiAgICBmcmVxcyA8LSB0YWJsZSh1bmxpc3Qoc3RyX3NwbGl0KGgsIiIpKSkKICAgIHN1bShzb3J0KGZyZXFzLCBkZWNyZWFzaW5nID0gVClbMToyXSkgLSAxCiAgfSkKfQoKIyAkeF97dSxsb2NhbH0kCndpdGhfbHVtcGluZXNzIDwtIGZ1bmN0aW9uKGhpc3RvcnkpIHsKICBzYXBwbHkoaGlzdG9yeSwgZnVuY3Rpb24oaCkgewogICAgZnJlcXMgPC0gdGFibGUodW5saXN0KHN0cl9zcGxpdChoLCIiKSkpCiAgICBtYXgoZnJlcXMpIC0gMQogIH0pCn0KCgp3aXRoX3RhcmdldHNfcmF0aW8gPC0gZnVuY3Rpb24oc3RpbXVsdXNfdHlwZSwgbGVuZ3RoPTE2KSB7CiAgc2FwcGx5KDE6bGVuZ3RoKHN0aW11bHVzX3R5cGUpLCBmdW5jdGlvbihpKSB7CiAgICB0cmlhbHMgPC0gc3RpbXVsdXNfdHlwZVttYXgoMSxpLWxlbmd0aCk6aV0KICAgIGxlbmd0aCh0cmlhbHNbdHJpYWxzPT0idGFyZ2V0Il0pIC8gbGVuZ3RoKHRyaWFscykKICB9KQp9Cgp3aXRoX2x1cmVzX3JhdGlvIDwtIGZ1bmN0aW9uKHN0aW11bHVzX3R5cGUsIGxlbmd0aD0xNikgewogIHNhcHBseSgxOmxlbmd0aChzdGltdWx1c190eXBlKSwgZnVuY3Rpb24oaSkgewogICAgdHJpYWxzIDwtIHN0aW11bHVzX3R5cGVbbWF4KDEsaS1sZW5ndGgpOmldCiAgICBsZW5ndGgodHJpYWxzW3RyaWFscz09Imx1cmUiXSkgLyBsZW5ndGgodHJpYWxzKQogIH0pCn0KCk5CMiA8LSBOQiAlPiUKICBmaWx0ZXIocGFydGljaXBhbnQ9PSJQMTMiKSAlPiUKICBncm91cF9ieShwYXJ0aWNpcGFudCwgY29uZGl0aW9uLCBibG9jaykgJT4lCiAgbXV0YXRlKG4gPSBpZmVsc2UoY29uZGl0aW9uPT0nMi1iYWNrJywyLDMpKSAlPiUKICBtdXRhdGUoc3RpbXVsdXNfdHlwZSA9IHdpdGhfbHVyZXMoc3RpbXVsdXMsIHN0aW11bHVzX3R5cGUsIG4pKSAlPiUKICBtdXRhdGUoaGlzdG9yeSA9IHdpdGhfaGlzdG9yeShzdGltdWx1cywgd2luZG93X3NpemUpKSAlPiUKICBtdXRhdGUoeF9zbCA9IHdpdGhfc2tld25lc3MoaGlzdG9yeSkpICU+JQogIG11dGF0ZSh4X3VsID0gd2l0aF9sdW1waW5lc3MoaGlzdG9yeSkpICU+JQogIG11dGF0ZSh4X3QgPSB3aXRoX3RhcmdldHNfcmF0aW8oc3RpbXVsdXNfdHlwZSwgd2luZG93X3NpemUpKSAlPiUKICBtdXRhdGUoeF9sID0gd2l0aF9sdXJlc19yYXRpbyhzdGltdWx1c190eXBlLCB3aW5kb3dfc2l6ZSkpICU+JQogIHVuZ3JvdXAoKQogIApwY2EgPC0gcHJjb21wKH54X3NsK3hfdWwreF90K3hfbCwgTkIyLCBjZW50ZXIgPSBUUlVFLHNjYWxlLiA9IFRSVUUsIG5hLmFjdGlvbj1uYS5leGNsdWRlKQpOQjIgPC0gTkIyICU+JSBtdXRhdGUocGMxPXBjYSR4WywnUEMxJ10sIHBjMj1wY2EkeFssJ1BDMiddKQoKIyBjYXJldApsaWJyYXJ5KGNhcmV0KQojIENvbXBpbGUgY3Jvc3MtdmFsaWRhdGlvbiBzZXR0aW5ncwoKCmFueShpcy5uYShOQjIpKQpOQjIgPC0gbmEub21pdChOQjIpCgojIHNldC5zZWVkKDEwMCkKIyB0cmFpbmluZ2ZvbGQgPC0gY3JlYXRlTXVsdGlGb2xkcyhOQjJAY29ycmVjdCwgayA9IDUsIHRpbWVzID0gMTApCiMgCiMgIyBQTFMKIyBtb2QxIDwtIHRyYWluKGNvcnJlY3QgfiAuLCBkYXRhID0gTkIyWyxjKCJjb3JyZWN0IiwieF9zbCIsInhfdWwiLCJ4X3QiLCJ4X2wiKV0sCiMgIG1ldGhvZCA9ICJwbHMiLAojICBtZXRyaWMgPSAiQWNjdXJhY3kiLAojICB0dW5lTGVuZ3RoID0gMjAsCiMgIHRyQ29udHJvbCA9IHRyYWluQ29udHJvbCgicmVwZWF0ZWRjdiIsIGluZGV4ID0gdHJhaW5pbmdmb2xkLCBzZWxlY3Rpb25GdW5jdGlvbiA9ICJvbmVTRSIpLAojICBwcmVQcm9jID0gYygienYiLCJjZW50ZXIiLCJzY2FsZSIpKQojICAKIyAjIENoZWNrIENWCiMgcGxvdChtb2QxKQoKCnBsc1Jlc3VsdCA8LSBwbHNSKGNvcnJlY3QgfiAuLCBkYXRhPU5CMlssYygiY29ycmVjdCIsInhfc2wiLCJ4X3VsIiwieF90IiwieF9sIildLDMpCgoKcGxzUmVzdWx0CmBgYA==