AdaptiveAdolescentrProject.Rmd 54.5 KB
Newer Older
Simon Ciranka's avatar
Simon Ciranka committed
1
2
3
4
5
6
7
8
9
10
---
title: "The Adaptive Adolescent"
author: "Simy"
date: "04/06/2020"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)

Ciranka's avatar
Ciranka committed
11
pacman::p_load(tidyverse,cowplot,matrixcalc,gganimate,ggformula,pracma)
Simon Ciranka's avatar
Simon Ciranka committed
12
13
```

Ciranka's avatar
Ciranka committed
14
# Adolescence and Ecological Rationality -> UNCERTAINTY NEUTRAL
Simon Ciranka's avatar
Simon Ciranka committed
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Often times adolescents are described as incredible risk seekers. This is backed up with evidence from neuroimaging, indicating that adolescents reward sensitivity matures faster than their ability to control their impulses. However,
there is another sociological feature that defines the adolescent period. Adolescents have to find independence. To become independent decision-makers, they need to expierience and explore what it means to make good decisions under uncertainty. Exploration however is often times costly as sometimes it might happen that a risky leap into the unkown results in a bad outcome.
We propose that adolescents prevalent increase in risky behavior can be emergent from their explorative behavior, which is situated in a world that provides an increasing amount of options and possibilites to them. When indivudals enter adoelscence they have expierienced the world within the constraints which their parents set to them. These constraints are then gradually loosened by caregivers. The rich world which lies ahead of them is full of pitfalls but learning how to navigate the worlds uncertainties can only be sucessful on the base of individual expierence.
Whe therefore beleive that an understanding of adolescent risk taking does not necessate the assumption of increased reward sensitivty but can emerge from an exploration policy that seeks out uncertainty in combination with increasing possibilities of how to behave.

# Setup
In our model of risk taking in adolescence, risk taking becomes emergent from adolescnets propensity to explore their environemt, which offers an increasing amount of behaviorual options. We concieve thiese options as probabilisitc patches in a growing environment. 
The difference between adolescnece and childhood is the amount of possible rewards that can be explored. While childhood offers a lot of relativiely safe opportunities, the behaviors that become aware to the adolescent also carry a big detrimental potential which however is unkown to them. 

We setup two environemtns where we understand exploration/exploitation as a multi armed bandid problem. One for childhood, another for adolescence. The child environemtn is a 10x10 grid with each cell in the grid being a bandit that has relatively low variance and losses are not possible.
The adolescent environemnt presents itself as a 100x100 grid where there is more variance and losses are possible.
We start with letting one agent solve this explore exploit dilemma.

#Problem!
We need to do some more thinking on the environment because as it is now lower and upper corners dont differ in how good they are on average. 
That is why agents end up on the right but it doesnt seem to make a difference where exactly on the vertical. Maybe the upper quarter is even more advantageous? 
I now implemented a slightly different environment in which all values can be better than the average but not better than some threshold.
Specificly i re sample the reward if it is over 120. Now, as you may see below, they become "risk-averse".

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}
37
library("viridis")
Simon Ciranka's avatar
Simon Ciranka committed
38
envirionmentMeanKids=seq(-50,50,length.out=5)#define the range of kid envirionemt
Ciranka's avatar
Ciranka committed
39
40
envirionmentVarianceKids=seq(1,10,length.out=5)
EnvirionemntKids=expand.grid(Mean=envirionmentMeanKids,Variance=envirionmentVarianceKids)# we sample from this later
Simon Ciranka's avatar
Simon Ciranka committed
41
42
43

#define the range of adolescent environment
envirionmentMeanAdol=seq(-100,100,length.out=12)
Ciranka's avatar
Ciranka committed
44
45
envirionmentVarianceAdol=seq(1,80,length.out=12)
EnvirionemntAdol=expand.grid(Mean=envirionmentMeanAdol,Variance=envirionmentVarianceAdol)
Simon Ciranka's avatar
Simon Ciranka committed
46
47
EnvirionemntAdol%>%ungroup()

Ciranka's avatar
Ciranka committed
48
49
EnvirionemntAdol%>%dplyr::rowwise()%>%mutate(value=rnorm(1,mean = Mean,sd=Variance))%>%
  ggplot(aes(x=Mean,y=Variance,fill=value))+geom_tile()+
50
  scale_fill_viridis(name="Outcome",option="plasma",direction = -1)+
Ciranka's avatar
Ciranka committed
51
  geom_hline(aes(yintercept=40),size=2)+
Simon Ciranka's avatar
Simon Ciranka committed
52
  geom_vline(aes(xintercept=0),size=2)+
Ciranka's avatar
Ciranka committed
53
54
55
56
  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"))+
57
  ggtitle("Adolescent Environment")+theme_minimal()+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())->Adolescent
Simon Ciranka's avatar
Simon Ciranka committed
58
59


Ciranka's avatar
Ciranka committed
60
61
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()+
62
63
  scale_fill_viridis(name="Outcome",option="plasma",direction = -1)+
  scale_alpha_discrete(range = c(1, 0.6))+
Ciranka's avatar
Ciranka committed
64
  geom_hline(aes(yintercept=40),size=2)+
Simon Ciranka's avatar
Simon Ciranka committed
65
  geom_vline(aes(xintercept=0),size=2)+
66
  guides(alpha=F)+theme_minimal()+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())->Kid
Simon Ciranka's avatar
Simon Ciranka committed
67
68
69
70
71
72
73

legend=cowplot::get_legend(Kid)
cowplot::plot_grid(Kid+theme(legend.position="none"),
                   Adolescent+theme(legend.position="none",
                                    axis.title.y = element_text(colour="white")),
                   legend,ncol =3,rel_widths = c(1,1,0.2))

74
75
ggsave(plot=Kid,filename = "/X_Figures/Environment_new2.png")

Simon Ciranka's avatar
Simon Ciranka committed
76
77
78
ggsave(filename = "../X_Figures/Environments.png")
```

79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
```{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)
Simon Ciranka's avatar
Simon Ciranka committed
125

126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
```


# 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)

```
Simon Ciranka's avatar
Simon Ciranka committed
191

Ciranka's avatar
Ciranka committed
192
193
194
195
196
197
198
# 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: 

* mu0, or Optimism: its prior assumption about how rewarding the envirionment will be on average. This Paramter will also gouvern the extend of exploration

* var0, or speed of learning: its prior uncertainty about that mean. the higher prior uncertainty is, the more extremely will the agent update its beliefs in the beginning after observing a new sample
Simon Ciranka's avatar
Simon Ciranka committed
199

Ciranka's avatar
Ciranka committed
200
201
202
203
204
* vare, or imprecision: Imprecision will impact the speed of updating as well. The higher the imprecision parameter, the more uncertain the agent will remain about one options mean, even after observing a lot of samples.

New samples are generated using an upper (lower) confidence bound rule where the uncertainty about an option is added to (subtracted from) the beleif about the mean of this option. This policy regulates exploration as well where we can vary uncertaintyphile or phobe behavioral ploicies. This proces is subject to paramter

* beta, or uncertainty aversion (seeking)
Simon Ciranka's avatar
Simon Ciranka committed
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
```{r}
bayesianMeanTracker <- function(x, y, theta, prevPost=NULL,mu0Par,var0Par){ 
  #Updates the previous posterior based on a single observation
  #parameters
  mu0 <- mu0Par #prior mean
  var0 <- var0Par #prior variance
  vare <- theta[1] #error varriance
  if (is.null(prevPost)){#if no posterior prior, assume it is the first observation
    predictions <- data.frame(mu=rep(mu0,144), sig=rep(var0,144))
  }else{#if previous posterior is provided, update
    predictions <- prevPost
  }
  #Which of the 121 options were chosen at time?
  allopts<-expand.grid(1:12, 1:12)
  chosen <- which(allopts$Var1==x[1] & allopts$Var2==x[2])
  #Kalman gain
221
  kGain <- predictions$sig[chosen] / (predictions$sig[chosen] + 360)#EnvirionemntAdol$Variance[chosen]^2)# feed the uncertainty in here.
Simon Ciranka's avatar
Simon Ciranka committed
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
  #update mean
  predictions$mu[chosen] <- predictions$mu[chosen] + (kGain * (y-predictions$mu[chosen]))
  #update variance for observed arm
  predictions$sig[chosen] <- predictions$sig[chosen] * (1 - kGain)
  #return output
  return(predictions)
}
class(bayesianMeanTracker)<- c(class(bayesianMeanTracker), "KalmanFilter")


