Adaptive_Adolescence_Multi.Rmd 71.1 KB
Newer Older
Ciranka's avatar
Ciranka committed
1
2
3
4
---
title: "Adaptive_Adolescence_multi"
author: "Simy"
date: "28/08/2020"
5
6
output:
  github_document:
Ciranka's avatar
Ciranka committed
7
    toc: true
8
    toc_depth: 2
Ciranka's avatar
Ciranka committed
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
---

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

pacman::p_load(tidyverse,cowplot,matrixcalc,gganimate,ggformula,pracma)
```

# I do everything exactly the same as before
But I make multiple simulations because there is so much stochastizity in the simluations and we need to get a feeling for the expectation value.

```{r fig.width=12,fig.height=6, include=FALSE}
loadfromdisk=T

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

#define the range of adolescent environment
envirionmentMeanAdol=seq(-100,100,length.out=12)
envirionmentVarianceAdol=seq(1,80,length.out=12)
EnvirionemntAdol=expand.grid(Mean=envirionmentMeanAdol,Variance=envirionmentVarianceAdol)
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")+
  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"))+
42
  ggtitle("Adolescent Environment")+theme_minimal(14)+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())->Adolescent
Ciranka's avatar
Ciranka committed
43
44
45
46
47
48
49
50
51
52
53
54
55


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))+
  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)+
56
  ggtitle("Childhood Environment")+theme_minimal(14)+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())->Kid
Ciranka's avatar
Ciranka committed
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71

```

```{r fig.width=12,fig.height=6}
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))

ggsave(filename = "../X_Figures/Environments.png")
```

# load the kalman filter and the UCB rule
Here i define the kalman filter and the choice rule.
72
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: 
Ciranka's avatar
Ciranka committed
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98

* 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

* 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)
```{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
99
  kGain <- predictions$sig[chosen] / (predictions$sig[chosen] + 3600)# feed the uncertainty in here.
Ciranka's avatar
Ciranka committed
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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
  #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)
}
```

### some values to set.
```{r setupObser}
# get sd of whole environemt for normalizing model input
set.seed(as.numeric(Sys.time()))
cntrl=list(
  #get lambda
  lambda=0.8,
  #get beta
  beta=0,# this scales risk attitude.
  #get tau
  tau=0.8,
  mu0=100,#exploration bonus
146
  var0=40,
Ciranka's avatar
Ciranka committed
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
  #create a parameter vector
  parVec = c(0.8, 0.8, 1, .0001) ,
  #
  ExploreBonus=0,
  #kernel is RBF
  #k<-rbf
  #loop through trials
  out=NULL,
  AllChoices=NULL,
  dummy=NULL,
  overallCnt=1,
  dat=expand.grid(x1=1:12,x2=1:12)
)
##
##
## Here i store the multiple Sims
163
164
ntrialss=100
list_Iter <- vector(mode = "list", length = ntrialss)
Ciranka's avatar
Ciranka committed
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
```

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

#### setup parallel
```{r}
if(loadfromdisk==F){
  library(doParallel)
  #####setup parralel
  cl <- makeCluster(40)
  registerDoParallel(cl)
}

```


```{r}
exploreEnv<-function(explore_func,choiceRule,env2,env1,cntrl,iter){
187
  #for (rep in 1:ntrialss){
Ciranka's avatar
Ciranka committed
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
  #unpack
  lambda=cntrl$lambda
  #get beta
  beta<-cntrl$beta# this scales risk attitude.
  #get tau
  tau<-cntrl$tau
  mu0<-cntrl$mu0#exploration bonus
  var0<-cntrl$var0
  #create a parameter vector
  parVec <- cntrl$parVec
  #
  ExploreBonus=cntrl$ExploreBonus
  #kernel is RBF
  #k<-rbf
  #loop through trials
  out=cntrl$out
  AllChoices=cntrl$AllChoices
  dummy=cntrl$dummy
  overallCnt=cntrl$overallCnt
  dat=cntrl$dat
208
209
  mu=list()
  sig=list()
Ciranka's avatar
Ciranka committed
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
  
  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[dat$x1>=lowestx & dat$x1<=highestx  & dat$x2<7,]))# here you define where a child should sample from
      ind<-sample(sampleVec,1)
      nTrials=400
    }else {
      ind<-sample(1:144,1)
      nTrials=400
    }
    #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
      y<-as.matrix(rnorm(1,mean = EnvirionemntAdol[ind,]$Mean,sd=EnvirionemntAdol[ind,]$Variance))
    }else if(overallCnt==1) {
      print("Youre an adolescent now")
      X<-as.matrix(dat[ind,1:2])# generate a new vector of Xs
      y<-as.matrix(rnorm(1,mean = EnvirionemntAdol[ind,]$Mean,sd=EnvirionemntAdol[ind,]$Variance))
    }
    #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)
      }
