check if exploration also reduces if subjective uncertainty is the criterion

B_AnalysisCode/Adaptive_Adolescence_Multi.Rmd

@@ -205,6 +205,8 @@ exploreEnv<-function(explore_func,choiceRule,env2,env1,cntrl,iter){
   dummy=cntrl$dummy
   overallCnt=cntrl$overallCnt
   dat=cntrl$dat
+  mu=list()
+  sig=list()
   
   for (nround in 1:3){
     #get parameters for participant on that round
@@ -240,6 +242,7 @@ exploreEnv<-function(explore_func,choiceRule,env2,env1,cntrl,iter){
       }else{
         out<-bayesianMeanTracker(X[overallCnt,1:2],y[overallCnt],theta=lambda, prevPost=NULL,mu0Par=mu0,var0Par=var0)
       }
+      #browser()
       #utility vector. transpose if you use greedyMean
       #where is everybody?
       #here i need a function that calls bayesianMeanTracker. n times and returns the values X for each n. Also, i need some kind of list, where i save the prior for each instance....
@@ -273,23 +276,31 @@ exploreEnv<-function(explore_func,choiceRule,env2,env1,cntrl,iter){
                         z=as.numeric(y[overallCnt]),round=nround)
       
       AllChoices<-rbind(AllChoices,dummy)
+      mu[[overallCnt]]<-out$mu
+      sig[[overallCnt]]<-out$sig
       overallCnt=overallCnt+1
     }
     #dummy data frame
   }
   #}
   #This Here is for Plotting
+
   Plot_dat=expand.grid(x=1:12,y=1:12,trials=0:max(dummy$trial))
   Plot_dat$sample=0
   Plot_dat$out=0
-  
+  Plot_dat$mu=0
+  Plot_dat$sig=40
   
   for (i in 1:length(AllChoices$x)){
     AllChoices$y[i]
     AllChoices$x[i]
     Plot_dat[Plot_dat$x==AllChoices$x[i] & Plot_dat$y==AllChoices$y[i] & Plot_dat$trials==AllChoices$trial[i],]$sample=1
     Plot_dat[Plot_dat$trials==AllChoices$trial[i],]$out=AllChoices$z[i]
+    Plot_dat[Plot_dat$trials==AllChoices$trial[i],]$mu=mu[[i]]
+    Plot_dat[Plot_dat$trials==AllChoices$trial[i],]$sig=sig[[i]]
   }
+   # browser()
+
   Plot_dat$iter=iter
   return(Plot_dat)
 }
@@ -1701,3 +1712,59 @@ newExp_all_Social_socialOutcomes%>%group_by(iter)%>%
   ggtitle("Stay With Noone")+
   theme_minimal(14)
 ```
+
+
+# Arbitrary choice Exploration
+```{r}
+Plot_datAll%>%
+  mutate(Criterion=case_when((sample==1 & sig>20)~1,TRUE~0)
+  )%>%mutate(newCum=cumsum(Criterion))%>%
+  ungroup()%>%group_by(trials,iter)%>%
+  summarise(explore=max(newCum))%>%
+  ungroup()%>%
+  arrange(iter)%>%
+  #ungroup()%>%#### looks about right but doublecheck.
+  mutate(
+    explore2=explore-lag(explore,50)
+  )%>%mutate(
+    Stage=case_when(
+      (trials<401)~"Children",
+      (trials>400&trials<800)~"Adolescents",
+      (trials>800)~"Adults"
+    )
+  )%>%filter(!is.na(Stage) & trials %in% round(seq(50,1200,length.out = 24)))%>%
+  ggplot(aes(x=trials,y=explore2))+
+  stat_summary(geom="ribbon", fun.data="mean_sdl",alpha=0.2)+
+  stat_summary(geom="line",fun.y = "mean",color="black")+
+  #geom_jitter()+
+  #geom_rect(aes(xmin=50,xmax=400,ymin=-5,ymax=100,fill="1"),alpha=0.1)+
+  #geom_rect(aes(xmin=400,xmax=800,ymin=-5,ymax=100,fill="2"),alpha=0.1)+
+  #geom_rect(aes(xmin=801,xmax=1200,ymin=-5,ymax=100,fill="3"),alpha=0.1)+
+  #geom_spline(size=1)+
+  geom_point(aes(shape=Stage),size=1,alpha=0.1)+
+  stat_summary(aes(shape=Stage),geom="point",fun.y = "mean",size=2.5,color="black",fill="white")+
+  scale_shape_manual(name="Developmental Stage",values=c(22,21,24))+
+  geom_vline(xintercept = 420, linetype="dotted",color="royalblue")+
+  geom_vline(xintercept = 410, linetype="dotted",color="royalblue")+
+  geom_vline(xintercept = 800, linetype="dotted",color="royalblue")+
+  geom_vline(xintercept = 790, linetype="dotted",color="royalblue")+
+  annotate("text",x=150,y=60,label=c("Children"))+
+  annotate("text",x=600,y=60,label=c("Adolescents"))+
+  annotate("text",x=950,y=60,label=c("Adults"))+
+  #scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
+  coord_cartesian(ylim=c(0,60))+
+  scale_fill_brewer(name="Developmental Stage",labels=c("Children","Adolescents","Adults"),palette = "Reds")+
+  scale_y_continuous(name="Decisions")+
+  scale_x_continuous(name="trials")+
+  ggtitle("Sample Highly Uncertain Options")+
+  theme_minimal(14)
+
+
+
+
+
+%>%
+  ggplot(aes(x=trials,y=sig,color=iter))+
+  geom_point()
+  #stat_summary()
+```
\ No newline at end of file