ucb<-function(out, pars, refactor=F){
  if (refactor==TRUE){
    gamma <- pars[1]
    beta_star<-pars[2]
    #calulate all the upper confidence bounds
    outtotal<-(gamma*out$mu)#+(beta_star*sqrt(out$sig)) #refactored parameters in combination with softmax tau, where gamma = 1/tau and beta_star = beta/tau
    #avoid borderline cases
    #outtotal[outtotal<=0]<-0.0001
    #outtotal[outtotal>100]<-100
    outtotal<-matrix(outtotal, ncol=1, byrow=TRUE)
  }else{
    beta <- pars[1]
    #calulate all the upper confidence bounds
    outtotal<-out$mu+(beta*sqrt(out$sig)) #refactored parameters in combination with softmax tau, where gamma = 1/tau and beta_star = beta/tau
    #avoid borderline cases
    #outtotal[outtotal<=0]<-0.0001
    #outtotal[outtotal>99]<-99
    outtotal<-matrix(outtotal, ncol=1, byrow=TRUE)
  }
  #return them
  return(outtotal)
}
```

Ciranka's avatar
Ciranka committed
256
257
### some values to set.
```{r setupObser}
Simon Ciranka's avatar
Simon Ciranka committed
258
259
260
261
# get sd of whole environemt for normalizing model input
set.seed(as.numeric(Sys.time()))

#get lambda
Ciranka's avatar
Ciranka committed
262
lambda=0.8
Simon Ciranka's avatar
Simon Ciranka committed
263
264
265
266
267
#get beta
beta<-0# this scales risk attitude.
#get tau
tau<-0.8
mu0<-100#exploration bonus
268
var0<-80
Simon Ciranka's avatar
Simon Ciranka committed
269
270
271
272
273
#create a parameter vector
parVec <- c(lambda, lambda, 1, .0001) 
#
ExploreBonus=0
#kernel is RBF
Ciranka's avatar
Ciranka committed
274
#k<-rbf
Simon Ciranka's avatar
Simon Ciranka committed
275
276
277
278
279
280
#loop through trials
out=NULL
AllChoices=NULL
dummy=NULL
overallCnt=1
dat=expand.grid(x1=1:12,x2=1:12)
Ciranka's avatar
Ciranka committed
281
282
283
284
285
286
287
```

# Make observations
Here i let the agent learn about the envirionment.
There are three phases of the simulation. Phase one is "childhood". During childhood Agents can explore only the lower middle quadrant. Here all decisions have low risk and there are some low rewards possible. 
Phase two, that occurs after some learning experience (400 samples), can be understood as the onset of adolescence. Here the whole environment becomes availible but the agent does not know about it so they have to learn.
Then after another 400 samples, the agent transitions into "adulthood" where the same environment is still present but the learning expierience now lead to greater exploitation of presumably advantengeous options.
Simon Ciranka's avatar
Simon Ciranka committed
288

Ciranka's avatar
Ciranka committed
289
290
```{r}
for (nround in 1:3){
Simon Ciranka's avatar
Simon Ciranka committed
291
292
293
294
295
296
297
  #get parameters for participant on that round
  if (nround==1){
    # define vectors that are used by the kalman filter
    lowestx=4
    highestx=9
    sampleVec=as.numeric(rownames(dat[dat$x1>=lowestx & dat$x1<=highestx  & dat$x2<7,]))# here you define where a child should sample from
    ind<-sample(sampleVec,1)
Ciranka's avatar
Ciranka committed
298
    nTrials=400
Simon Ciranka's avatar
Simon Ciranka committed
299
300
  }else {
    ind<-sample(1:144,1)
Ciranka's avatar
Ciranka committed
301
    nTrials=400
Simon Ciranka's avatar
Simon Ciranka committed
302
303
304
305
306
  }
  #random initialization as observation t=0
  #y matrix
  if (nround==1 & overallCnt==1){
    X<-as.matrix(dat[ind,1:2])# generate a new vector of Xs
Ciranka's avatar
Ciranka committed
307
    y<-as.matrix(rnorm(1,mean = EnvirionemntAdol[ind,]$Mean,sd=EnvirionemntAdol[ind,]$Variance))
Simon Ciranka's avatar
Simon Ciranka committed
308
309
310
  }else if(overallCnt==1) {
    print("Youre an adolescent now")
    X<-as.matrix(dat[ind,1:2])# generate a new vector of Xs
Ciranka's avatar
Ciranka committed
311
    y<-as.matrix(rnorm(1,mean = EnvirionemntAdol[ind,]$Mean,sd=EnvirionemntAdol[ind,]$Variance))
Simon Ciranka's avatar
Simon Ciranka committed
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
  }
  #X-start, i.e. all possible observations
  Xstar<-as.matrix(dat[,1:2])
  
  for (trial in 1:nTrials){
    #output by GP with particular parameter settings
    #don't forget mean centering and standardization.... mean is already 0 :)
    if (overallCnt>1){
      out<-bayesianMeanTracker(X[overallCnt,1:2],y[overallCnt], theta=lambda, prevPost=out,mu0Par=mu0,var0Par = var0)
    }else{
      out<-bayesianMeanTracker(X[overallCnt,1:2],y[overallCnt],theta=lambda, prevPost=NULL,mu0Par=mu0,var0Par=var0)
    }
    #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....
    #
    utilityVec<-ucb(out,beta)
    utilities <- utilityVec - max(utilityVec)
    #softmaximization
    p <- exp(utilities/tau)
    #probabilities
    p <- p/colSums(p)
    #numerical overflow
    p <- (pmax(p, 0.00001))
    p <- (pmin(p, 0.99999))
    #index is sampled proprotionally to softmaxed utitily vector
    if (nround==1){# subset the probability vector so that it corresponds to the right tiles.
      ind<-sample(sampleVec,1,prob=p[dat$x1>=lowestx & dat$x1<=highestx & dat$x2<7,])# sample from a childhood environemnt
      #this monster just scales exploration boni
    }else {
      ind<-sample(1:144, 1, prob=p)# sample from an adolescent environemnt
      # print(ind)
    }
    X<-rbind(X, as.matrix(dat[ind,1:2]))
    #bind y-observations
Ciranka's avatar
Ciranka committed
347
    y<-rbind(y, as.matrix(rnorm(n=1,mean = EnvirionemntAdol[ind,]$Mean,sd=EnvirionemntAdol[ind,]$Variance)))# change this into a sample.
Simon Ciranka's avatar
Simon Ciranka committed
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
    #if(y[overallCnt]<0){
    #  y[overallCnt]=-1*y[overallCnt]^2# make losses more severe. 
    #}
    
    dummy<-data.frame(trial=overallCnt, x=as.numeric(X[overallCnt,1]), y=as.numeric(X[overallCnt,2]),
                      z=as.numeric(y[overallCnt]),round=nround)
    
    AllChoices<-rbind(AllChoices,dummy)
    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


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]
}
```

Ciranka's avatar
Ciranka committed
375
376
377
# Animate the exploration.
Here, i plot how often each bandit gets sampled. In each timestep i show the sum of decisions in favor of each option in the color code where brighter colors indicate more samples.

Simon Ciranka's avatar
Simon Ciranka committed
378
379
380
381
382
383
384
385
386
387
388
```{r}
library(gganimate)# you can plot the trajectory with gganimate. 
Plot_dat%>%group_by(x,y)%>%mutate(cumDens=cumsum(sample))%>%
  ggplot(aes(x=x,y=y,fill=cumDens))+
  geom_tile()+
  scale_fill_viridis_c()+
  scale_y_continuous(name="Variance in Outcomes",breaks=c(0,2.5,5.0,7.5,10.0,12.5),labels=seq(1,80,length.out=6))+
  scale_x_continuous(name="Mean Outcome",breaks=c(0,2.5,5.0,7.5,10.0,12.5),labels=seq(-100,100,length.out=6))+
  ggtitle("Sampling Density trial {frame_time}")+
  transition_time(trials)+theme_cowplot()->anim#plot(anim)