245
      #browser()
Ciranka's avatar
Ciranka committed
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
      #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....
      #
      # browser()
      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
      y<-rbind(y, as.matrix(rnorm(n=1,mean = EnvirionemntAdol[ind,]$Mean,sd=EnvirionemntAdol[ind,]$Variance)))# change this into a sample.
      #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)
279
280
      mu[[overallCnt]]<-out$mu
      sig[[overallCnt]]<-out$sig
Ciranka's avatar
Ciranka committed
281
282
283
284
285
286
      overallCnt=overallCnt+1
    }
    #dummy data frame
  }
  #}
  #This Here is for Plotting
287

Ciranka's avatar
Ciranka committed
288
289
290
  Plot_dat=expand.grid(x=1:12,y=1:12,trials=0:max(dummy$trial))
  Plot_dat$sample=0
  Plot_dat$out=0
291
292
  Plot_dat$mu=0
  Plot_dat$sig=40
Ciranka's avatar
Ciranka committed
293
294
295
296
297
298
  
  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]
299
300
    Plot_dat[Plot_dat$trials==AllChoices$trial[i],]$mu=mu[[i]]
    Plot_dat[Plot_dat$trials==AllChoices$trial[i],]$sig=sig[[i]]
Ciranka's avatar
Ciranka committed
301
  }
302
303
   # browser()

Ciranka's avatar
Ciranka committed
304
305
306
307
308
  Plot_dat$iter=iter
  return(Plot_dat)
}

if(loadfromdisk==F){
309
  Plot_datAll<-foreach(iter=1:ntrialss, .combine='rbind') %dopar%{
Ciranka's avatar
Ciranka committed
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
    exploreEnv(explore_func=bayesianMeanTracker,choiceRule=ucb,env2=EnvirionemntAdol,env1=EnvirionemntKids,cntrl=cntrl,iter=iter)
  }
  saveRDS(file="../A_GeneratedFiles/Plot_datAll",object = Plot_datAll)
}else{
  Plot_datAll<-readRDS(file="../A_GeneratedFiles/Plot_datAll")
}
# do it.

```




# Now lets contrast the relative & the total number of risky decisions.
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.

```{r fig.width=10}
Plot_datAll%>%group_by(x,y,iter)%>%filter(trials<=400)%>%mutate(cumDens=cumsum(sample),
                                                                Outcome=case_when(
                                                                  (out<0)~"Loss",
331
                                                                  (out>=0)~"Gain"
Ciranka's avatar
Ciranka committed
332
333
334
335
336
337
338
                                                                )
)%>%group_by(Outcome,iter)%>%summarise(howMany=n()/144,
                                    howMuch=sum(out))->Kids

Plot_datAll%>%group_by(x,y,iter)%>%filter(trials>=400 & trials<800)%>%mutate(cumDens=cumsum(sample),
                                                                             Outcome=case_when(
                                                                               (out<0)~"Loss",
339
                                                                               (out>=0)~"Gain"
Ciranka's avatar
Ciranka committed
340
341
342
343
344
345
346
                                                                             )
)%>%group_by(Outcome,iter)%>%summarise(howMany=n()/144,
                                    howMuch=sum(out))->Adolescents

Plot_datAll%>%group_by(x,y,iter)%>%filter(trials>800 & trials<2400)%>%mutate(cumDens=cumsum(sample),
                                                                             Outcome=case_when(
                                                                               (out<0)~"Loss",
347
                                                                               (out>=0)~"Gain"
Ciranka's avatar
Ciranka committed
348
349
350
351
352
353
354
355
356
357
358
359
360
                                                                             )
)%>%group_by(Outcome,iter)%>%summarise(howMany=n()/144,
                                    howMuch=sum(out)
)->YoungAdults

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

