diff --git a/pie_inspect.R b/pie_inspect.R index 5735d77..4335359 100644 --- a/pie_inspect.R +++ b/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) diff --git a/pie_utility.R b/pie_utility.R index 20c7faf..f903bc3 100644 --- a/pie_utility.R +++ b/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)