animate(anim)
Ciranka's avatar
Ciranka committed
389
anim_save(animation = animate(anim), filename ="../X_Figures/Sampling_Timecourse_indi.gif")
Simon Ciranka's avatar
Simon Ciranka committed
390
391
392
393
394
395
```




# Now lets contrast the relative & the total number of risky decisions.
Ciranka's avatar
Ciranka committed
396
397
Here i compare different developmental phases with respect to how many rewards and losses have been encounterd as a consequence of exploring this envirionment. An exploring agent likely samples highly disadventegous options which agents with more expierience may avoid. Therefore I also show how severe the losses were on average in each developmental phase. An interesting divergence occurs here:
While encountered losses decrease and rewards increase across development; the severity of losses is highest for the adolescent agents who still need to explore the environment.
Simon Ciranka's avatar
Simon Ciranka committed
398
399

```{r fig.width=10}
Ciranka's avatar
Ciranka committed
400
Plot_dat%>%group_by(x,y)%>%filter(trials<=400)%>%mutate(cumDens=cumsum(sample),
Simon Ciranka's avatar
Simon Ciranka committed
401
402
403
404
405
406
407
                                                        Risk=case_when(
                                                          (out<0)~"Loss",
                                                          (out>=0)~"Win"
                                                        )
)%>%group_by(Risk)%>%summarise(howMany=n()/144,
                               howMuch=sum(out))->Kids

Ciranka's avatar
Ciranka committed
408
409
410
411
412
Plot_dat%>%group_by(x,y)%>%filter(trials>=400 & trials<800)%>%mutate(cumDens=cumsum(sample),
                                                                     Risk=case_when(
                                                                       (out<0)~"Loss",
                                                                       (out>=0)~"Win"
                                                                     )
Simon Ciranka's avatar
Simon Ciranka committed
413
414
415
)%>%group_by(Risk)%>%summarise(howMany=n()/144,
                               howMuch=sum(out))->Adolescents

Ciranka's avatar
Ciranka committed
416
417
418
419
420
Plot_dat%>%group_by(x,y)%>%filter(trials>800 & trials<2400)%>%mutate(cumDens=cumsum(sample),
                                                                     Risk=case_when(
                                                                       (out<0)~"Loss",
                                                                       (out>=0)~"Win"
                                                                     )
Simon Ciranka's avatar
Simon Ciranka committed
421
422
423
424
425
426
427
428
)%>%group_by(Risk)%>%summarise(howMany=n()/144,
                               howMuch=sum(out)
)->YoungAdults

Adolescents$Stage="2"
Kids$Stage="1"
YoungAdults$Stage="3"

Ciranka's avatar
Ciranka committed
429
430
431
432
Adolescents$Soc="0"
Kids$Soc="0"
YoungAdults$Soc="0"

Simon Ciranka's avatar
Simon Ciranka committed
433
434
Plot_labels=c("Kids","Adolescents","Adults")

Ciranka's avatar
Ciranka committed
435
rbind(Kids,Adolescents,YoungAdults)->AllIndi
Simon Ciranka's avatar
Simon Ciranka committed
436

Ciranka's avatar
Ciranka committed
437
438
439
```

```{r}
Simon Ciranka's avatar
Simon Ciranka committed
440
441
#first show distribution of risky decisions as kid
ggplot(Kids,aes(x=Risk,y=howMany,fill=Risk))+
Ciranka's avatar
Ciranka committed
442
  stat_summary(geom="bar",color="black",size=1,width=0.9)+
Simon Ciranka's avatar
Simon Ciranka committed
443
444
  coord_cartesian(ylim=c(0,700))+
  scale_y_continuous(name="#")+
Ciranka's avatar
Ciranka committed
445
  ggtitle("outcomes children\nsolo")+
Simon Ciranka's avatar
Simon Ciranka committed
446
447
448
449
450
  guides(fill=F)+
  theme_minimal(8)->One

#then show distribution of risky decisions as adolescent
ggplot(Adolescents,aes(x=Risk,y=howMany,fill=Risk))+
Ciranka's avatar
Ciranka committed
451
  stat_summary(geom="bar",color="black",size=1,width=0.9)+
Simon Ciranka's avatar
Simon Ciranka committed
452
453
  coord_cartesian(ylim=c(0,700))+
  scale_y_continuous(name="")+
Ciranka's avatar
Ciranka committed
454
  ggtitle("outcomes adolescents\nsolo")+
Simon Ciranka's avatar
Simon Ciranka committed
455
456
457
458
459
  guides(fill=F)+
  theme_minimal(8)->Two

#then Adults distribution of risky decisions as adolescent
ggplot(YoungAdults,aes(x=Risk,y=howMany,fill=Risk))+
Ciranka's avatar
Ciranka committed
460
  stat_summary(geom="bar",color="black",size=1,width=0.9)+
Simon Ciranka's avatar
Simon Ciranka committed
461
462
463
  coord_cartesian(ylim=c(0,700))+
  scale_y_continuous(name="")+
  guides(fill=F)+
Ciranka's avatar
Ciranka committed
464
  ggtitle("outcomes adults\nsolo")+
Simon Ciranka's avatar
Simon Ciranka committed
465
466
467
  theme_minimal(8)->Three

#Now, look at the outcome
Ciranka's avatar
Ciranka committed
468
469
ggplot(AllIndi[AllIndi$Risk=="Loss",],aes(x=Stage,y=howMuch,fill=Stage))+
  stat_summary(geom="bar",color="black",size=1,width=0.9)+
Simon Ciranka's avatar
Simon Ciranka committed
470
471
  scale_y_continuous(name="Cumulative Loss")+
  scale_x_discrete("Developmental Stage",breaks=c("1","2","3"),labels=Plot_labels)+
Ciranka's avatar
Ciranka committed
472
  ggtitle("Severety of bad\noutcomes")+
Simon Ciranka's avatar
Simon Ciranka committed
473
  scale_fill_brewer(palette = "Set2")+
Ciranka's avatar
Ciranka committed
474
  coord_cartesian(ylim=c(-2000000,0))+
Simon Ciranka's avatar
Simon Ciranka committed
475
476
477
  guides(fill=F)+
  theme_minimal(8)->Four

Ciranka's avatar
Ciranka committed
478
479
cowplot::plot_grid(One,Two,Three,NULL,Four,ncol=5,rel_widths = c(1,1,1,0.3,1))->Solo
ggsave(plot = Solo,"../X_Figures/EmergentBehavior_summary.png",width = 10,height = 4)
Simon Ciranka's avatar
Simon Ciranka committed
480
481
482
```

# Number of explorative decisions
Ciranka's avatar
Ciranka committed
483

Simon Ciranka's avatar
Simon Ciranka committed
484
Not only the outcomes are interesting but also how much exploraiton happens. 
Ciranka's avatar
Ciranka committed
485
486
So i now declare an explorative decision as switching a bandit. This is done by observing whether sampling of one xy pair changes from 0 to 1. 

Simon Ciranka's avatar
Simon Ciranka committed
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
```{r}
#this is why i love dplyr!
#create count for each new decision.
Plot_dat%>%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
newExp$newExplore=0
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)#
  #  newExp[newExp$trials==i,]$generalExplore=xor(newExp[newExp$trials==i,]$sample,newExp[newExp$trials==i-1,]$sample)
}

saveRDS(newExp,"Derivatives_TrialWise.rds")
# to compute the derivative
503
504
#newExp<-readRDS("Derivatives_TrialWise.rds")

Simon Ciranka's avatar
Simon Ciranka committed
505
506
```

Ciranka's avatar
Ciranka committed
507
508
509
510
# Plot

I then compute the cumulative sum of this count and subtract the cumulative count from 50 trials earlier from it, which gives me a "slope" of new explorative decisions. But i also contrast this to the raw cumulative count, in order for us to inspect how these values correspond.

Simon Ciranka's avatar
Simon Ciranka committed
511
512
513
514
515
516
517
518
```{r}
newExp%>%ungroup()%>%
  mutate(newCum=cumsum(newExplore))%>%
  group_by(trials)%>%
  summarise(explore=max(newCum))%>%mutate(
    explore2=explore-lag(explore,50)
  )%>%mutate(
    Stage=case_when(
Ciranka's avatar
Ciranka committed
519
520
521
      (trials<401)~"Kids",
      (trials>400&trials<800)~"Adolescents",
      (trials>800)~"Adults"
Simon Ciranka's avatar
Simon Ciranka committed
522
    )
Ciranka's avatar
Ciranka committed
523
  )%>%filter(!is.na(Stage) & trials %in% round(seq(50,1200,length.out = 24)))%>%