Adolescents$Soc="0"
Kids$Soc="0"
YoungAdults$Soc="0"

361
Plot_labels=c("Children","Adolescents","Adults")
Ciranka's avatar
Ciranka committed
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415

rbind(Kids,Adolescents,YoungAdults)->AllIndi

```

```{r fig.width=11, fig.height=3}

AllIndi%>%ungroup()%>%select(howMany)%>%min()->minScale
AllIndi%>%ungroup()%>%select(howMany)%>%max()->maxScale

#first show distribution of risky decisions as kid
ggplot(Kids,aes(x=Outcome,y=howMany,fill=Outcome))+
  geom_jitter(aes(group=iter,color=Outcome),alpha=0.3)+
  stat_summary(aes(color=Outcome),geom="pointrange",color="black",fun.data = "mean_cl_boot")+
  coord_cartesian(ylim=c(0,400))+
  scale_y_continuous(name="#")+
  ggtitle("outcomes children\nsolo")+
  guides(fill=F)+
  theme_minimal(8)->One

#then show distribution of risky decisions as adolescent
ggplot(Adolescents,aes(x=Outcome,y=howMany,fill=Outcome))+
  geom_jitter(aes(group=iter,color=Outcome),alpha=0.3)+
  stat_summary(aes(color=Outcome),geom="pointrange",color="black",fun.data = "mean_cl_boot")+
  coord_cartesian(ylim=c(0,400))+
  scale_y_continuous(name="")+
  ggtitle("outcomes adolescents\nsolo")+
  guides(fill=F)+
  theme_minimal(8)->Two

#then Adults distribution of risky decisions as adolescent
ggplot(YoungAdults,aes(x=Outcome,y=howMany,fill=Outcome))+
  geom_jitter(aes(group=iter,color=Outcome),alpha=0.3)+
  stat_summary(aes(color=Outcome),geom="pointrange",color="black",fun.data = "mean_cl_boot")+
  scale_y_continuous(name="")+
  coord_cartesian(ylim=c(0,400))+
  guides(fill=F)+
  ggtitle("outcomes adults\nsolo")+
  theme_minimal(8)->Three

#Now, look at the outcome
ggplot(AllIndi[AllIndi$Outcome=="Loss",],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")+
  scale_x_discrete("Developmental Stage",breaks=c("1","2","3"),labels=Plot_labels)+
  ggtitle("Severety of bad\noutcomes")+
  scale_color_brewer(palette = "Set2")+
  coord_cartesian(ylim=c(-2000000,0))+
  guides(fill=F)+
  theme_minimal(8)->Four

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)
416
print(Solo)
Ciranka's avatar
Ciranka committed
417
418
419
420
421
422
423
424
425
426
427
428
```

# Number of explorative decisions

Not only the outcomes are interesting but also how much exploraiton happens. 
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. 

```{r}
#this is why i love dplyr!
#create count for each new decision.

# do it in parralel again
429
compute_sampling_strategy<-function(Plot_datAll,subject){
Ciranka's avatar
Ciranka committed
430
431
  library(dplyr)
  
432
  Plot_datAll%>%filter(iter==subject)%>%group_by(x,y)%>%mutate(cumDens=cumsum(sample))%>%ungroup()%>% group_by(x,y, trials) %>%
Ciranka's avatar
Ciranka committed
433
434
435
436
437
438
439
    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)#
440
    print(i)
Ciranka's avatar
Ciranka committed
441
442
    #  newExp[newExp$trials==i,]$generalExplore=xor(newExp[newExp$trials==i,]$sample,newExp[newExp$trials==i-1,]$sample)
  }
443
  newExp$iter=subject
Ciranka's avatar
Ciranka committed
444
445
446
447
  return(newExp)
}
#saveRDS(newExp,"Derivatives_TrialWise.rds")
if (loadfromdisk==F){
448
449
450
451
452
  #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)
Ciranka's avatar
Ciranka committed
453
  }
454
  saveRDS(file = "../A_GeneratedFiles/solotraj2.rds",object = newExp_all)
Ciranka's avatar
Ciranka committed
455
}else {
456
  newExp_all<-readRDS(file = "../A_GeneratedFiles/solotraj2.rds")
Ciranka's avatar
Ciranka committed
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
}

