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,
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}
library("viridis")
envirionmentMeanKids=seq(-50,50,length.out=5)#define the range of kid envirionemt
envirionmentVarianceKids=seq(1,10,length.out=5)
EnvirionemntKids=expand.grid(Mean=envirionmentMeanKids,Variance=envirionmentVarianceKids)# we sample from this later
......@@ -47,28 +47,23 @@ EnvirionemntAdol%>%ungroup()
EnvirionemntAdol%>%dplyr::rowwise()%>%mutate(value=rnorm(1,mean = Mean,sd=Variance))%>%
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_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 / Loss"))+
annotate("text",x=50,y=42,label=c("High Risk / Reward"))+
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))%>%
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_alpha_discrete(range = c(0.2, 1))+
scale_fill_viridis(name="Outcome",option="plasma",direction = -1)+
scale_alpha_discrete(range = c(1, 0.6))+
geom_hline(aes(yintercept=40),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 / 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
guides(alpha=F)+theme_minimal()+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())->Kid
legend=cowplot::get_legend(Kid)
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")),
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")
```
```{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
Here i define the kalman filter and the choice rule.
......@@ -110,7 +218,7 @@ bayesianMeanTracker <- function(x, y, theta, prevPost=NULL,mu0Par,var0Par){
allopts<-expand.grid(1:12, 1:12)
chosen <- which(allopts$Var1==x[1] & allopts$Var2==x[2])
#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
predictions$mu[chosen] <- predictions$mu[chosen] + (kGain * (y-predictions$mu[chosen]))
#update variance for observed arm
......@@ -157,7 +265,7 @@ beta<-0# this scales risk attitude.
#get tau
tau<-0.8
mu0<-100#exploration bonus
var0<-5
var0<-80
#create a parameter vector
parVec <- c(lambda, lambda, 1, .0001)
#
......@@ -392,6 +500,8 @@ for( i in 1:length(unique(newExp$trials))){
saveRDS(newExp,"Derivatives_TrialWise.rds")
# to compute the derivative
#newExp<-readRDS("Derivatives_TrialWise.rds")
```
# Plot
......@@ -435,6 +545,7 @@ newExp%>%ungroup()%>%
ggtitle("Exploration -> Solo")+
guides(linetype=F)+
theme_cowplot()
ggsave("../X_Figures/TimecourseExplore.png",width=7,height=4)
```
# Area under the curve
......
......@@ -2,11 +2,10 @@
title: "Adaptive_Adolescence_multi"
author: "Simy"
date: "28/08/2020"
output:
html_document:
code_folding: hide
output:
github_document:
toc: true
toc_float: true
toc_depth: 2
---
```{r setup, include=FALSE}
......@@ -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=42,label=c("High Risk / Reward"))+
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))%>%
......@@ -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 / Loss"))+
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")
# load the kalman filter and the UCB 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
......@@ -97,7 +96,7 @@ bayesianMeanTracker <- function(x, y, theta, prevPost=NULL,mu0Par,var0Par){
allopts<-expand.grid(1:12, 1:12)
chosen <- which(allopts$Var1==x[1] & allopts$Var2==x[2])
#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
predictions$mu[chosen] <- predictions$mu[chosen] + (kGain * (y-predictions$mu[chosen]))
#update variance for observed arm
......@@ -144,7 +143,7 @@ cntrl=list(
#get tau
tau=0.8,
mu0=100,#exploration bonus
var0=5,
var0=40,
#create a parameter vector
parVec = c(0.8, 0.8, 1, .0001) ,
#
......@@ -161,8 +160,8 @@ cntrl=list(
##
##
## Here i store the multiple Sims
nIterations=100
list_Iter <- vector(mode = "list", length = nIterations)
ntrialss=100
list_Iter <- vector(mode = "list", length = ntrialss)
```
# Make observations
......@@ -185,7 +184,7 @@ if(loadfromdisk==F){
```{r}
exploreEnv<-function(explore_func,choiceRule,env2,env1,cntrl,iter){
#for (rep in 1:nIterations){
#for (rep in 1:ntrialss){
#unpack
lambda=cntrl$lambda
#get beta
......@@ -296,7 +295,7 @@ exploreEnv<-function(explore_func,choiceRule,env2,env1,cntrl,iter){
}
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)
}
saveRDS(file="../A_GeneratedFiles/Plot_datAll",object = Plot_datAll)
......@@ -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),
Outcome=case_when(
(out<0)~"Loss",
(out>=0)~"Win"
(out>=0)~"Gain"
)
)%>%group_by(Outcome,iter)%>%summarise(howMany=n()/144,
howMuch=sum(out))->Kids
......@@ -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),
Outcome=case_when(
(out<0)~"Loss",
(out>=0)~"Win"
(out>=0)~"Gain"
)
)%>%group_by(Outcome,iter)%>%summarise(howMany=n()/144,
howMuch=sum(out))->Adolescents
......@@ -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),
Outcome=case_when(
(out<0)~"Loss",
(out>=0)~"Win"
(out>=0)~"Gain"
)
)%>%group_by(Outcome,iter)%>%summarise(howMany=n()/144,
howMuch=sum(out)
......@@ -348,7 +347,7 @@ Adolescents$Soc="0"
Kids$Soc="0"
YoungAdults$Soc="0"
Plot_labels=c("Kids","Adolescents","Adults")
Plot_labels=c("Children","Adolescents","Adults")
rbind(Kids,Adolescents,YoungAdults)->AllIndi
......@@ -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
ggsave(plot = Solo,"../X_Figures/EmergentBehavior_summary.png",width = 11,height = 4)
#print(Solo)
print(Solo)
```
# Number of explorative decisions
......@@ -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.
# do it in parralel again
compute_sampling_strategy<-function(Plot_datAll,iteration){
compute_sampling_strategy<-function(Plot_datAll,subject){
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.
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
......@@ -427,19 +426,23 @@ compute_sampling_strategy<-function(Plot_datAll,iteration){
newExp$generalExplore=0
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)#
print(i)
# 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)
}
#saveRDS(newExp,"Derivatives_TrialWise.rds")
if (loadfromdisk==F){
newExp_all<-foreach(iteration=1:nIterations, .combine='rbind') %dopar%{
compute_sampling_strategy(Plot_datAll,iteration)
#newExp_all<-NULL
#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 {
newExp_all<-readRDS(file = "../A_GeneratedFiles/solotraj.rds")
newExp_all<-readRDS(file = "../A_GeneratedFiles/solotraj2.rds")
}
# to compute the derivative
......@@ -460,39 +463,43 @@ newExp_all%>%group_by(iter)%>%
explore2=explore-lag(explore,50)
)%>%mutate(
Stage=case_when(
(trials<401)~"Kids",
(trials<401)~"Children",
(trials>400&trials<800)~"Adolescents",
(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))+
stat_summary(geom="ribbon", fun.data="mean_sdl",alpha=0.2)+
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=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_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))+
scale_shape_manual(name="Developmental\nStage",values=c(22,21,24))+
geom_vline(xintercept = 420, linetype="dotted",color="red")+
geom_vline(xintercept = 410, linetype="dotted",color="red")+
geom_vline(xintercept = 800, linetype="dotted",color="red")+
geom_vline(xintercept = 790, linetype="dotted",color="red")+
annotate("text",x=150,y=60,label=c("Childhood"))+
annotate("text",x=600,y=60,label=c("Adolescence"))+
annotate("text",x=950,y=60,label=c("Adulthood"))+
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,))+
scale_y_continuous(name="Explorative Decisions")+
scale_x_continuous(name="iteration")+
ggtitle("Exploration -> Solo")+
scale_y_continuous(name="Exploration decisions")+
scale_x_continuous(name="trials")+
guides(linetype=F)+
theme_cowplot()->ExploreSoloPlot
ggsave(plot=ExploreSoloPlot,filename="../X_Figures/TimecourseExplore.png",width=7,height=4)
theme_minimal(14)
#->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))+
#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(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")+
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))+
theme_cowplot()->AUCSolo
theme_minimal(14)->AUCSolo
```
......@@ -549,9 +556,9 @@ loadfromdisk=T
cntrl_social<-list(
beta=0,# this scales risk attitude.
#get tau
tau=0.8,
tau=1,
mu0=100,#exploration bonus
var0=5,
var0=40,
#create a parameter vector
parVec <- c(0.8, 0.8, 1, .0001) ,
#loop through trials
......@@ -561,8 +568,8 @@ cntrl_social<-list(
overallCnt=1,
dat_social=expand.grid(x1=1:12,x2=1:12),
HowManyOthers=18,
diminishingSocial=0.9
HowManyOthers=19,
diminishingSocial=0.8
# info about the agents
)
......@@ -669,7 +676,7 @@ WhereIsEverybody<-function(HowManyOthers,others,otherLoc,dat_social,X_oth,y_oth,
```{r}
#otherLoc=0
exploreEnv_Social<-function(explore_func,choiceRule,socialfunc,env2,env1,cntrl,iter){
#for (rep in 1:nIterations){
#for (rep in 1:ntrialss){
#unpack
lambda=cntrl$lambda
#get beta
......@@ -819,14 +826,14 @@ exploreEnv_Social<-function(explore_func,choiceRule,socialfunc,env2,env1,cntrl,i
}
#loadfromdisk==F
if (loadfromdisk==F){
Plot_dat_social_All<-foreach(iteration=1:nIterations, .combine='rbind') %dopar%{
Plot_dat_social_All<-foreach(trials=1:ntrialss, .combine='rbind') %dopar%{
exploreEnv_Social(explore_func=bayesianMeanTracker,
choiceRule=ucb,
socialfunc=WhereIsEverybody,
env2=EnvirionemntAdol,
env1=EnvirionemntKids,
cntrl=cntrl_social,
iteration)
trials)
}
saveRDS(file="../A_GeneratedFiles/Plot_dat_social_All.rds",object=Plot_dat_social_All)
} else{
......@@ -839,7 +846,7 @@ if (loadfromdisk==F){
# Now lets contrast the relative & the total number of risky decisions.
This plot shows the same as above. Counts of Wins and Losses and Severity in Losses.
This plot shows the same as above. Counts of Gains and Losses and Severity in Losses.
Generally having others in this patch seems to help making better decisions, also during adolescence!
```{r fig.width=10}
......@@ -847,7 +854,7 @@ Plot_dat_social_All[length(Plot_dat_social_All$x),]$out=-0.1# dummy to make the
Plot_dat_social_All%>%group_by(x,y,iter)%>%filter(trials<=400)%>%mutate(cumDens=cumsum(sample),
Outcome=case_when(
(out<0)~"Loss",
(out>=0)~"Win"
(out>=0)~"Gain"
)
)%>%group_by(Outcome,iter)%>%summarise(howMany=n()/144,
howMuch=sum(out))->KidsSoc
......@@ -855,7 +862,7 @@ Plot_dat_social_All%>%group_by(x,y,iter)%>%filter(trials<=400)%>%mutate(cumDens=
Plot_dat_social_All%>%group_by(x,y,iter)%>%filter(trials>=400 & trials<800)%>%mutate(cumDens=cumsum(sample),
Outcome=case_when(
(out<0)~"Loss",
(out>=0)~"Win"
(out>=0)~"Gain"
)
)%>%group_by(Outcome,iter)%>%summarise(howMany=n()/144,
howMuch=sum(out))->AdolescentsSoc
......@@ -863,7 +870,7 @@ Plot_dat_social_All%>%group_by(x,y,iter)%>%filter(trials>=400 & trials<800)%>%mu
Plot_dat_social_All%>%group_by(x,y,iter)%>%filter(trials>800 & trials<1200)%>%mutate(cumDens=cumsum(sample),
Outcome=case_when(
(out<0)~"Loss",
(out>=0)~"Win"
(out>=0)~"Gain"
)
)%>%group_by(Outcome,iter)%>%summarise(howMany=n()/144,
howMuch=sum(out)
......@@ -877,7 +884,7 @@ AdolescentsSoc$Soc="1"
KidsSoc$Soc="1"
YoungAdultsSoc$Soc="1"
Plot_labels=c("Kids","Adolescents","Adults")
Plot_labels=c("Children","Adolescents","Adults")
rbind(KidsSoc,AdolescentsSoc,YoungAdultsSoc)->AllSoc
```
......@@ -916,7 +923,7 @@ ggplot(YoungAdultsSoc,aes(x=Outcome,y=howMany,fill=Outcome))+
theme_minimal(8)->Three
#Now, look at the outcome
ggplot(AllSoc[AllSoc$Outcome=="Win",],aes(x=Stage,y=howMuch,fill=Stage))+
ggplot(AllSoc[AllSoc$Outcome=="Gain",],aes(x=Stage,y=howMuch,fill=Stage))+
geom_jitter(aes(group=iter,color=Stage),alpha=0.3)+
stat_summary(aes(color=Stage),geom="pointrange",color="black",fun.data = "mean_cl_boot")+
scale_y_continuous(name="Cumulative Loss")+
......@@ -934,59 +941,78 @@ ggsave(plot = Social,"../X_Figures/EmergentBehavior_summary_Social.png",width =
```
#make plot
```{r fig.width=12,fig.height=5}
AllSoc%>%ggplot(aes(x=Outcome,y=howMany,shape=Outcome,color=Stage))+
geom_jitter(aes(group=iter),alpha=0.2)+
stat_summary(aes(color=Stage),geom="pointrange",fun.data = "mean_cl_boot",size=1)+
scale_y_continuous(name="Number of outcomes encountered")+
```{r fig.width=9,fig.height=4}
AllSoc%>%ggplot(aes(x=Stage,y=howMany,color=Outcome))+
geom_jitter(aes(group=iter,shape=Stage),alpha=0.2)+
#stat_summary(aes(fill=Outcome),geom="pointrange",fun.data = "mean_cl_boot",size=0.7,color="black")+
stat_smooth(aes(x=as.numeric(Stage)))+
geom_boxplot(width=0.5,position = position_dodge(0))+
scale_y_continuous(name="N outcomes")+
scale_x_discrete("",breaks=c("1","2","3"),labels=Plot_labels)+
coord_cartesian(ylim=c(0,400))+
scale_color_brewer(palette = "Dark2",name="Developmental Stage",breaks=c("1","2","3"),labels=Plot_labels)+
guides(fill=F)+
ggtitle("Social")+
scale_shape_manual(name="",breaks=c("1","2","3"),labels=Plot_labels,values=c(24,22,21))+
guides(fill=F,shape=F)+
ggtitle("")+
theme_minimal(14)->SocialQual
ggplot(AllSoc,aes(x=Stage,y=abs(howMuch),color=Outcome))+
geom_jitter(aes(group=iter),alpha=0.2)+
AllSoc%>%ggplot(aes(x=Stage,y=abs(howMuch),color=Outcome))+
geom_jitter(aes(group=iter,shape=Stage),alpha=0.2)+
stat_smooth(aes(x=as.numeric(Stage)))+
stat_summary(aes(group=Outcome),geom="pointrange",color="black",fun.data = "mean_cl_boot",size=1)+
scale_y_continuous(name="magnitude of outcomes")+
scale_x_discrete("Developmental Stage",breaks=c("1","2","3"),labels=Plot_labels)+
geom_boxplot(width=0.5,position = position_dodge(0))+
#stat_summary(aes(group=Outcome,shape=Stage,fill=Outcome),geom="pointrange",color="black",fun.data = "mean_cl_boot",size=0.7)+
scale_y_continuous(name="Outcome magnitude")+
scale_x_discrete("",breaks=c("1","2","3"),labels=Plot_labels)+
ggtitle("")+
geom_hline(aes(yintercept=0),size=1,linetype="dotdash")+
coord_cartesian(ylim=c(0,6000000))+
#guides(fill=F)+
scale_shape_manual(name="",breaks=c("1","2","3"),labels=Plot_labels,values=c(24,22,21))+
coord_cartesian(ylim=c(0,7000000))+
guides(fill=F,shape=F)+
theme_minimal(14)->SocialQuant
ggplot(AllIndi,aes(x=Stage,y=abs(howMuch),color=Outcome))+
geom_jitter(aes(group=iter),alpha=0.2)+
geom_jitter(aes(group=iter,shape=Stage),alpha=0.2)+
stat_smooth(aes(x=as.numeric(Stage)))+
stat_summary(aes(group=Outcome),geom="pointrange",color="black",fun.data = "mean_cl_boot",size=1)+
scale_y_continuous(name="magnitude of outcomes")+
scale_x_discrete("Developmental Stage",breaks=c("1","2","3"),labels=Plot_labels)+
geom_boxplot(width=0.5,position = position_dodge(0))+
scale_y_continuous(name="Outcome magnitude")+
scale_x_discrete("",breaks=c("1","2","3"),labels=Plot_labels)+
ggtitle("")+
geom_hline(aes(yintercept=0),size=1,linetype="dotdash")+
coord_cartesian(ylim=c(0,6000000))+
#guides(fill=F)+
scale_shape_manual(name="",breaks=c("1","2","3"),labels=Plot_labels,values=c(24,22,21))+
coord_cartesian(ylim=c(0,7000000))+
guides(fill=F,shape=F)+
theme_minimal(14)->IndiQuant
AllIndi%>%ggplot(aes(x=Outcome,y=howMany,shape=Outcome,color=Stage))+
geom_jitter(aes(group=iter),alpha=0.2)+
stat_summary(aes(color=Stage),geom="pointrange",fun.data = "mean_cl_boot",size=1)+
scale_y_continuous(name="Number of outcomes encountered")+
AllIndi%>%ggplot(aes(x=Stage,y=howMany,color=Outcome))+
geom_jitter(aes(group=iter,shape=Stage),alpha=0.2)+
#stat_summary(aes(fill=Outcome),geom="pointrange",fun.data = "mean_cl_boot",size=0.7,color="black")+
stat_smooth(aes(x=as.numeric(Stage)))+
geom_boxplot(width=0.5,position = position_dodge(0))+
scale_y_continuous(name="N outcomes")+
scale_x_discrete("",breaks=c("1","2","3"),labels=Plot_labels)+
scale_shape_manual(name="",breaks=c("1","2","3"),labels=Plot_labels,values=c(24,22,21))+
coord_cartesian(ylim=c(0,400))+
scale_color_brewer(palette = "Dark2",name="Developmental Stage",breaks=c("1","2","3"),labels=Plot_labels)+
guides(fill=F)+
ggtitle("Solo")+
guides(fill=F,shape=F)+
ggtitle("")+
theme_minimal(14)->IndiQual
cowplot::plot_grid(IndiQual,NULL,IndiQuant,labels=c("A","","B"),rel_widths = c(1,0.1,1),ncol = 3)->OutcomesSolo