Simon Ciranka's avatar
Simon Ciranka committed
524
  ggplot(aes(x=trials,y=explore2))+
Ciranka's avatar
Ciranka committed
525
526
  #geom_smooth(aes(linetype=Stage),color="black",method="loess")+
  geom_line()+
Simon Ciranka's avatar
Simon Ciranka committed
527
  # geom_point(size=2)+
Ciranka's avatar
Ciranka committed
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
  #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=2)+
  scale_shape_manual(name="Developmental Stage",values=c(0,1,2))+
  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=100,label=c("Childhood"))+
  annotate("text",x=600,y=100,label=c("Adolescence"))+
  annotate("text",x=950,y=100,label=c("Adulthood"))+
  #scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
  coord_cartesian(ylim=c(0,130))+
Simon Ciranka's avatar
Simon Ciranka committed
543
  scale_y_continuous(name="Explorative Decisions")+
Ciranka's avatar
Ciranka committed
544
545
546
  scale_x_continuous(name="iteration")+
  ggtitle("Exploration -> Solo")+
  guides(linetype=F)+
Simon Ciranka's avatar
Simon Ciranka committed
547
  theme_cowplot()
548

Ciranka's avatar
Ciranka committed
549
550
551
ggsave("../X_Figures/TimecourseExplore.png",width=7,height=4)
```
# Area under the curve
Simon Ciranka's avatar
Simon Ciranka committed
552

Ciranka's avatar
Ciranka committed
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
```{r}
newExp%>%ungroup()%>%
  mutate(newCum=cumsum(newExplore))%>%
  group_by(trials)%>%
  summarise(explore=max(newCum))%>%mutate(
    explore2=explore-lag(explore,50)
  )%>%mutate(
    Stage=case_when(
      (trials<401)~"1",
      (trials>400&trials<800)~"2",
      (trials>800)~"3"
    )
  )%>%filter(!is.na(Stage) & trials %in% round(seq(50,1200,length.out = 24)))%>%group_by(Stage)%>%
  summarize(AUC=trapz(trials,explore2))->AUCSolo

# set limits so i can compare the AUC of solo/social later.
ylim=max(AUCSolo$AUC)+50
Simon Ciranka's avatar
Simon Ciranka committed
570

Ciranka's avatar
Ciranka committed
571
572
573
574
575
576
577
578
579
580
581
  AUCSolo%>%ggplot(aes(x=Stage,y=AUC))+geom_bar(stat="identity",color="black",size=1,width = 0.8,alpha=0.5)+
  scale_x_discrete(name="Developmental Stage",breaks=c(1,2,3),labels=c("Kids","Adolescents","Adults"))+
  ggtitle("Exploration (AUC) - Solo")+
  scale_y_continuous(name=c("AUC Explore"),limits=c(0,ylim))+
  theme_cowplot()->AUCSolo

print(AUCSolo)
```

# Other ways to visualize it.
```{r}
Simon Ciranka's avatar
Simon Ciranka committed
582
583
584
585
586
587
588
newExp%>%ungroup()%>%
  mutate(newCum=cumsum(newExplore))%>%
  group_by(trials)%>%
  summarise(explore=max(newCum))%>%mutate(
    explore2=explore-lag(explore,50)
  )%>%mutate(
    Stage=case_when(
Ciranka's avatar
Ciranka committed
589
590
591
      (trials<401)~"Kids",
      (trials>400&trials<800)~"Adolescents",
      (trials>800)~"Adults"
Simon Ciranka's avatar
Simon Ciranka committed
592
    )
Ciranka's avatar
Ciranka committed
593
  )%>%filter(trials<1200 & trials>50)%>%
Simon Ciranka's avatar
Simon Ciranka committed
594
  ggplot(aes(x=trials,y=explore2))+