# to compute the derivative

```

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.

```{r}
newExp_all%>%group_by(iter)%>%
  mutate(newCum=cumsum(newExplore))%>%
  ungroup()%>%group_by(trials,iter)%>%
  summarise(explore=max(newCum))%>%
  ungroup()%>%
  arrange(iter)%>%
  #ungroup()%>%#### looks about right but doublecheck.
  mutate(
    explore2=explore-lag(explore,50)
  )%>%mutate(
    Stage=case_when(
477
      (trials<401)~"Children",
Ciranka's avatar
Ciranka committed
478
479
      (trials>400&trials<800)~"Adolescents",
      (trials>800)~"Adults"
480
481
482
483
    ),
    Which="Solo"
  )%>%#filter(trials>36 & (trials <401 | trials >508))%>%
  filter(!is.na(Stage) & trials %in% round(seq(50,1200,length.out = 24)))%>%
Ciranka's avatar
Ciranka committed
484
485
486
  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")+
487
 # geom_jitter()+
Ciranka's avatar
Ciranka committed
488
489
490
  #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)+
491
  geom_spline(size=1)+
Ciranka's avatar
Ciranka committed
492
493
  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")+
494
  scale_shape_manual(name="Developmental\nStage",values=c(22,21,24))+
Ciranka's avatar
Ciranka committed
495
496
497
498
  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")+
499
500
501
  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"))+
Ciranka's avatar
Ciranka committed
502
503
  #scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
  #coord_cartesian(ylim=c(0,))+
504
505
  scale_y_continuous(name="Exploration decisions")+
  scale_x_continuous(name="trials")+
Ciranka's avatar
Ciranka committed
506
  guides(linetype=F)+
507
508
509
510
511
512
513
  theme_minimal(14)


#->ExploreSoloPlot


