Commit 5e93e8f8 authored by Ciranka's avatar Ciranka
Browse files

check if exploration also reduces if subjective uncertainty is the criterion

parent 1e2e9098
......@@ -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
X_Figures/Environments.png

137 KB | W: | H:

X_Figures/Environments.png

139 KB | W: | H:

X_Figures/Environments.png
X_Figures/Environments.png
X_Figures/Environments.png
X_Figures/Environments.png
  • 2-up
  • Swipe
  • Onion skin
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment