Commit 1e2e9098 authored by Simon Ciranka's avatar Simon Ciranka
Browse files

added latest probabilistic sims and new figures

parent 57c72c28
No preview for this file type
...@@ -34,7 +34,7 @@ Specificly i re sample the reward if it is over 120. Now, as you may see below, ...@@ -34,7 +34,7 @@ Specificly i re sample the reward if it is over 120. Now, as you may see below,
I am not really happy with that because now, the normative solution is to seek out variance and the story about risk taking is that there is no such normative solution isnt it? I am not really happy with that because now, the normative solution is to seek out variance and the story about risk taking is that there is no such normative solution isnt it?
```{r fig.width=12,fig.height=6} ```{r fig.width=12,fig.height=6}
library("viridis")
envirionmentMeanKids=seq(-50,50,length.out=5)#define the range of kid envirionemt envirionmentMeanKids=seq(-50,50,length.out=5)#define the range of kid envirionemt
envirionmentVarianceKids=seq(1,10,length.out=5) envirionmentVarianceKids=seq(1,10,length.out=5)
EnvirionemntKids=expand.grid(Mean=envirionmentMeanKids,Variance=envirionmentVarianceKids)# we sample from this later EnvirionemntKids=expand.grid(Mean=envirionmentMeanKids,Variance=envirionmentVarianceKids)# we sample from this later
...@@ -47,28 +47,23 @@ EnvirionemntAdol%>%ungroup() ...@@ -47,28 +47,23 @@ EnvirionemntAdol%>%ungroup()
EnvirionemntAdol%>%dplyr::rowwise()%>%mutate(value=rnorm(1,mean = Mean,sd=Variance))%>% EnvirionemntAdol%>%dplyr::rowwise()%>%mutate(value=rnorm(1,mean = Mean,sd=Variance))%>%
ggplot(aes(x=Mean,y=Variance,fill=value))+geom_tile()+ ggplot(aes(x=Mean,y=Variance,fill=value))+geom_tile()+
scale_fill_distiller(name="Outcome",palette = "Spectral",trans = "reverse")+ scale_fill_viridis(name="Outcome",option="plasma",direction = -1)+
geom_hline(aes(yintercept=40),size=2)+ geom_hline(aes(yintercept=40),size=2)+
geom_vline(aes(xintercept=0),size=2)+ geom_vline(aes(xintercept=0),size=2)+
annotate("text",x=50,y=38,label=c("Low Risk / Reward"))+ annotate("text",x=50,y=38,label=c("Low Risk / Reward"))+
annotate("text",x=-50,y=38,label=c("Low Risk / Loss"))+ annotate("text",x=-50,y=38,label=c("Low Risk / Loss"))+
annotate("text",x=50,y=42,label=c("High Risk / Reward"))+ annotate("text",x=50,y=42,label=c("High Risk / Reward"))+
annotate("text",x=-50,y=42,label=c("High Risk / Loss"))+ annotate("text",x=-50,y=42,label=c("High Risk / Loss"))+
ggtitle("Adolescent Environment")+theme_cowplot()->Adolescent ggtitle("Adolescent Environment")+theme_minimal()+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())->Adolescent
EnvirionemntAdol%>%dplyr::rowwise()%>%mutate(value=rnorm(1,mean = Mean,sd=Variance))%>% EnvirionemntAdol%>%dplyr::rowwise()%>%mutate(value=rnorm(1,mean = Mean,sd=Variance))%>%
ggplot(aes(x=Mean,y=Variance,fill=value,alpha=Mean>-46&Variance<40&Mean<46))+geom_tile()+ ggplot(aes(x=Mean,y=Variance,fill=value,alpha=Mean>-46&Variance<40&Mean<46))+geom_tile()+
scale_fill_distiller(name="Outcome",palette = "Spectral",trans = "reverse")+ scale_fill_viridis(name="Outcome",option="plasma",direction = -1)+
scale_alpha_discrete(range = c(0.2, 1))+ scale_alpha_discrete(range = c(1, 0.6))+
geom_hline(aes(yintercept=40),size=2)+ geom_hline(aes(yintercept=40),size=2)+
geom_vline(aes(xintercept=0),size=2)+ geom_vline(aes(xintercept=0),size=2)+
annotate("text",x=50,y=38,label=c("Low Risk / Reward"))+ guides(alpha=F)+theme_minimal()+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())->Kid
annotate("text",x=-50,y=38,label=c("Low Risk / Loss"))+
annotate("text",x=50,y=42,label=c("High Risk / Reward"))+
annotate("text",x=-50,y=42,label=c("High Risk / Loss"))+
guides(alpha=F)+
ggtitle("Kids Environment")+theme_cowplot()->Kid
legend=cowplot::get_legend(Kid) legend=cowplot::get_legend(Kid)
cowplot::plot_grid(Kid+theme(legend.position="none"), cowplot::plot_grid(Kid+theme(legend.position="none"),
...@@ -76,10 +71,123 @@ cowplot::plot_grid(Kid+theme(legend.position="none"), ...@@ -76,10 +71,123 @@ cowplot::plot_grid(Kid+theme(legend.position="none"),
axis.title.y = element_text(colour="white")), axis.title.y = element_text(colour="white")),
legend,ncol =3,rel_widths = c(1,1,0.2)) legend,ncol =3,rel_widths = c(1,1,0.2))
ggsave(plot=Kid,filename = "/X_Figures/Environment_new2.png")
ggsave(filename = "../X_Figures/Environments.png") ggsave(filename = "../X_Figures/Environments.png")
``` ```
```{r, fig.width=5,fig.height=5}
x=-300:300
tibble(y=dnorm(x,mean=100,sd=80),
x=x)%>%
ggplot(aes(y=y,x=x,color=x>0))+geom_line(size=3)+
scale_y_continuous(name="probability")+
scale_x_continuous(name="Outcome value")+
scale_color_discrete(name="Outcome",breaks=c("TRUE","FALSE"),labels=c("Loss","Win"))+
theme_cowplot()+theme(axis.text.y = element_blank(),
panel.border = element_rect(colour = "black", fill=NA, size=2),
legend.position = c(0.75,0.8))
ggsave("../X_Figures/HighRiskHighRew.png",dpi=300,height = 5,width = 5)
tibble(y=dnorm(x,mean=100,sd=10),
x=x)%>%
ggplot(aes(y=y,x=x,color=x>0))+geom_line(size=3)+
scale_y_continuous(name="probability")+
scale_x_continuous(name="Outcome value")+
scale_color_discrete(name="Outcome",breaks=c("TRUE","FALSE"),labels=c("Loss","Win"))+
theme_cowplot()+theme(axis.text.y = element_blank(),
panel.border = element_rect(colour = "black", fill=NA, size=2),
legend.position = c(0.75,0.8))
ggsave("../X_Figures/LowRiskHighRew.png",dpi=300,height = 5,width = 5)
tibble(y=dnorm(x,mean=-100,sd=80),
x=x)%>%
ggplot(aes(y=y,x=x,color=x>0))+geom_line(size=3)+
scale_y_continuous(name="probability")+
scale_x_continuous(name="Outcome value")+
scale_color_discrete(name="Outcome",breaks=c("TRUE","FALSE"),labels=c("Loss","Win"))+
theme_cowplot()+theme(axis.text.y = element_blank(),
panel.border = element_rect(colour = "black", fill=NA, size=2),
legend.position = c(0.75,0.8))
ggsave("../X_Figures/HighRiskLowRew.png",dpi=300,height = 5,width = 5)
tibble(y=dnorm(x,mean=-100,sd=10),
x=x)%>%
ggplot(aes(y=y,x=x,color=x>0))+geom_line(size=3)+
scale_y_continuous(name="probability")+
scale_x_continuous(name="Outcome value")+
scale_color_discrete(name="Outcome",breaks=c("TRUE","FALSE"),labels=c("Loss","Win"))+
theme_cowplot()+theme(axis.text.y = element_blank(),
panel.border = element_rect(colour = "black", fill=NA, size=2),
legend.position = c(0.75,0.8))
ggsave("../X_Figures/LowRiskLowRew.png",dpi=300,height = 5,width = 5)
```
# Bayes update
```{r}
library(viridis)
x=-20:50
NormalSamples=tibble(values=rnorm(20,mean=25,sd=6))
rbind(
tibble(y=dnorm(x,mean=20,sd=10),x=x)%>%mutate(type="1"),
tibble(y=dnorm(x,mean=25,sd=6),x=x)%>%mutate(type="2")
)%>%
ggplot()+
geom_line(aes(y=y,x=x,color=type),size=3)+
scale_color_viridis_d(name="",option="plasma")+
#scale_alpha_discrete(range=c(0.4,1))+
geom_dotplot(data = NormalSamples,aes(x=values,color="3"),fill="#F1F592",binwidth = 1,dotsize = 1.5)+
#scale_fill_viridis()+
coord_cartesian(ylim=c(0,0.15))+
theme_cowplot(20)+
theme(axis.line.y=element_blank(),
axis.title.y =element_blank(),
axis.text.y =element_blank(),
axis.ticks.y=element_blank()
)->Posterior
rbind(
tibble(y=dnorm(x,mean=20,sd=10),x=x)%>%mutate(type="1")
#tibble(y=dnorm(x,mean=25,sd=3),x=x)%>%mutate(type="Posterior")
)%>%
ggplot()+
geom_line(aes(y=y,x=x,color=type),size=3)+
scale_color_viridis_d(name="",option="plasma")+
#geom_dotplot(data = NormalSamples,aes(x=values,color="Observations (Likelihood)"),fill="grey",binwidth = 1,dotsize = 1.5)+
#scale_fill_viridis()+
theme_cowplot(20)+
coord_cartesian(ylim=c(0,0.15))+
theme(axis.line.y=element_blank(),
axis.title.y =element_blank(),
axis.text.y =element_blank(),
axis.ticks.y=element_blank()
)->Prior
rbind(
tibble(y=dnorm(x,mean=20,sd=10),x=x)%>%mutate(type="1")
#tibble(y=dnorm(x,mean=25,sd=3),x=x)%>%mutate(type="Posterior")
)%>%
ggplot()+
geom_line(aes(y=y,x=x,color=type),size=3)+
scale_color_viridis_d(name="",option="plasma")+
geom_dotplot(data = NormalSamples,aes(x=values,color="2"),fill="#F1F592",binwidth = 1,dotsize = 1.5)+
#scale_fill_viridis()+
coord_cartesian(ylim=c(0,0.15))+theme_cowplot(20)+
theme(axis.line.y=element_blank(),
axis.title.y =element_blank(),
axis.text.y =element_blank(),
axis.ticks.y=element_blank()
)->Outcomes
ggsave(plot=Posterior,filename="../X_Figures/Posterior.png",dpi=330)
ggsave(plot=Outcomes,filename="../X_Figures/Outcomes.png",dpi=330)
ggsave(plot=Prior,filename="../X_Figures/Prior.png",dpi=330)
```
# load the kalman filter and the UCB rule # load the kalman filter and the UCB rule
Here i define the kalman filter and the choice rule. Here i define the kalman filter and the choice rule.
...@@ -110,7 +218,7 @@ bayesianMeanTracker <- function(x, y, theta, prevPost=NULL,mu0Par,var0Par){ ...@@ -110,7 +218,7 @@ bayesianMeanTracker <- function(x, y, theta, prevPost=NULL,mu0Par,var0Par){
allopts<-expand.grid(1:12, 1:12) allopts<-expand.grid(1:12, 1:12)
chosen <- which(allopts$Var1==x[1] & allopts$Var2==x[2]) chosen <- which(allopts$Var1==x[1] & allopts$Var2==x[2])
#Kalman gain #Kalman gain
kGain <- predictions$sig[chosen] / (predictions$sig[chosen] + EnvirionemntAdol$Variance[chosen]^2)# feed the uncertainty in here. kGain <- predictions$sig[chosen] / (predictions$sig[chosen] + 360)#EnvirionemntAdol$Variance[chosen]^2)# feed the uncertainty in here.
#update mean #update mean
predictions$mu[chosen] <- predictions$mu[chosen] + (kGain * (y-predictions$mu[chosen])) predictions$mu[chosen] <- predictions$mu[chosen] + (kGain * (y-predictions$mu[chosen]))
#update variance for observed arm #update variance for observed arm
...@@ -157,7 +265,7 @@ beta<-0# this scales risk attitude. ...@@ -157,7 +265,7 @@ beta<-0# this scales risk attitude.
#get tau #get tau
tau<-0.8 tau<-0.8
mu0<-100#exploration bonus mu0<-100#exploration bonus
var0<-5 var0<-80
#create a parameter vector #create a parameter vector
parVec <- c(lambda, lambda, 1, .0001) parVec <- c(lambda, lambda, 1, .0001)
# #
...@@ -392,6 +500,8 @@ for( i in 1:length(unique(newExp$trials))){ ...@@ -392,6 +500,8 @@ for( i in 1:length(unique(newExp$trials))){
saveRDS(newExp,"Derivatives_TrialWise.rds") saveRDS(newExp,"Derivatives_TrialWise.rds")
# to compute the derivative # to compute the derivative
#newExp<-readRDS("Derivatives_TrialWise.rds")
``` ```
# Plot # Plot
...@@ -435,6 +545,7 @@ newExp%>%ungroup()%>% ...@@ -435,6 +545,7 @@ newExp%>%ungroup()%>%
ggtitle("Exploration -> Solo")+ ggtitle("Exploration -> Solo")+
guides(linetype=F)+ guides(linetype=F)+
theme_cowplot() theme_cowplot()
ggsave("../X_Figures/TimecourseExplore.png",width=7,height=4) ggsave("../X_Figures/TimecourseExplore.png",width=7,height=4)
``` ```
# Area under the curve # Area under the curve
......
...@@ -2,11 +2,10 @@ ...@@ -2,11 +2,10 @@
title: "Adaptive_Adolescence_multi" title: "Adaptive_Adolescence_multi"
author: "Simy" author: "Simy"
date: "28/08/2020" date: "28/08/2020"
output: output:
html_document: github_document:
code_folding: hide
toc: true toc: true
toc_float: true toc_depth: 2
--- ---
```{r setup, include=FALSE} ```{r setup, include=FALSE}
...@@ -40,7 +39,7 @@ EnvirionemntAdol%>%dplyr::rowwise()%>%mutate(value=rnorm(1,mean = Mean,sd=Varian ...@@ -40,7 +39,7 @@ EnvirionemntAdol%>%dplyr::rowwise()%>%mutate(value=rnorm(1,mean = Mean,sd=Varian
annotate("text",x=-50,y=38,label=c("Low Risk / Loss"))+ annotate("text",x=-50,y=38,label=c("Low Risk / Loss"))+
annotate("text",x=50,y=42,label=c("High Risk / Reward"))+ annotate("text",x=50,y=42,label=c("High Risk / Reward"))+
annotate("text",x=-50,y=42,label=c("High Risk / Loss"))+ annotate("text",x=-50,y=42,label=c("High Risk / Loss"))+
ggtitle("Adolescent Environment")+theme_cowplot()->Adolescent ggtitle("Adolescent Environment")+theme_minimal(14)+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())->Adolescent
EnvirionemntAdol%>%dplyr::rowwise()%>%mutate(value=rnorm(1,mean = Mean,sd=Variance))%>% EnvirionemntAdol%>%dplyr::rowwise()%>%mutate(value=rnorm(1,mean = Mean,sd=Variance))%>%
...@@ -54,7 +53,7 @@ EnvirionemntAdol%>%dplyr::rowwise()%>%mutate(value=rnorm(1,mean = Mean,sd=Varian ...@@ -54,7 +53,7 @@ EnvirionemntAdol%>%dplyr::rowwise()%>%mutate(value=rnorm(1,mean = Mean,sd=Varian
annotate("text",x=50,y=42,label=c("High Risk / Reward"))+ annotate("text",x=50,y=42,label=c("High Risk / Reward"))+
annotate("text",x=-50,y=42,label=c("High Risk / Loss"))+ annotate("text",x=-50,y=42,label=c("High Risk / Loss"))+
guides(alpha=F)+ guides(alpha=F)+
ggtitle("Kids Environment")+theme_cowplot()->Kid ggtitle("Childhood Environment")+theme_minimal(14)+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())->Kid
``` ```
...@@ -70,7 +69,7 @@ ggsave(filename = "../X_Figures/Environments.png") ...@@ -70,7 +69,7 @@ ggsave(filename = "../X_Figures/Environments.png")
# load the kalman filter and the UCB rule # load the kalman filter and the UCB rule
Here i define the kalman filter and the choice rule. Here i define the kalman filter and the choice rule.
The Kalman Agent explores the bandits by representing their mean reward rate and its uncertainty about that mean. Both, beliefs about the mean reward rate and uncertainty about that belief are updated every iteration after observing a new outcome. The Agents behavior can be gouverend by 3 parameters: The Kalman Agent explores the bandits by representing their mean reward rate and its uncertainty about that mean. Both, beliefs about the mean reward rate and uncertainty about that belief are updated every trials after observing a new outcome. The Agents behavior can be gouverend by 3 parameters:
* mu0, or Optimism: its prior assumption about how rewarding the envirionment will be on average. This Paramter will also gouvern the extend of exploration * mu0, or Optimism: its prior assumption about how rewarding the envirionment will be on average. This Paramter will also gouvern the extend of exploration
...@@ -97,7 +96,7 @@ bayesianMeanTracker <- function(x, y, theta, prevPost=NULL,mu0Par,var0Par){ ...@@ -97,7 +96,7 @@ bayesianMeanTracker <- function(x, y, theta, prevPost=NULL,mu0Par,var0Par){
allopts<-expand.grid(1:12, 1:12) allopts<-expand.grid(1:12, 1:12)
chosen <- which(allopts$Var1==x[1] & allopts$Var2==x[2]) chosen <- which(allopts$Var1==x[1] & allopts$Var2==x[2])
#Kalman gain #Kalman gain
kGain <- predictions$sig[chosen] / (predictions$sig[chosen] + EnvirionemntAdol$Variance[chosen]^2)# feed the uncertainty in here. kGain <- predictions$sig[chosen] / (predictions$sig[chosen] + 3600)# feed the uncertainty in here.
#update mean #update mean
predictions$mu[chosen] <- predictions$mu[chosen] + (kGain * (y-predictions$mu[chosen])) predictions$mu[chosen] <- predictions$mu[chosen] + (kGain * (y-predictions$mu[chosen]))
#update variance for observed arm #update variance for observed arm
...@@ -144,7 +143,7 @@ cntrl=list( ...@@ -144,7 +143,7 @@ cntrl=list(
#get tau #get tau
tau=0.8, tau=0.8,
mu0=100,#exploration bonus mu0=100,#exploration bonus
var0=5, var0=40,
#create a parameter vector #create a parameter vector
parVec = c(0.8, 0.8, 1, .0001) , parVec = c(0.8, 0.8, 1, .0001) ,
# #
...@@ -161,8 +160,8 @@ cntrl=list( ...@@ -161,8 +160,8 @@ cntrl=list(
## ##
## ##
## Here i store the multiple Sims ## Here i store the multiple Sims
nIterations=100 ntrialss=100
list_Iter <- vector(mode = "list", length = nIterations) list_Iter <- vector(mode = "list", length = ntrialss)
``` ```
# Make observations # Make observations
...@@ -185,7 +184,7 @@ if(loadfromdisk==F){ ...@@ -185,7 +184,7 @@ if(loadfromdisk==F){
```{r} ```{r}
exploreEnv<-function(explore_func,choiceRule,env2,env1,cntrl,iter){ exploreEnv<-function(explore_func,choiceRule,env2,env1,cntrl,iter){
#for (rep in 1:nIterations){ #for (rep in 1:ntrialss){
#unpack #unpack
lambda=cntrl$lambda lambda=cntrl$lambda
#get beta #get beta
...@@ -296,7 +295,7 @@ exploreEnv<-function(explore_func,choiceRule,env2,env1,cntrl,iter){ ...@@ -296,7 +295,7 @@ exploreEnv<-function(explore_func,choiceRule,env2,env1,cntrl,iter){
} }
if(loadfromdisk==F){ if(loadfromdisk==F){
Plot_datAll<-foreach(iter=1:nIterations, .combine='rbind') %dopar%{ Plot_datAll<-foreach(iter=1:ntrialss, .combine='rbind') %dopar%{
exploreEnv(explore_func=bayesianMeanTracker,choiceRule=ucb,env2=EnvirionemntAdol,env1=EnvirionemntKids,cntrl=cntrl,iter=iter) exploreEnv(explore_func=bayesianMeanTracker,choiceRule=ucb,env2=EnvirionemntAdol,env1=EnvirionemntKids,cntrl=cntrl,iter=iter)
} }
saveRDS(file="../A_GeneratedFiles/Plot_datAll",object = Plot_datAll) saveRDS(file="../A_GeneratedFiles/Plot_datAll",object = Plot_datAll)
...@@ -318,7 +317,7 @@ While encountered losses decrease and rewards increase across development; the s ...@@ -318,7 +317,7 @@ While encountered losses decrease and rewards increase across development; the s
Plot_datAll%>%group_by(x,y,iter)%>%filter(trials<=400)%>%mutate(cumDens=cumsum(sample), Plot_datAll%>%group_by(x,y,iter)%>%filter(trials<=400)%>%mutate(cumDens=cumsum(sample),
Outcome=case_when( Outcome=case_when(
(out<0)~"Loss", (out<0)~"Loss",
(out>=0)~"Win" (out>=0)~"Gain"
) )
)%>%group_by(Outcome,iter)%>%summarise(howMany=n()/144, )%>%group_by(Outcome,iter)%>%summarise(howMany=n()/144,
howMuch=sum(out))->Kids howMuch=sum(out))->Kids
...@@ -326,7 +325,7 @@ Plot_datAll%>%group_by(x,y,iter)%>%filter(trials<=400)%>%mutate(cumDens=cumsum(s ...@@ -326,7 +325,7 @@ Plot_datAll%>%group_by(x,y,iter)%>%filter(trials<=400)%>%mutate(cumDens=cumsum(s
Plot_datAll%>%group_by(x,y,iter)%>%filter(trials>=400 & trials<800)%>%mutate(cumDens=cumsum(sample), Plot_datAll%>%group_by(x,y,iter)%>%filter(trials>=400 & trials<800)%>%mutate(cumDens=cumsum(sample),
Outcome=case_when( Outcome=case_when(
(out<0)~"Loss", (out<0)~"Loss",
(out>=0)~"Win" (out>=0)~"Gain"
) )
)%>%group_by(Outcome,iter)%>%summarise(howMany=n()/144, )%>%group_by(Outcome,iter)%>%summarise(howMany=n()/144,
howMuch=sum(out))->Adolescents howMuch=sum(out))->Adolescents
...@@ -334,7 +333,7 @@ Plot_datAll%>%group_by(x,y,iter)%>%filter(trials>=400 & trials<800)%>%mutate(cum ...@@ -334,7 +333,7 @@ Plot_datAll%>%group_by(x,y,iter)%>%filter(trials>=400 & trials<800)%>%mutate(cum
Plot_datAll%>%group_by(x,y,iter)%>%filter(trials>800 & trials<2400)%>%mutate(cumDens=cumsum(sample), Plot_datAll%>%group_by(x,y,iter)%>%filter(trials>800 & trials<2400)%>%mutate(cumDens=cumsum(sample),
Outcome=case_when( Outcome=case_when(
(out<0)~"Loss", (out<0)~"Loss",
(out>=0)~"Win" (out>=0)~"Gain"
) )
)%>%group_by(Outcome,iter)%>%summarise(howMany=n()/144, )%>%group_by(Outcome,iter)%>%summarise(howMany=n()/144,
howMuch=sum(out) howMuch=sum(out)
...@@ -348,7 +347,7 @@ Adolescents$Soc="0" ...@@ -348,7 +347,7 @@ Adolescents$Soc="0"
Kids$Soc="0" Kids$Soc="0"
YoungAdults$Soc="0" YoungAdults$Soc="0"
Plot_labels=c("Kids","Adolescents","Adults") Plot_labels=c("Children","Adolescents","Adults")
rbind(Kids,Adolescents,YoungAdults)->AllIndi rbind(Kids,Adolescents,YoungAdults)->AllIndi
...@@ -403,7 +402,7 @@ ggplot(AllIndi[AllIndi$Outcome=="Loss",],aes(x=Stage,y=howMuch,fill=Stage))+ ...@@ -403,7 +402,7 @@ ggplot(AllIndi[AllIndi$Outcome=="Loss",],aes(x=Stage,y=howMuch,fill=Stage))+
cowplot::plot_grid(One,Two,Three,NULL,Four,ncol=5,rel_widths = c(1,1,1,0.3,1.7))->Solo cowplot::plot_grid(One,Two,Three,NULL,Four,ncol=5,rel_widths = c(1,1,1,0.3,1.7))->Solo
ggsave(plot = Solo,"../X_Figures/EmergentBehavior_summary.png",width = 11,height = 4) ggsave(plot = Solo,"../X_Figures/EmergentBehavior_summary.png",width = 11,height = 4)
#print(Solo) print(Solo)
``` ```
# Number of explorative decisions # Number of explorative decisions
...@@ -416,10 +415,10 @@ So i now declare an explorative decision as switching a bandit. This is done by ...@@ -416,10 +415,10 @@ So i now declare an explorative decision as switching a bandit. This is done by
#create count for each new decision. #create count for each new decision.
# do it in parralel again # do it in parralel again
compute_sampling_strategy<-function(Plot_datAll,iteration){ compute_sampling_strategy<-function(Plot_datAll,subject){
library(dplyr) library(dplyr)
Plot_datAll%>%filter(iter==iteration)%>%group_by(x,y)%>%mutate(cumDens=cumsum(sample))%>%ungroup()%>% group_by(x,y, trials) %>% Plot_datAll%>%filter(iter==subject)%>%group_by(x,y)%>%mutate(cumDens=cumsum(sample))%>%ungroup()%>% group_by(x,y, trials) %>%
mutate(newC = ifelse(cumDens == 1 & lag(cumDens)==0, 1, 0))->newExp# if i take the derivative of this this might be exaclty what wouter was intersted in. mutate(newC = ifelse(cumDens == 1 & lag(cumDens)==0, 1, 0))->newExp# if i take the derivative of this this might be exaclty what wouter was intersted in.
newExp[is.na(newExp$newC),]$newC=1# newExp[is.na(newExp$newC),]$newC=1#
#now i have to "reset" so that each trial there can only be one new decision and because otherwise this will scale up the cumulative sum too much #now i have to "reset" so that each trial there can only be one new decision and because otherwise this will scale up the cumulative sum too much
...@@ -427,19 +426,23 @@ compute_sampling_strategy<-function(Plot_datAll,iteration){ ...@@ -427,19 +426,23 @@ compute_sampling_strategy<-function(Plot_datAll,iteration){
newExp$generalExplore=0 newExp$generalExplore=0
for( i in 1:length(unique(newExp$trials))){ for( i in 1:length(unique(newExp$trials))){
newExp[newExp$trials==i,]$newExplore=xor(newExp[newExp$trials==i,]$newC,newExp[newExp$trials==i-1,]$newC)# newExp[newExp$trials==i,]$newExplore=xor(newExp[newExp$trials==i,]$newC,newExp[newExp$trials==i-1,]$newC)#
print(i)
# newExp[newExp$trials==i,]$generalExplore=xor(newExp[newExp$trials==i,]$sample,newExp[newExp$trials==i-1,]$sample) # newExp[newExp$trials==i,]$generalExplore=xor(newExp[newExp$trials==i,]$sample,newExp[newExp$trials==i-1,]$sample)
} }
newExp$iter=iteration newExp$iter=subject
return(newExp) return(newExp)
} }
#saveRDS(newExp,"Derivatives_TrialWise.rds") #saveRDS(newExp,"Derivatives_TrialWise.rds")
if (loadfromdisk==F){ if (loadfromdisk==F){
newExp_all<-foreach(iteration=1:nIterations, .combine='rbind') %dopar%{ #newExp_all<-NULL
compute_sampling_strategy(Plot_datAll,iteration) #for(subject in 1:ntrialss){
# print(subject)
newExp_all<-foreach(subject = 1:ntrialss,.combine = "rbind",.verbose=T) %dopar%{
compute_sampling_strategy(Plot_datAll,subject)
} }
saveRDS(file = "../A_GeneratedFiles/solotraj.rds",object = newExp_all) saveRDS(file = "../A_GeneratedFiles/solotraj2.rds",object = newExp_all)
}else { }else {
newExp_all<-readRDS(file = "../A_GeneratedFiles/solotraj.rds") newExp_all<-readRDS(file = "../A_GeneratedFiles/solotraj2.rds")
} }
# to compute the derivative # to compute the derivative
...@@ -460,39 +463,43 @@ newExp_all%>%group_by(iter)%>% ...@@ -460,39 +463,43 @@ newExp_all%>%group_by(iter)%>%
explore2=explore-lag(explore,50) explore2=explore-lag(explore,50)
)%>%mutate( )%>%mutate(
Stage=case_when( Stage=case_when(
(trials<401)~"Kids", (trials<401)~"Children",
(trials>400&trials<800)~"Adolescents", (trials>400&trials<800)~"Adolescents",
(trials>800)~"Adults" (trials>800)~"Adults"
) ),
)%>%filter(!is.na(Stage) & trials %in% round(seq(50,1200,length.out = 24)))%>% Which="Solo"
)%>%#filter(trials>36 & (trials <401 | trials >508))%>%
filter(!is.na(Stage) & trials %in% round(seq(50,1200,length.out = 24)))%>%
ggplot(aes(x=trials,y=explore2))+ ggplot(aes(x=trials,y=explore2))+
stat_summary(geom="ribbon", fun.data="mean_sdl",alpha=0.2)+ stat_summary(geom="ribbon", fun.data="mean_sdl",alpha=0.2)+
stat_summary(geom="line",fun.y = "mean",color="black")+ stat_summary(geom="line",fun.y = "mean",color="black")+
#geom_jitter()+ # geom_jitter()+
#geom_rect(aes(xmin=50,xmax=400,ymin=-5,ymax=100,fill="1"),alpha=0.1)+ #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=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_rect(aes(xmin=801,xmax=1200,ymin=-5,ymax=100,fill="3"),alpha=0.1)+
#geom_spline(size=1)+ geom_spline(size=1)+
geom_point(aes(shape=Stage),size=1,alpha=0.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")+ 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))+ scale_shape_manual(name="Developmental\nStage",values=c(22,21,24))+
geom_vline(xintercept = 420, linetype="dotted",color="red")+ geom_vline(xintercept = 420, linetype="dotted",color="red")+
geom_vline(xintercept = 410, linetype="dotted",color="red")+ geom_vline(xintercept = 410, linetype="dotted",color="red")+
geom_vline(xintercept = 800, linetype="dotted",color="red")+ geom_vline(xintercept = 800, linetype="dotted",color="red")+
geom_vline(xintercept = 790, linetype="dotted",color="red")+ geom_vline(xintercept = 790, linetype="dotted",color="red")+
annotate("text",x=150,y=60,label=c("Childhood"))+ annotate("text",x=150,y=60,label=c("Children"))+
annotate("text",x=600,y=60,label=c("Adolescence"))+ annotate("text",x=600,y=60,label=c("Adolescents"))+
annotate("text",x=950,y=60,label=c("Adulthood"))+ annotate("text",x=950,y=60,label=c("Adults"))+
#scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+ #scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
#coord_cartesian(ylim=c(0,))+ #coord_cartesian(ylim=c(0,))+
scale_y_continuous(name="Explorative Decisions")+ scale_y_continuous(name="Exploration decisions")+
scale_x_continuous(name="iteration")+ scale_x_continuous(name="trials")+
ggtitle("Exploration -> Solo")+
guides(linetype=F)+ guides(linetype=F)+
theme_cowplot()->ExploreSoloPlot theme_minimal(14)
ggsave(plot=ExploreSoloPlot,filename="../X_Figures/TimecourseExplore.png",width=7,height=4)
#->ExploreSoloPlot
#ggsave(plot=ExploreSoloPlot,filename="../X_Figures/TimecourseExplore.png",width=6.3,height=5)
``` ```
...@@ -519,11 +526,11 @@ ggplot(AUCSoloTbl,aes(x=Stage,y=AUC))+ ...@@ -519,11 +526,11 @@ ggplot(AUCSoloTbl,aes(x=Stage,y=AUC))+
#geom_jitter(aes(group=iter,color=Stage),alpha=0.1)+ #geom_jitter(aes(group=iter,color=Stage),alpha=0.1)+
stat_summary(aes(x=Stage,y=AUC,fill=Stage),geom="bar",color="black",fun.y = "mean",stat="identity")+ stat_summary(aes(x=Stage,y=AUC,fill=Stage),geom="bar",color="black",fun.y = "mean",stat="identity")+
stat_summary(aes(color=Stage),geom="pointrange",color="black",fun.data = "mean_cl_boot")+ stat_summary(aes(color=Stage),geom="pointrange",color="black",fun.data = "mean_cl_boot")+
scale_x_discrete(name="Developmental Stage",breaks=c(1,2,3),labels=c("Kids","Adolescents","Adults"))+ scale_x_discrete(name="Developmental Stage",breaks=c(1,2,3),labels=c("Children","Adolescents","Adults"))+
ggtitle("Exploration (AUC) - Solo")+ ggtitle("Exploration (AUC) - Solo")+
scale_fill_brewer(palette = "Set2",breaks=c(1,2,3),labels=c("Kids","Adolescents","Adults"))+ scale_fill_brewer(palette = "Set2",breaks=c(1,2,3),labels=c("Children","Adolescents","Adults"))+
scale_y_continuous(name=c("AUC Explore"),limits=c(0,ylimauc))+ scale_y_continuous(name=c("AUC Explore"),limits=c(0,ylimauc))+
theme_cowplot()->AUCSolo theme_minimal(14)->AUCSolo
``` ```
...@@ -549,9 +556,9 @@ loadfromdisk=T ...@@ -549,9 +556,9 @@ loadfromdisk=T
cntrl_social<-list( cntrl_social<-list(
beta=0,# this scales risk attitude. beta=0,# this scales risk attitude.
#get tau #get tau
tau=0.8, tau=1,
mu0=100,#exploration bonus mu0=100,#exploration bonus
var0=5, var0=40,
#create a parameter vector #create a parameter vector
parVec <- c(0.8, 0.8, 1, .0001) , parVec <- c(0.8, 0.8, 1, .0001) ,
#loop through trials #loop through trials
...@@ -561,8 +568,8 @@ cntrl_social<-list( ...@@ -561,8 +568,8 @@ cntrl_social<-list(
overallCnt=1, overallCnt=1,
dat_social=expand.grid(x1=1:12,x2=1:12), dat_social=expand.grid(x1=1:12,x2=1:12),
HowManyOthers=18, HowManyOthers=19,
diminishingSocial=0.9 diminishingSocial=0.8
# info about the agents # info about the agents
) )
...@@ -669,7 +676,7 @@ WhereIsEverybody<-function(HowManyOthers,others,otherLoc,dat_social,X_oth,y_oth, ...@@ -669,7 +676,7 @@ WhereIsEverybody<-function(HowManyOthers,others,otherLoc,dat_social,X_oth,y_oth,
```{r} ```{r}