#ggsave(plot=ExploreSoloPlot,filename="../X_Figures/TimecourseExplore.png",width=6.3,height=5)
Ciranka's avatar
Ciranka committed
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
```


```{r}
newExp_all%>%group_by(iter)%>%
  mutate(newCum=cumsum(newExplore))%>%
  ungroup()%>%group_by(trials,iter)%>%
  summarise(explore=max(newCum))%>%
  ungroup()%>%
  arrange(iter)%>%
  #ungroup()%>%#### looks about right but doublecheck.
  mutate(
    explore2=explore-lag(explore,50)
  )%>%mutate(
    Stage=case_when(
      (trials<401)~"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,iter)%>%
  summarize(AUC=trapz(trials,explore2))->AUCSoloTbl
ylimauc<-AUCSoloTbl%>%ungroup()%>%select(AUC)%>%max()
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")+
540
  scale_x_discrete(name="Developmental Stage",breaks=c(1,2,3),labels=c("Children","Adolescents","Adults"))+
Ciranka's avatar
Ciranka committed
541
  ggtitle("Exploration (AUC) - Solo")+
542
  scale_fill_brewer(palette = "Set2",breaks=c(1,2,3),labels=c("Children","Adolescents","Adults"))+
Ciranka's avatar
Ciranka committed
543
  scale_y_continuous(name=c("AUC Explore"),limits=c(0,ylimauc))+
544
  theme_minimal(14)->AUCSolo
Ciranka's avatar
Ciranka committed
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
```


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

```{r setupsims}
# get sd of whole environemt for normalizing model input
set.seed(as.numeric(Sys.time()))
loadfromdisk=T
###
###
###
###
### PARAMETERS
###
###
###
#get lambda
#get beta
cntrl_social<-list(
  beta=0,# this scales risk attitude.
  #get tau
570
  tau=1,
Ciranka's avatar
Ciranka committed
571
  mu0=100,#exploration bonus
572
  var0=40,
Ciranka's avatar
Ciranka committed
573
574
575
576
577
578
579
580
581
  #create a parameter vector
  parVec <- c(0.8, 0.8, 1, .0001) ,
  #loop through trials
  out=NULL,
  AllChoices_social=NULL,
  dummy=NULL,
  overallCnt=1,
  dat_social=expand.grid(x1=1:12,x2=1:12),
  
582
583
  HowManyOthers=19,
  diminishingSocial=0.8
Ciranka's avatar
Ciranka committed
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
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
677
678
679
680
681
682
683
684
685
686
687
688
689
  # info about the agents
)

```

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

```{r}
###
###
### 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,diminishingSocial,nround,overallCnt,cntrl,sampleVec){
  lowestx=4
  highestx=9
  lambda=cntrl$lambda
  #get beta
  beta<-cntrl$beta# this scales risk attitude.
  #get tau
  tau<-cntrl$tau
  mu0<-cntrl$mu0#exploration bonus
  var0<-cntrl$var0
  #create a parameter vector
  parVec <- cntrl$parVec
  #
  ExploreBonus=cntrl$ExploreBonus
  #kernel is RBF
  #k<-rbf
  #loop through trials
  out=cntrl$out
  
  mu0=100
  if (HowManyOthers==1){
    return(list(Others=dat_social$others,LastSamples=X_oth,LastReturn=y_oth,OthersUtil=others))
  }
  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
      y_oth[HowManyOthers]<-as.matrix(rnorm(1,mean = EnvirionemntAdol[ind,]$Mean,sd=EnvirionemntAdol[ind,]$Variance))
    }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
      y_oth[HowManyOthers]<-as.matrix(rnorm(1,mean = EnvirionemntAdol[ind,]$Mean,sd=EnvirionemntAdol[ind,]$Variance))
    }
    if (overallCnt>1){
      others[[HowManyOthers]]<-bayesianMeanTracker(X_oth[[HowManyOthers]],y_oth[HowManyOthers], theta=lambda, prevPost=others[[HowManyOthers]],mu0Par=mu0,var0Par = var0)
    }else{
      others[[HowManyOthers]]<-bayesianMeanTracker(X_oth[[HowManyOthers]],y_oth[HowManyOthers],theta=lambda, prevPost=NULL,mu0Par=mu0,var0Par=var0)
    }     
    utilityVec<-ucb(others[[HowManyOthers]],beta)
    #browser()
    #if(nround==1){
    # no social impact in "kids environment"
    #  utilityVec=utilityVec#+otherLoc
    #} else{
    #social impact follows a power law starting in adolescnece. 
    # browser()
    utilityVec=utilityVec+otherLoc^diminishingSocial
    #}
    utilities <- utilityVec - max(utilityVec)
    # utilities=utilities
    #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
    y_oth[HowManyOthers]<-as.matrix(rnorm(n=1,mean = EnvirionemntAdol[ind,]$Mean,sd=EnvirionemntAdol[ind,]$Variance))# change this into a sample.
    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,diminishingSocial,nround,overallCnt,cntrl,sampleVec)# recursion
  }
}

