merge

pie_inspect.R

@@ -17,8 +17,6 @@ df <- as.tibble(pie_data_proc$df)
 
 df = df %>% as_tibble %>% arrange(ID, block_num, trial)
 
-
-df<-df[!as.logical(df$forced_choice),]
 # value sampled on the first free choice as a function of even/uneven sampling -- should be lower in uneven
 
 # inspect relative value and uncertainty signals
@@ -29,17 +27,45 @@ df$forced_sampling <- NA
 df$forced_sampling[df$even_uneven==0] <- 'uneven'
 df$forced_sampling[df$even_uneven==1] <- 'even'
 
+inx<-df[names(df)[grep("samplehx[0-9]",names(df))]]==0
+df[names(df)[grep("v_bayes[0-9]",names(df))]][inx]<-NA
+
+# calculate different value flavors
+
+df$v_mean <- rowMeans(df[c('v_bayes1','v_bayes2','v_bayes3', 'v_bayes4',
+                           'v_bayes5','v_bayes6','v_bayes7','v_bayes8')], na.rm =  T)
+df$v_diff <- df$vbay_selected - df$v_mean
+
+fdf<-df[!as.logical(df$forced_choice),]
 
 ff <- as.tibble(df[(df$trial==5 & df$num_segments==4) | (df$trial==9 & df$num_segments==8),])
 
 # df$logVrel <- log(df$v_l)
-# df$logUrel <- log(df$u_l)
+# df$logUrel <- log(df$u)
+gridExtra::grid.arrange(
+ggplot(fdf,aes(trial,v_bayes1,color = num_segments, lty = show_points)) + geom_smooth(),
+ggplot(fdf,aes(trial,v_bayes2,color = num_segments, lty = show_points)) + geom_smooth(),
+ggplot(fdf,aes(trial,v_bayes3,color = num_segments, lty = show_points)) + geom_smooth(),
+ggplot(fdf,aes(trial,v_bayes4,color = num_segments, lty = show_points)) + geom_smooth(),
+ggplot(fdf,aes(trial,v_bayes5,color = num_segments, lty = show_points)) + geom_smooth(),
+ggplot(fdf,aes(trial,v_bayes6,color = num_segments, lty = show_points)) + geom_smooth(),
+ggplot(fdf,aes(trial,v_bayes7,color = num_segments, lty = show_points)) + geom_smooth(),
+ggplot(fdf,aes(trial,v_bayes8,color = num_segments, lty = show_points)) + geom_smooth(),
+nrow=4)
+varyingvars<-names(df)[grep("[1-9]",names(df))]
+ldf<-reshape2::melt(fdf, measure.vars = varyingvars)
+ldf$type<-gsub("[0-9]*","",ldf$variable)
+ldf <- ldf[ldf$type=='v_bayes',]
+ggplot(ldf,aes(trial,value, color = variable)) + geom_smooth() + facet_wrap(~num_segments)
+
+# their exploitation is helped by show_points in 8
+ggplot(fdf,aes(trial,vbay_selected,color = num_segments, lty = show_points)) + geom_smooth(method = "loess") 
+
+ggplot(fdf,aes(trial,v_diff,color = num_segments, lty = show_points)) + geom_smooth(method = "loess") 
 
-# log-log value-uncertainty relationship
-ggplot(df,aes(v_l,u_l,color = num_segments)) + geom_point() + facet_wrap(~ID)
 
 # linear value-uncertainty relationship
-ggplot(df,aes(v_l,u_l,color = num_segments)) + geom_point() + facet_wrap(~ID)
+ggplot(df,aes(v_l,u,color = num_segments)) + geom_point() + facet_wrap(~ID)
 
 # do they switch from exploration to exploitation
 ggplot(df,aes(trial, selected_prob,color = num_segments, lty = show_points)) + geom_smooth() + facet_wrap(~ID)
@@ -63,14 +89,16 @@ m3 <- lmer(v_bayes ~ num_segments * show_points + trial + (1|ID), df)
 summary(m3)
 car::Anova(m3,'3')
 
-m4 <- lmer(u_l ~ num_segments * show_points * trial + (1|ID), df)
+m4 <- lmer(u ~ num_segments * show_points * trial + (1|ID), df)
 summary(m4)
 car::Anova(m4,'3')
 
-ggplot(df,aes(trial, u_l,color = num_segments)) + geom_smooth(method = 'gam') + facet_wrap(~ID)
-ggplot(df,aes(trial, 1-u_l,color = num_segments, lty = show_points)) + geom_smooth(method = 'gam')
+ggplot(df,aes(trial, u,color = num_segments)) + geom_smooth(method = 'gam') + facet_wrap(~ID)
+ggplot(df,aes(trial, 1-u,color = num_segments, lty = show_points)) + geom_smooth(method = 'gam')
 
-ggplot(ff,aes(forced_sampling,samphx_lag,color = show_points, shape = show_points)) + geom_jitter() + facet_wrap(~num_segments)
 
-ggplot(ff,aes(even_uneven,rewhx_lag,color = show_points, shape = show_points)) + geom_jitter() + facet_wrap(~num_segments)
+######
+# Find the Bob Wilson uncertainty-driven exploration effect
+ggplot(ff,aes(forced_sampling,samplehx_selected,color = vbay_selected)) + geom_jitter() + facet_wrap(~num_segments)
+ggplot(ff,aes(forced_sampling,vbay_selected,color = show_points)) + geom_jitter() + facet_wrap(~num_segments)
 

pie_utility.R

@@ -179,7 +179,7 @@ pie_preproc<-function(ss_pie_raw=NULL,filter_freechoice=T,only_firstfree=F,useme
       sxw$firstfree[max(sxw$num_segments)+1]<-TRUE
     }
 
-    sxw$u_l<-1-(sxw$samplehx_selected/(sxw$trial-1))
+    sxw$u<-1-(sxw$samplehx_selected/(sxw$trial-1))
     # for (ix in c(indexsx$variname,"samphx","rewhx")) {
     #   d<-sxw[,ix]
     #   sxw[paste0(ix,"_lag")]<-dplyr::lag(d)