Ciranka's avatar
Ciranka committed
595
596
597
598
599
600
601
  # geom_point(size=2)+
  geom_rect(aes(xmin=0,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_line(size=2)+
  #geom_path()+
  geom_vline(xintercept = 400, linetype="dotted",size=2)+
Simon Ciranka's avatar
Simon Ciranka committed
602
603
604
605
  geom_vline(xintercept = 800, linetype="dotted",size=2)+
  scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
  scale_y_continuous(name="Explorative Decisions")+
  scale_x_continuous(name="trials")+
Ciranka's avatar
Ciranka committed
606
  #transition_time(trials)+
Simon Ciranka's avatar
Simon Ciranka committed
607
608
609
610
611
612
613
614
615
616
617
618
  ggtitle("Exploration - Raw")+
  theme_cowplot()
ggsave("../X_Figures/TimecourseExplore_Raw.png")


newExp%>%ungroup()%>%
  mutate(newCum=cumsum(newExplore))%>%
  group_by(trials)%>%
  summarise(explore=max(newCum))%>%mutate(
    explore2=explore-lag(explore)
  )%>%mutate(
    Stage=case_when(
Ciranka's avatar
Ciranka committed
619
620
621
      (trials<401)~"Kids",
      (trials>400&trials<800)~"Adolescents",
      (trials>800)~"Adults"
Simon Ciranka's avatar
Simon Ciranka committed
622
    )
Ciranka's avatar
Ciranka committed
623
  )%>%filter(trials<1200)%>%
Simon Ciranka's avatar
Simon Ciranka committed
624
625
  ggplot(aes(x=trials,y=explore))+
  # geom_point(size=2)+
Ciranka's avatar
Ciranka committed
626
627
628
  geom_rect(aes(xmin=0,xmax=400,ymin=-5,ymax=300,fill="1"),alpha=0.1)+
  geom_rect(aes(xmin=400,xmax=800,ymin=-5,ymax=300,fill="2"),alpha=0.1)+
  geom_rect(aes(xmin=801,xmax=1200,ymin=-5,ymax=300,fill="3"),alpha=0.1)+
Simon Ciranka's avatar
Simon Ciranka committed
629
  geom_spline(size=2)+
Ciranka's avatar
Ciranka committed
630
  geom_vline(xintercept = 400, linetype="dotted",size=2)+
Simon Ciranka's avatar
Simon Ciranka committed
631
632
633
634
635
636
637
638
639
640
641
642
  geom_vline(xintercept = 800, linetype="dotted",size=2)+
  scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
  scale_y_continuous(name="Explorative Decision")+
  scale_x_continuous(name="trials")+
  ggtitle("Exploration - Cumulative")+
  theme_cowplot()

ggsave("../X_Figures/TimecourseExplore_Cumulative.png")

```


Ciranka's avatar
Ciranka committed
643
644
645
# Social
One particular feature about adolescents is that they are sensitive to social information. In order to invesitage how such a sensitivity impacts 1) exploration behavior and 2) encountered outcomes.
For this i let _n_ agents perform the task in parallel and introduce a bonus to the choice utilites that depends on how many others have visited this option in the previous trial.
Simon Ciranka's avatar
Simon Ciranka committed
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676

```{r setupsims}
# get sd of whole environemt for normalizing model input
set.seed(as.numeric(Sys.time()))

###
###
###
###
### PARAMETERS
###
###
###
#get lambda
#get beta
beta<-0# this scales risk attitude.
#get tau
tau<-0.8
mu0<-100#exploration bonus
var0<-5
#create a parameter vector
parVec <- c(lambda, lambda, 1, .0001) 
#loop through trials
out=NULL
AllChoices_social=NULL
dummy=NULL
overallCnt=1
dat_social=expand.grid(x1=1:12,x2=1:12)
dat_social$others=0#to get the right indices
otherLoc=dat_social$others# location of others in last turn i need it to pass it to the social updating function to avoid social info to have a cumulative effect relative to trials.

Ciranka's avatar
Ciranka committed
677
678
HowManyOthers=18
diminishingSocial=0.77
Simon Ciranka's avatar
Simon Ciranka committed
679
680
681
682
683
684
# info about the agents
others <- vector(mode = "list", length = HowManyOthers)# environment for everybody_needed for learning
X_oth<- vector(mode = "list",length = HowManyOthers)#new sample
y_oth<- vector(length = HowManyOthers)#new outcome


Ciranka's avatar
Ciranka committed
685
686
687
688
689
```

# Social function
This here is a function that returns the location of other kalman agent in the space. 
You can modify the agents risk attitudes by changing the prior mu0 in the beginning.
Simon Ciranka's avatar
Simon Ciranka committed
690

Ciranka's avatar
Ciranka committed
691
```{r}
Simon Ciranka's avatar
Simon Ciranka committed
692
693
694
695
696
697
698
699
###
###
### This here is a function that returns the location of other kalman agent in the space. 
### You can modify their risk attitudes by changing the prior mu0 in the beginning.
###
WhereIsEverybody<-function(HowManyOthers,others,otherLoc,dat_social,X_oth,y_oth){
  mu0=100
  if (HowManyOthers==1){
Ciranka's avatar
Ciranka committed
700
    return(list(Others=dat_social$others,LastSamples=X_oth,LastReturn=y_oth,OthersUtil=others))
Simon Ciranka's avatar
Simon Ciranka committed
701
702
703
704
705
706
707
708
709
710
  }
  else{
    ####
    ####Update_socialing process for each individual
    ####
    
    if (nround==1 & overallCnt==1){
      sampleVec=as.numeric(rownames(dat_social[dat_social$x1>=lowestx & dat_social$x1<=highestx  & dat_social$x2<7,]))# here you define where a child should sample from
      ind<-sample(sampleVec,1)
      X_oth[[HowManyOthers]]<-as.matrix(dat_social[ind,1:2])# generate a new vector of Xs
Ciranka's avatar
Ciranka committed
711
      y_oth[HowManyOthers]<-as.matrix(rnorm(1,mean = EnvirionemntAdol[ind,]$Mean,sd=EnvirionemntAdol[ind,]$Variance))
Simon Ciranka's avatar
Simon Ciranka committed
712
713
714
715
    }else if(overallCnt==1) {
      ind<-sample(1:144,1)
      print("Youre an adolescent now")
      X_oth[[HowManyOthers]]<-as.matrix(dat_social[ind,1:2])# generate a new vector of Xs
Ciranka's avatar
Ciranka committed
716
      y_oth[HowManyOthers]<-as.matrix(rnorm(1,mean = EnvirionemntAdol[ind,]$Mean,sd=EnvirionemntAdol[ind,]$Variance))
Simon Ciranka's avatar
Simon Ciranka committed
717
718
719
720
    }
    if (overallCnt>1){
      others[[HowManyOthers]]<-bayesianMeanTracker(X_oth[[HowManyOthers]],y_oth[HowManyOthers], theta=lambda, prevPost=others[[HowManyOthers]],mu0Par=mu0,var0Par = var0)
    }else{
Ciranka's avatar
Ciranka committed
721
      others[[HowManyOthers]]<-bayesianMeanTracker(X_oth[[HowManyOthers]],y_oth[HowManyOthers],theta=lambda, prevPost=NULL,mu0Par=mu0,var0Par=var0)
Simon Ciranka's avatar
Simon Ciranka committed
722
723
724
    }     
    utilityVec<-ucb(others[[HowManyOthers]],beta)
    #browser()
Simon Ciranka's avatar
Simon Ciranka committed
725
726
727
728
729
    if(nround==1){
      # no social impact in "kids environment"
      utilityVec=utilityVec#+otherLoc
    } else{
      #social impact follows a power law starting in adolescnece. 
Ciranka's avatar
Ciranka committed
730
      # browser()
Simon Ciranka's avatar
Simon Ciranka committed
731
732
      utilityVec=utilityVec+otherLoc^diminishingSocial
    }
Simon Ciranka's avatar
Simon Ciranka committed
733
    utilities <- utilityVec - max(utilityVec)
Ciranka's avatar
Ciranka committed
734
    # utilities=utilities
Simon Ciranka's avatar
Simon Ciranka committed
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
    #softmaximization
    p <- exp(utilities/tau)
    #probabilities
    p <- p/colSums(p)
    #numerical overflow
    p <- (pmax(p, 0.00001))
    p <- (pmin(p, 0.99999))
    #index is sampled proprotionally to softmaxed utitily vector
    if (nround==1){# subset the probability vector so that it corresponds to the right tiles.
      ind<-sample(sampleVec,1,prob=p[dat_social$x1>=lowestx & dat_social$x1<=highestx & dat_social$x2<7,])# sample from a childhood environemnt
      #this monster just scales exploration boni
    }else {
      ind<-sample(1:144, 1, prob=p)# sample from an adolescent environemnt
      # print(ind)
    }
    X_oth[[HowManyOthers]]<-as.matrix(dat_social[ind,1:2])
    #bind y-observations
Ciranka's avatar
Ciranka committed
752
    y_oth[HowManyOthers]<-as.matrix(rnorm(n=1,mean = EnvirionemntAdol[ind,]$Mean,sd=EnvirionemntAdol[ind,]$Variance))# change this into a sample.
Simon Ciranka's avatar
Simon Ciranka committed
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
    dat_social[ind,]$others=dat_social[ind,]$others+1
    
    ####
    ####Now, let the others play
    ####
    WhereIsEverybody(HowManyOthers-1,others,otherLoc,dat_social,X_oth,y_oth)# recursion
  }
}

```



```{r}
#otherLoc=0
overallCnt=1
AllOthers=NULL
for (nround in 1:3){
  #get parameters for participant on that round
  if (nround==1){
    # define vectors that are used by the kalman filter
    lowestx=4
    highestx=9
    sampleVec=as.numeric(rownames(dat_social[dat_social$x1>=lowestx & dat_social$x1<=highestx  & dat_social$x2<7,]))# here you define where a child should sample from
    ind<-sample(sampleVec,1)
Ciranka's avatar
Ciranka committed
778
    nTrials=400
Simon Ciranka's avatar
Simon Ciranka committed
779
780
  }else {
    ind<-sample(1:144,1)
Ciranka's avatar
Ciranka committed
781
    nTrials=400
Simon Ciranka's avatar
Simon Ciranka committed
782
783
784
785
786
  }
  #random initialization as observation t=0
  #y matrix
  if (nround==1 & overallCnt==1){
    X<-as.matrix(dat_social[ind,1:2])# generate a new vector of Xs
Ciranka's avatar
Ciranka committed
787
    y<-as.matrix(rnorm(1,mean = EnvirionemntAdol[ind,]$Mean,sd=EnvirionemntAdol[ind,]$Variance))
Simon Ciranka's avatar
Simon Ciranka committed
788
789
790
  }else if(overallCnt==1) {
    print("Youre an adolescent now")
    X<-as.matrix(dat_social[ind,1:2])# generate a new vector of Xs
Ciranka's avatar
Ciranka committed
791
    y<-as.matrix(rnorm(1,mean = EnvirionemntAdol[ind,]$Mean,sd=EnvirionemntAdol[ind,]$Variance))
Simon Ciranka's avatar
Simon Ciranka committed
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
  }
  #X-start, i.e. all possible observations
  Xstar<-as.matrix(dat_social[,1:2])
  
  for (trial in 1:nTrials){
    #dat_social$others=0
    #output by GP with particular parameter settings
    #don't forget mean centering and standardization.... mean is already 0 :)
    if (overallCnt>1){
      out<-bayesianMeanTracker(X[overallCnt,1:2],y[overallCnt], theta=lambda, prevPost=out,mu0Par=mu0,var0Par = var0)
    }else{
      out<-bayesianMeanTracker(X[overallCnt,1:2],y[overallCnt],theta=lambda, prevPost=NULL,mu0Par=mu0,var0Par=var0)
    }
    #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....
    ####
    ####
Ciranka's avatar
Ciranka committed
810
811
812
813
814
815
816
    Out_Others=WhereIsEverybody(HowManyOthers,others,otherLoc,dat_social,X_oth,y_oth)
    otherLoc=Out_Others$Others
    X_oth=Out_Others$LastSamples
    y_oth=Out_Others$LastReturn
    others=Out_Others$OthersUtil
    
    #add social info
Simon Ciranka's avatar
Simon Ciranka committed
817
818
819
820
821
    #browser()
    ####
    ####
    #print(otherLoc)
    utilityVec<-ucb(out,beta)
Simon Ciranka's avatar
Simon Ciranka committed
822
823
824
825
826
827
828
829
    if(nround==1){
      # no social impact in "kids environment"
      utilityVec=utilityVec#+otherLoc
    } else{
      #social impact follows a power law starting in adolescnece. 
      utilityVec=utilityVec+otherLoc^diminishingSocial
    }
    #utilityVec=utilityVec+otherLoc^diminishingSocial#add social info
Simon Ciranka's avatar
Simon Ciranka committed
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
    utilities <- utilityVec - max(utilityVec)
    #softmaximization
    p <- exp(utilities/tau)
    #probabilities
    p <- p/colSums(p)
    #numerical overflow
    p <- (pmax(p, 0.00001))
    p <- (pmin(p, 0.99999))
    #index is sampled proprotionally to softmaxed utitily vector
    if (nround==1){# subset the probability vector so that it corresponds to the right tiles.
      ind<-sample(sampleVec,1,prob=p[dat_social$x1>=lowestx & dat_social$x1<=highestx & dat_social$x2<7,])# sample from a childhood environemnt
      #this monster just scales exploration boni
    }else {
      ind<-sample(1:144, 1, prob=p)# sample from an adolescent environemnt
      # print(ind)
    }
    X<-rbind(X, as.matrix(dat_social[ind,1:2]))
    #bind y-observations
Ciranka's avatar
Ciranka committed
848
    y<-rbind(y, as.matrix(rnorm(n=1,mean = EnvirionemntAdol[ind,]$Mean,sd=EnvirionemntAdol[ind,]$Variance)))# change this into a sample.
Simon Ciranka's avatar
Simon Ciranka committed
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
    #if(y[overallCnt]<0){
    #  y[overallCnt]=-1*y[overallCnt]^2# make losses more severe. 
    #}
    AllOthers=rbind(AllOthers,data.frame(Loc=otherLoc,trial=overallCnt))
    dummy<-data.frame(trial=overallCnt, x=as.numeric(X[overallCnt,1]), y=as.numeric(X[overallCnt,2]),
                      z=as.numeric(y[overallCnt]),round=nround)
    
    AllChoices_social<-rbind(AllChoices_social,dummy)
    overallCnt=overallCnt+1
  }
  #dummy data frame
}
#}
#This Here is for Plotting
Plot_dat_social=expand.grid(x=1:12,y=1:12,trials=0:max(dummy$trial))
Plot_dat_social$sample=0
Plot_dat_social$out=0


for (i in 1:length(AllChoices_social$x)){
  AllChoices_social$y[i]
  AllChoices_social$x[i]
  Plot_dat_social[Plot_dat_social$x==AllChoices_social$x[i] & Plot_dat_social$y==AllChoices_social$y[i] & Plot_dat_social$trials==AllChoices_social$trial[i],]$sample=1
  Plot_dat_social[Plot_dat_social$trials==AllChoices_social$trial[i],]$out=AllChoices_social$z[i]
}

Ciranka's avatar
Ciranka committed
875
876
877
878
879
880
881
## here add the tally of "others".
Plot_dat_social$Others=0
for(k in unique(Plot_dat_social$trials)){
  if (k>0){
    Plot_dat_social[Plot_dat_social$trials==k,]$Others=AllOthers[AllOthers$trial==k,]$Loc
  }
}
Simon Ciranka's avatar
Simon Ciranka committed
882
883


Ciranka's avatar
Ciranka committed
884
```
Simon Ciranka's avatar
Simon Ciranka committed
885
886


Ciranka's avatar
Ciranka committed
887
# Animate
Simon Ciranka's avatar
Simon Ciranka committed
888

Ciranka's avatar
Ciranka committed
889
This image is analogous to the above.
Simon Ciranka's avatar
Simon Ciranka committed
890
891
892
893
894
895
896
897
898
899

```{r}
library(gganimate)# you can plot the trajectory with gganimate. 
Plot_dat_social%>%group_by(x,y)%>%mutate(cumDens=cumsum(sample))%>%
  ggplot(aes(x=x,y=y,fill=cumDens))+
  geom_tile()+
  scale_fill_viridis_c(option="inferno")+
  scale_y_continuous(name="Variance in Outcomes",breaks=c(0,2.5,5.0,7.5,10.0,12.5),labels=seq(1,80,length.out=6))+
  scale_x_continuous(name="Mean Outcome",breaks=c(0,2.5,5.0,7.5,10.0,12.5),labels=seq(-100,100,length.out=6))+
  ggtitle("Sampling Density Social {frame_time}")+
Ciranka's avatar
Ciranka committed
900
901
  transition_time(trials)+theme_cowplot()->animInd#plot(anim)
animate(animInd)
Simon Ciranka's avatar
Simon Ciranka committed
902
903
```

Ciranka's avatar
Ciranka committed
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
# Where are the others in that space

Now i show you the same stuff in the figure but in this image, brighter colors signal that more agents visited this patch on a given trial, as opposed to darker colors.

```{r}
Plot_dat_social%>%group_by(x,y)%>%mutate(cumDens=cumsum(sample))%>%
  ggplot(aes(x=x,y=y,fill=Others))+
  geom_tile()+
  scale_fill_distiller(palette = "RdPu")+
  scale_y_continuous(name="Variance in Outcomes",breaks=c(0,2.5,5.0,7.5,10.0,12.5),labels=seq(1,80,length.out=6))+
  scale_x_continuous(name="Mean Outcome",breaks=c(0,2.5,5.0,7.5,10.0,12.5),labels=seq(-100,100,length.out=6))+
  ggtitle("Everybody Else {frame_time}")+
  transition_time(trials)+theme_cowplot()->animSoc#plot(anim)
animate(animSoc)

anim_save(animation = animate(animSoc), filename ="../X_Figures/Sampling_TimecourseSoc_Oth.gif")
anim_save(animation = animate(animInd), filename ="../X_Figures/Sampling_TimecourseSoc_Ind.gif")

#cowplot::plot_grid(animInd,animSoc)
```
Simon Ciranka's avatar
Simon Ciranka committed
924
925
926
927



# Now lets contrast the relative & the total number of risky decisions.
Ciranka's avatar
Ciranka committed
928
929
This plot shows the same as above. Counts of Wins and Losses and Severity in Losses.
Generally having others in this patch seems to help making better decisions, also during adolescence!
Simon Ciranka's avatar
Simon Ciranka committed
930
931

```{r fig.width=10}
Ciranka's avatar
Ciranka committed
932
933
Plot_dat_social[length(Plot_dat_social$x),]$out=-0.1# dummy to make the x axis for the adult plot right
Plot_dat_social%>%group_by(x,y)%>%filter(trials<=400)%>%mutate(cumDens=cumsum(sample),
Simon Ciranka's avatar
Simon Ciranka committed
934
935
936
937
                                                               Risk=case_when(
                                                                 (out<0)~"Loss",
                                                                 (out>=0)~"Win"
                                                               )
Simon Ciranka's avatar
Simon Ciranka committed
938
939
940
)%>%group_by(Risk)%>%summarise(howMany=n()/144,
                               howMuch=sum(out))->Kids

Ciranka's avatar
Ciranka committed
941
942
943
944
945
Plot_dat_social%>%group_by(x,y)%>%filter(trials>=400 & trials<800)%>%mutate(cumDens=cumsum(sample),
                                                                            Risk=case_when(
                                                                              (out<0)~"Loss",
                                                                              (out>=0)~"Win"
                                                                            )
Simon Ciranka's avatar
Simon Ciranka committed
946
947
948
)%>%group_by(Risk)%>%summarise(howMany=n()/144,
                               howMuch=sum(out))->Adolescents

Ciranka's avatar
Ciranka committed
949
950
951
952
953
Plot_dat_social%>%group_by(x,y)%>%filter(trials>800 & trials<1200)%>%mutate(cumDens=cumsum(sample),
                                                                            Risk=case_when(
                                                                              (out<0)~"Loss",
                                                                              (out>=0)~"Win"
                                                                            )
Simon Ciranka's avatar
Simon Ciranka committed
954
955
956
957
958
959
960
961
)%>%group_by(Risk)%>%summarise(howMany=n()/144,
                               howMuch=sum(out)
)->YoungAdults

Adolescents$Stage="2"
Kids$Stage="1"
YoungAdults$Stage="3"

Ciranka's avatar
Ciranka committed
962
963
964
965
Adolescents$Soc="1"
Kids$Soc="1"
YoungAdults$Soc="1"

Simon Ciranka's avatar
Simon Ciranka committed
966
967
Plot_labels=c("Kids","Adolescents","Adults")

Ciranka's avatar
Ciranka committed
968
969
970
971
rbind(Kids,Adolescents,YoungAdults)->AllSoc
```

```{r}
Simon Ciranka's avatar
Simon Ciranka committed
972
973
974

#first show distribution of risky decisions as kid
ggplot(Kids,aes(x=Risk,y=howMany,fill=Risk))+
Ciranka's avatar
Ciranka committed
975
  stat_summary(geom="bar",color="black",size=1,width=0.9)+
Simon Ciranka's avatar
Simon Ciranka committed
976
977
  coord_cartesian(ylim=c(0,700))+
  scale_y_continuous(name="#")+
Ciranka's avatar
Ciranka committed
978
  ggtitle("outcomes children\nsocial")+
Simon Ciranka's avatar
Simon Ciranka committed
979
980
981
982
983
  guides(fill=F)+
  theme_minimal(8)->One

#then show distribution of risky decisions as adolescent
ggplot(Adolescents,aes(x=Risk,y=howMany,fill=Risk))+
Ciranka's avatar
Ciranka committed
984
  stat_summary(geom="bar",color="black",size=1,width=0.9)+
Simon Ciranka's avatar
Simon Ciranka committed
985
986
  coord_cartesian(ylim=c(0,700))+
  scale_y_continuous(name="")+
Ciranka's avatar
Ciranka committed
987
  ggtitle("outcomes adolescence\nsocial")+
Simon Ciranka's avatar
Simon Ciranka committed
988
989
990
991
992
  guides(fill=F)+
  theme_minimal(8)->Two

#then Adults distribution of risky decisions as adolescent
ggplot(YoungAdults,aes(x=Risk,y=howMany,fill=Risk))+
Ciranka's avatar
Ciranka committed
993
  stat_summary(geom="bar",color="black",size=1,width=0.9)+
Simon Ciranka's avatar
Simon Ciranka committed
994
995
996
  coord_cartesian(ylim=c(0,700))+
  scale_y_continuous(name="")+
  guides(fill=F)+
Ciranka's avatar
Ciranka committed
997
  ggtitle("outcomes adults\nsocial")+
Simon Ciranka's avatar
Simon Ciranka committed
998
999
1000
  theme_minimal(8)->Three

#Now, look at the outcome
Ciranka's avatar
Ciranka committed
1001
ggplot(AllSoc[AllSoc$Risk=="Loss",],aes(x=Stage,y=howMuch,fill=Stage))+
Simon Ciranka's avatar
Simon Ciranka committed
1002
1003
1004
  stat_summary(geom="bar",color="black")+
  scale_y_continuous(name="Cumulative Loss")+
  scale_x_discrete("Developmental Stage",breaks=c("1","2","3"),labels=Plot_labels)+
Ciranka's avatar
Ciranka committed
1005
1006
1007
  ggtitle("Severety of bad\noutcomes")+
  scale_fill_brewer(palette = "Set2")+ 
  coord_cartesian(ylim=c(-2000000,0))+
Simon Ciranka's avatar
Simon Ciranka committed
1008
1009
1010
  guides(fill=F)+
  theme_minimal(8)->Four

Ciranka's avatar
Ciranka committed
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
cowplot::plot_grid(One,Two,Three,NULL,Four,ncol=5,rel_widths = c(1,1,1,0.3,1))->Social
ggsave(plot = Social,filename="../X_Figures/EmergentBehavior_summary_Social.png",width = 10,height = 4)


```

# joint plot
```{r}
cowplot::plot_grid(Solo,NULL,Social,nrow=3,rel_heights = c(1,0.2,1))->both
ggsave(filename="../X_Figures/Solo_Social_Outcomes.png",plot = both, width = 9, height=6)
```



# Number of explorative decisions
This here is equivalent to the above, but now for social agents. In comparison to solo agents we can see that introducing social information and a social following rule, 

```{r}
#this is why i love dplyr!
#create count for each new decision.
Plot_dat_social%>%group_by(x,y)%>%mutate(cumDens=cumsum(sample))%>%ungroup()%>% group_by(x,y, trials) %>%
  mutate(newC = ifelse(cumDens == 1 & lag(cumDens)==0, 1, 0))->newExpSoc# if i take the derivative of this this might be exaclty what wouter was intersted in.
newExpSoc[is.na(newExpSoc$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
newExpSoc$newExplore=0
newExpSoc$generalExplore=0
for( i in 1:length(unique(newExpSoc$trials))){
  newExpSoc[newExpSoc$trials==i,]$newExplore=xor(newExpSoc[newExpSoc$trials==i,]$newC,newExpSoc[newExpSoc$trials==i-1,]$newC)#
  #  newExp[newExp$trials==i,]$generalExplore=xor(newExp[newExp$trials==i,]$sample,newExp[newExp$trials==i-1,]$sample)
}

saveRDS(newExpSoc,"Derivatives_TrialWise_Social.rds")
# to compute the derivative
```

```{r}
# newExp%>%ungroup()%>%
#   mutate(newCum=cumsum(newExplore))%>%
#   group_by(trials)%>%
#   summarise(explore=max(newCum))%>%mutate(
#     explore2=explore-lag(explore,50)
#   )%>%mutate(
#     Stage=case_when(
#       (trials<401)~"Kids",
#       (trials>400&trials<800)~"Adolescents",
#       (trials>800)~"Adults"
#     )
#   )%>%filter(trials<1200)%>%
#   ggplot(aes(x=trials,y=explore2))+
#   # geom_point(size=2)+
#   geom_rect(aes(xmin=0,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=2,)+
#   geom_vline(xintercept = 400, linetype="dotted",size=2)+
#   geom_vline(xintercept = 800, linetype="dotted",size=2)+
#   scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
#   scale_y_continuous(name="Explorative Decisions")+
#   scale_x_continuous(name="trials")+
#   ggtitle("Exploration - Spline")+
#   theme_cowplot()
# ggsave("../X_Figures/TimecourseExplore_Spline.png")


newExpSoc%>%ungroup()%>%
  mutate(newCum=cumsum(newExplore))%>%
  group_by(trials)%>%
  summarise(explore=max(newCum))%>%mutate(
    explore2=explore-lag(explore,50)
  )%>%mutate(
    Stage=case_when(
      (trials<401)~"Kids",
      (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))+
  geom_line()+
  #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=2)+
  scale_shape_manual(name="Developmental Stage",values=c(0,1,2))+
  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=100,label=c("Childhood"))+
  annotate("text",x=600,y=100,label=c("Adolescence"))+
  annotate("text",x=950,y=100,label=c("Adulthood"))+
  #scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
  coord_cartesian(ylim=c(0,130))+
  scale_y_continuous(name="Explorative Decisions")+
  scale_x_continuous(name="iteration")+
  ggtitle("Exploration -> Social")+
  guides(linetype=F)+
  theme_cowplot()
ggsave("../X_Figures/TimecourseExplore_Raw_Social.png",width = 7,height = 4)

```

#Area under the curve

```{r}
# Area under the curve
newExpSoc%>%ungroup()%>%
  mutate(newCum=cumsum(newExplore))%>%
  group_by(trials)%>%
  summarise(explore=max(newCum))%>%mutate(
    explore2=explore-lag(explore,50)
  )%>%mutate(
    Stage=case_when(
      (trials<401)~"1",
      (trials>400&trials<800)~"2",
      (trials>800)~"3"
    )
  )%>%filter(!is.na(Stage) & trials %in% round(seq(50,1200,length.out = 24)))%>%group_by(Stage)%>%
  summarize(AUC=trapz(trials,explore2))%>%ggplot(aes(x=Stage,y=AUC))+geom_bar(stat="identity",color="black",size=1,width = 0.8,alpha=0.5)+
  scale_x_discrete(name="Developmental Stage",breaks=c(1,2,3),labels=c("Kids","Adolescents","Adults"))+
  ggtitle("Exploration (AUC) - Social")+
  scale_y_continuous(name=c("AUC Explore"),limits=c(0,ylim))+
  theme_cowplot()->AUCSocial
```

#Compare Solo & Social AUCs
```{r}
cowplot::plot_grid(AUCSolo,AUCSocial+theme(axis.text.y=element_text(color="white")))
```

```{r}
newExpSoc%>%ungroup()%>%
  mutate(newCum=cumsum(newExplore))%>%
  group_by(trials)%>%
  summarise(explore=max(newCum))%>%mutate(
    explore2=explore-lag(explore)
  )%>%mutate(
    Stage=case_when(
      (trials<401)~"Kids",
      (trials>400&trials<800)~"Adolescents",
      (trials>800)~"Adults"
    )
  )%>%filter(trials<1200)%>%
  ggplot(aes(x=trials,y=explore))+
  # geom_point(size=2)+
  geom_rect(aes(xmin=0,xmax=400,ymin=-5,ymax=300,fill="1"),alpha=0.1)+
  geom_rect(aes(xmin=400,xmax=800,ymin=-5,ymax=300,fill="2"),alpha=0.1)+
  geom_rect(aes(xmin=801,xmax=1200,ymin=-5,ymax=300,fill="3"),alpha=0.1)+
  geom_spline(size=2)+
  geom_vline(xintercept = 400, linetype="dotted",size=2)+
  geom_vline(xintercept = 800, linetype="dotted",size=2)+
  scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
  scale_y_continuous(name="Explorative Decision")+
  scale_x_continuous(name="trials")+
  ggtitle("Exploration - Cumulative")+
  theme_cowplot()

ggsave("../X_Figures/TimecourseExplore_Cumulative_Social.png")

```



# 4 types of Social decisions.
But The social dimension also allows for examining additional dimensions of behavior.
Specifically a four fold pattern of exploration emerges in respect to social content.

1) Individuals could switch to a patch that is favoured by SI 
2) Individuals could switch to a patch that is _not_ favoured by SI
3) Individuals could stay at a patch that has been favoured by SI 
4) Individuals could stay at a patch that has been _not_ favoured by SI 

## Going Where Others have been before.

```{r}
newExpSoc$GoToOthers=0
newExpSoc$GoToNoone=0
newExpSoc$StayWithOthers=0
newExpSoc$StayWithNoone=0

for( i in 1:length(unique(newExpSoc$trials))){
  #If you explored a new option that was sampled my more than 0 others before.
  newExpSoc[newExpSoc$trials==i,]$GoToOthers=as.numeric(newExpSoc[newExpSoc$trials==i,]$newExplore & (newExpSoc[newExpSoc$trials==i-1,]$Others!=0))#
  
  #If you explored a new option that was sampled my 0 others before.
  newExpSoc[newExpSoc$trials==i,]$GoToNoone=as.numeric(newExpSoc[newExpSoc$trials==i,]$newExplore & (newExpSoc[newExpSoc$trials==i-1,]$Others==0))#
  #  newExp[newExp$trials==i,]$generalExplore=xor(newExp[newExp$trials==i,]$sample,newExp[newExp$trials==i-1,]$sample)
  
  # If you sample an option, where others have been and still are and you dont explore again.
  newExpSoc[newExpSoc$trials==i,]$StayWithOthers=as.numeric(newExpSoc[newExpSoc$trials==i,]$sample & (newExpSoc[newExpSoc$trials==i-1,]$Others!=0) & (newExpSoc[newExpSoc$trials==i,]$Others!=0) & (newExpSoc[newExpSoc$trials==i,]$newExplore==0))#
  
  # If you sample an option, where no others have been and still none are and you dont explore again.
  newExpSoc[newExpSoc$trials==i,]$StayWithNoone=as.numeric(newExpSoc[newExpSoc$trials==i,]$sample & (newExpSoc[newExpSoc$trials==i-1,]$Others==0) & (newExpSoc[newExpSoc$trials==i,]$Others==0) &(newExpSoc[newExpSoc$trials==i,]$newExplore==0))#
}




newExpSoc%>%ungroup()%>%
  mutate(newCum=cumsum(GoToNoone))%>%
  group_by(trials)%>%
  summarise(explore=max(newCum))%>%mutate(
    explore2=explore-lag(explore,100)
  )%>%mutate(
    Stage=case_when(
      (trials<401)~"Kids",
      (trials>400&trials<800)~"Adolescents",
      (trials>800)~"Adults"
    )
  )%>%filter(trials<1200)%>%
  ggplot(aes(x=trials,y=explore2))+
  # geom_point(size=2)+
  geom_rect(aes(xmin=0,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=2)+
  geom_vline(xintercept = 400, linetype="dotted",size=2)+
  geom_vline(xintercept = 800, linetype="dotted",size=2)+
  scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "Reds")+
  scale_y_continuous(name="Explorative Decisions")+
  scale_x_continuous(name="trials")+
  ggtitle("Switch Where Noone Is")+
  theme_cowplot()
ggsave("../X_Figures/TimecourseExplore_Raw_Social.png")





newExpSoc%>%ungroup()%>%
  mutate(newCum=cumsum(GoToOthers))%>%
  group_by(trials)%>%
  summarise(explore=max(newCum))%>%mutate(
    explore2=explore-lag(explore,100)
  )%>%mutate(
    Stage=case_when(
      (trials<401)~"Kids",
      (trials>400&trials<800)~"Adolescents",
      (trials>800)~"Adults"
    )
  )%>%filter(trials<1200)%>%
  ggplot(aes(x=trials,y=explore2))+
  # geom_point(size=2)+
  geom_rect(aes(xmin=0,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=2)+
  geom_vline(xintercept = 400, linetype="dotted",size=2)+
  geom_vline(xintercept = 800, linetype="dotted",size=2)+
  scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "Reds")+
  scale_y_continuous(name="Explorative Decisions")+
  scale_x_continuous(name="trials")+
  ggtitle("Switch to Where Others Are")+
  theme_cowplot()





newExpSoc%>%ungroup()%>%
  mutate(newCum=cumsum(StayWithOthers))%>%
  group_by(trials)%>%
  summarise(explore=max(newCum))%>%mutate(
    explore2=explore-lag(explore,100)
  )%>%mutate(
    Stage=case_when(
      (trials<401)~"Kids",
      (trials>400&trials<800)~"Adolescents",
      (trials>800)~"Adults"
    )
  )%>%filter(trials<1200)%>%
  ggplot(aes(x=trials,y=explore2))+
  # geom_point(size=2)+
  geom_rect(aes(xmin=0,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=2)+
  geom_vline(xintercept = 400, linetype="dotted",size=2)+
  geom_vline(xintercept = 800, linetype="dotted",size=2)+
  scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "Reds")+
  scale_y_continuous(name="Explorative Decisions")+
  scale_x_continuous(name="trials")+
  ggtitle("Stay With Others")+
  theme_cowplot()




newExpSoc%>%ungroup()%>%
  mutate(newCum=cumsum(StayWithNoone))%>%
  group_by(trials)%>%
  summarise(explore=max(newCum))%>%mutate(
    explore2=explore-lag(explore,100)
  )%>%mutate(
    Stage=case_when(
      (trials<401)~"Kids",
      (trials>400&trials<800)~"Adolescents",
      (trials>800)~"Adults"
    )
  )%>%filter(trials<1200)%>%
  ggplot(aes(x=trials,y=explore2))+
  # geom_point(size=2)+
  geom_rect(aes(xmin=0,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=2)+
  geom_vline(xintercept = 400, linetype="dotted",size=2)+
  geom_vline(xintercept = 800, linetype="dotted",size=2)+
  scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "Reds")+
  scale_y_continuous(name="Sum Previous Decisions")+
  scale_x_continuous(name="trials")+
  ggtitle("Stay Alone")+
  theme_cowplot()

```