```



```{r}
#otherLoc=0
exploreEnv_Social<-function(explore_func,choiceRule,socialfunc,env2,env1,cntrl,iter){
690
  #for (rep in 1:ntrialss){
Ciranka's avatar
Ciranka committed
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
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
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
  #unpack
  lambda=cntrl$lambda
  #get beta
  beta<-cntrl$beta# this scales risk attitude.
  #get tau
  tau<-cntrl$tau
  mu0<-cntrl$mu0#exploration bonus
  var0<-cntrl$var0
  #create a parameter vector
  parVec <- cntrl$parVec
  #
  ExploreBonus=cntrl$ExploreBonus
  #kernel is RBF
  #k<-rbf
  #loop through trials
  out=cntrl$out
  AllChoices_social=cntrl$AllChoices_social
  dummy=cntrl$dummy
  overallCnt=cntrl$overallCnt
  dat_social=cntrl$dat_social
  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.
  
  HowManyOthers=cntrl$HowManyOthers
  diminishingSocial=cntrl$diminishingSocial
  # 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
  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)
      nTrials=400
    }else {
      ind<-sample(1:144,1)
      nTrials=400
    }
    #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
      y<-as.matrix(rnorm(1,mean = EnvirionemntAdol[ind,]$Mean,sd=EnvirionemntAdol[ind,]$Variance))
    }else if(overallCnt==1) {
      print("Youre an adolescent now")
      X<-as.matrix(dat_social[ind,1:2])# generate a new vector of Xs
      y<-as.matrix(rnorm(1,mean = EnvirionemntAdol[ind,]$Mean,sd=EnvirionemntAdol[ind,]$Variance))
    }
    #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....
      ####
      ####
      Out_Others=WhereIsEverybody(HowManyOthers,others,otherLoc,dat_social,X_oth,y_oth,diminishingSocial,nround,overallCnt,cntrl,sampleVec)
      otherLoc=Out_Others$Others
      X_oth=Out_Others$LastSamples
      y_oth=Out_Others$LastReturn
      others=Out_Others$OthersUtil
      
      #add social info
      #browser()
      ####
      ####
      #print(otherLoc)
      utilityVec<-ucb(out,beta)
      # 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
      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
      y<-rbind(y, as.matrix(rnorm(n=1,mean = EnvirionemntAdol[ind,]$Mean,sd=EnvirionemntAdol[ind,]$Variance)))# change this into a sample.
      #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]
  }
  
  ## 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
    }
  }
  Plot_dat_social$iter=iter
  return(Plot_dat_social)
}
#loadfromdisk==F
if (loadfromdisk==F){
840
  Plot_dat_social_All<-foreach(trials=1:ntrialss, .combine='rbind') %dopar%{
Ciranka's avatar
Ciranka committed
841
842
843
844
845
846
    exploreEnv_Social(explore_func=bayesianMeanTracker,
                      choiceRule=ucb,
                      socialfunc=WhereIsEverybody,
                      env2=EnvirionemntAdol,
                      env1=EnvirionemntKids,
                      cntrl=cntrl_social,
847
                      trials)
Ciranka's avatar
Ciranka committed
848
849
850
851
852
853
854
855
856
857
858
859
  }
  saveRDS(file="../A_GeneratedFiles/Plot_dat_social_All.rds",object=Plot_dat_social_All)
} else{
  Plot_dat_social_All<-readRDS(file="../A_GeneratedFiles/Plot_dat_social_All.rds")
}
```





# Now lets contrast the relative & the total number of risky decisions.
860
This plot shows the same as above. Counts of Gains and Losses and Severity in Losses.
Ciranka's avatar
Ciranka committed
861
862
863
864
865
866
867
Generally having others in this patch seems to help making better decisions, also during adolescence!

```{r fig.width=10}
Plot_dat_social_All[length(Plot_dat_social_All$x),]$out=-0.1# dummy to make the x axis for the adult plot right
Plot_dat_social_All%>%group_by(x,y,iter)%>%filter(trials<=400)%>%mutate(cumDens=cumsum(sample),
                                                                        Outcome=case_when(
                                                                          (out<0)~"Loss",
868
                                                                          (out>=0)~"Gain"
Ciranka's avatar
Ciranka committed
869
870
871
872
873
874
875
                                                                        )
)%>%group_by(Outcome,iter)%>%summarise(howMany=n()/144,
                                    howMuch=sum(out))->KidsSoc

Plot_dat_social_All%>%group_by(x,y,iter)%>%filter(trials>=400 & trials<800)%>%mutate(cumDens=cumsum(sample),
                                                                                     Outcome=case_when(
                                                                                       (out<0)~"Loss",
876
                                                                                       (out>=0)~"Gain"
Ciranka's avatar
Ciranka committed
877
878
879
880
881
882
883
                                                                                     )
)%>%group_by(Outcome,iter)%>%summarise(howMany=n()/144,
                                    howMuch=sum(out))->AdolescentsSoc

Plot_dat_social_All%>%group_by(x,y,iter)%>%filter(trials>800 & trials<1200)%>%mutate(cumDens=cumsum(sample),
                                                                                     Outcome=case_when(
                                                                                       (out<0)~"Loss",
884
                                                                                       (out>=0)~"Gain"
Ciranka's avatar
Ciranka committed
885
886
887
888
889
890
891
892
893
894
895
896
897
                                                                                     )
)%>%group_by(Outcome,iter)%>%summarise(howMany=n()/144,
                                    howMuch=sum(out)
)->YoungAdultsSoc

AdolescentsSoc$Stage="2"
KidsSoc$Stage="1"
YoungAdultsSoc$Stage="3"

AdolescentsSoc$Soc="1"
KidsSoc$Soc="1"
YoungAdultsSoc$Soc="1"

898
Plot_labels=c("Children","Adolescents","Adults")
Ciranka's avatar
Ciranka committed
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936

rbind(KidsSoc,AdolescentsSoc,YoungAdultsSoc)->AllSoc
```

```{r fig.width=11,fig.height=3}


#first show distribution of risky decisions as kid
ggplot(KidsSoc,aes(x=Outcome,y=howMany,fill=Outcome))+
  geom_jitter(aes(group=iter,color=Outcome),alpha=0.3)+
  stat_summary(aes(color=Outcome),geom="pointrange",color="black",fun.data = "mean_cl_boot")+
  coord_cartesian(ylim=c(0,400))+
  scale_y_continuous(name="#")+
  ggtitle("outcomes children\nsolo")+
  guides(fill=F)+
  theme_minimal(8)->One

#then show distribution of risky decisions as adolescent
ggplot(AdolescentsSoc,aes(x=Outcome,y=howMany,fill=Outcome))+
  geom_jitter(aes(group=iter,color=Outcome),alpha=0.3)+
  stat_summary(aes(color=Outcome),geom="pointrange",color="black",fun.data = "mean_cl_boot")+
  coord_cartesian(ylim=c(0,400))+
  scale_y_continuous(name="")+
  ggtitle("outcomes adolescents\nsolo")+
  guides(fill=F)+
  theme_minimal(8)->Two

#then Adults distribution of risky decisions as adolescent
ggplot(YoungAdultsSoc,aes(x=Outcome,y=howMany,fill=Outcome))+
  geom_jitter(aes(group=iter,color=Outcome),alpha=0.3)+
  stat_summary(aes(color=Outcome),geom="pointrange",color="black",fun.data = "mean_cl_boot")+
  scale_y_continuous(name="")+
  coord_cartesian(ylim=c(0,400))+
  guides(fill=F)+
  ggtitle("outcomes adults\nsolo")+
  theme_minimal(8)->Three

#Now, look at the outcome
937
ggplot(AllSoc[AllSoc$Outcome=="Gain",],aes(x=Stage,y=howMuch,fill=Stage))+
Ciranka's avatar
Ciranka committed
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
  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")+
  scale_x_discrete("Developmental Stage",breaks=c("1","2","3"),labels=Plot_labels)+
  ggtitle("Severety of bad\noutcomes")+
  scale_color_brewer(palette = "Set2")+
  #coord_cartesian(ylim=c(-2000000,0))+
  guides(fill=F)+
  theme_minimal(8)->Four

cowplot::plot_grid(One,Two,Three,NULL,Four,ncol=5,rel_widths = c(1,1,1,0.3,1.7))->Social
ggsave(plot = Social,"../X_Figures/EmergentBehavior_summary_Social.png",width = 11,height = 4)
#print(Social)

```

#make plot
955
956
957
958
959
960
961
962
```{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)+
Ciranka's avatar
Ciranka committed
963
  coord_cartesian(ylim=c(0,400))+
964
965
966
  scale_shape_manual(name="",breaks=c("1","2","3"),labels=Plot_labels,values=c(24,22,21))+
  guides(fill=F,shape=F)+
  ggtitle("")+
Ciranka's avatar
Ciranka committed
967
968
969
  theme_minimal(14)->SocialQual


970
971
AllSoc%>%ggplot(aes(x=Stage,y=abs(howMuch),color=Outcome))+
  geom_jitter(aes(group=iter,shape=Stage),alpha=0.2)+
Ciranka's avatar
Ciranka committed
972
  stat_smooth(aes(x=as.numeric(Stage)))+
973
974
975
976
  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)+
Ciranka's avatar
Ciranka committed
977
  ggtitle("")+
978
979
980
  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)+
Ciranka's avatar
Ciranka committed
981
982
983
984
  theme_minimal(14)->SocialQuant


ggplot(AllIndi,aes(x=Stage,y=abs(howMuch),color=Outcome))+
985
  geom_jitter(aes(group=iter,shape=Stage),alpha=0.2)+
Ciranka's avatar
Ciranka committed
986
  stat_smooth(aes(x=as.numeric(Stage)))+
987
988
989
  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)+
Ciranka's avatar
Ciranka committed
990
  ggtitle("")+
991
992
993
  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)+
Ciranka's avatar
Ciranka committed
994
995
  theme_minimal(14)->IndiQuant

996
997
998
999
1000
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))+