Adaptive_Adolescence_Multi.Rmd 68.7 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
208
209
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
245
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
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
  #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
  
  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)
      }
      #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)
      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]
  }
  Plot_dat$iter=iter
  return(Plot_dat)
}

if(loadfromdisk==F){
298
  Plot_datAll<-foreach(iter=1:ntrialss, .combine='rbind') %dopar%{
Ciranka's avatar
Ciranka committed
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
    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",
320
                                                                  (out>=0)~"Gain"
Ciranka's avatar
Ciranka committed
321
322
323
324
325
326
327
                                                                )
)%>%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",
328
                                                                               (out>=0)~"Gain"
Ciranka's avatar
Ciranka committed
329
330
331
332
333
334
335
                                                                             )
)%>%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",
336
                                                                               (out>=0)~"Gain"
Ciranka's avatar
Ciranka committed
337
338
339
340
341
342
343
344
345
346
347
348
349
                                                                             )
)%>%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"

350
Plot_labels=c("Children","Adolescents","Adults")
Ciranka's avatar
Ciranka committed
351
352
353
354
355
356
357
358
359
360
361
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

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)
405
print(Solo)
Ciranka's avatar
Ciranka committed
406
407
408
409
410
411
412
413
414
415
416
417
```

# 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
418
compute_sampling_strategy<-function(Plot_datAll,subject){
Ciranka's avatar
Ciranka committed
419
420
  library(dplyr)
  
421
  Plot_datAll%>%filter(iter==subject)%>%group_by(x,y)%>%mutate(cumDens=cumsum(sample))%>%ungroup()%>% group_by(x,y, trials) %>%
Ciranka's avatar
Ciranka committed
422
423
424
425
426
427
428
    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)#
429
    print(i)
Ciranka's avatar
Ciranka committed
430
431
    #  newExp[newExp$trials==i,]$generalExplore=xor(newExp[newExp$trials==i,]$sample,newExp[newExp$trials==i-1,]$sample)
  }
432
  newExp$iter=subject
Ciranka's avatar
Ciranka committed
433
434
435
436
  return(newExp)
}
#saveRDS(newExp,"Derivatives_TrialWise.rds")
if (loadfromdisk==F){
437
438
439
440
441
  #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
442
  }
443
  saveRDS(file = "../A_GeneratedFiles/solotraj2.rds",object = newExp_all)
Ciranka's avatar
Ciranka committed
444
}else {
445
  newExp_all<-readRDS(file = "../A_GeneratedFiles/solotraj2.rds")
Ciranka's avatar
Ciranka committed
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
}

# 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(
466
      (trials<401)~"Children",
Ciranka's avatar
Ciranka committed
467
468
      (trials>400&trials<800)~"Adolescents",
      (trials>800)~"Adults"
469
470
471
472
    ),
    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
473
474
475
  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")+
476
 # geom_jitter()+
Ciranka's avatar
Ciranka committed
477
478
479
  #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)+
480
  geom_spline(size=1)+
Ciranka's avatar
Ciranka committed
481
482
  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")+
483
  scale_shape_manual(name="Developmental\nStage",values=c(22,21,24))+
Ciranka's avatar
Ciranka committed
484
485
486
487
  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")+
488
489
490
  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
491
492
  #scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
  #coord_cartesian(ylim=c(0,))+
493
494
  scale_y_continuous(name="Exploration decisions")+
  scale_x_continuous(name="trials")+
Ciranka's avatar
Ciranka committed
495
  guides(linetype=F)+
496
497
498
499
500
501
502
  theme_minimal(14)


#->ExploreSoloPlot


#ggsave(plot=ExploreSoloPlot,filename="../X_Figures/TimecourseExplore.png",width=6.3,height=5)
Ciranka's avatar
Ciranka committed
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
```


```{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")+
529
  scale_x_discrete(name="Developmental Stage",breaks=c(1,2,3),labels=c("Children","Adolescents","Adults"))+
Ciranka's avatar
Ciranka committed
530
  ggtitle("Exploration (AUC) - Solo")+
531
  scale_fill_brewer(palette = "Set2",breaks=c(1,2,3),labels=c("Children","Adolescents","Adults"))+
Ciranka's avatar
Ciranka committed
532
  scale_y_continuous(name=c("AUC Explore"),limits=c(0,ylimauc))+
533
  theme_minimal(14)->AUCSolo
Ciranka's avatar
Ciranka committed
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
```


# 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
559
  tau=1,
Ciranka's avatar
Ciranka committed
560
  mu0=100,#exploration bonus
561
  var0=40,
Ciranka's avatar
Ciranka committed
562
563
564
565
566
567
568
569
570
  #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),
  
571
572
  HowManyOthers=19,
  diminishingSocial=0.8
Ciranka's avatar
Ciranka committed
573
574
575
576
577
578
579
580
581
582
583
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
  # 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){
679
  #for (rep in 1:ntrialss){
Ciranka's avatar
Ciranka committed
680
681
682
683
684
685
686
687
688
689
690
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
  #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){
829
  Plot_dat_social_All<-foreach(trials=1:ntrialss, .combine='rbind') %dopar%{
Ciranka's avatar
Ciranka committed
830
831
832
833
834
835
    exploreEnv_Social(explore_func=bayesianMeanTracker,
                      choiceRule=ucb,
                      socialfunc=WhereIsEverybody,
                      env2=EnvirionemntAdol,
                      env1=EnvirionemntKids,
                      cntrl=cntrl_social,
836
                      trials)
Ciranka's avatar
Ciranka committed
837
838
839
840
841
842
843
844
845
846
847
848
  }
  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.
849
This plot shows the same as above. Counts of Gains and Losses and Severity in Losses.
Ciranka's avatar
Ciranka committed
850
851
852
853
854
855
856
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",
857
                                                                          (out>=0)~"Gain"
Ciranka's avatar
Ciranka committed
858
859
860
861
862
863
864
                                                                        )
)%>%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",
865
                                                                                       (out>=0)~"Gain"
Ciranka's avatar
Ciranka committed
866
867
868
869
870
871
872
                                                                                     )
)%>%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",
873
                                                                                       (out>=0)~"Gain"
Ciranka's avatar
Ciranka committed
874
875
876
877
878
879
880
881
882
883
884
885
886
                                                                                     )
)%>%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"

887
Plot_labels=c("Children","Adolescents","Adults")
Ciranka's avatar
Ciranka committed
888
889
890
891
892
893
894
895
896
897
898
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

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
926
ggplot(AllSoc[AllSoc$Outcome=="Gain",],aes(x=Stage,y=howMuch,fill=Stage))+
Ciranka's avatar
Ciranka committed
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
  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
944
945
946
947
948
949
950
951
```{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
952
  coord_cartesian(ylim=c(0,400))+
953
954
955
  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
956
957
958
  theme_minimal(14)->SocialQual


959
960
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
961
  stat_smooth(aes(x=as.numeric(Stage)))+
962
963
964
965
  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
966
  ggtitle("")+
967
968
969
  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
970
971
972
973
  theme_minimal(14)->SocialQuant


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

985
986
987
988
989
990
991
992
AllIndi%>%ggplot(aes(x=Stage,y=howMany,color=Outcome))+
  geom_jitter(aes(group=iter,shape=Stage),alpha=0.2)+
  #stat_summary(aes(fill=Outcome),geom="pointrange",fun.data = "mean_cl_boot",size=0.7,color="black")+
  stat_smooth(aes(x=as.numeric(Stage)))+
  geom_boxplot(width=0.5,position = position_dodge(0))+
  scale_y_continuous(name="N outcomes")+
  scale_x_discrete("",breaks=c("1","2","3"),labels=Plot_labels)+
  scale_shape_manual(name="",breaks=c("1","2","3"),labels=Plot_labels,values=c(24,22,21))+
Ciranka's avatar
Ciranka committed
993
  coord_cartesian(ylim=c(0,400))+
994
995
  guides(fill=F,shape=F)+
  ggtitle("")+
Ciranka's avatar
Ciranka committed
996
997
  theme_minimal(14)->IndiQual

998
999
1000
1001
1002
1003
leg<-get_legend(SocialQual)
title1 <- ggdraw() +draw_label("Solo Outcomes",fontface = 'bold',x = 0,hjust = 0) +
  theme(plot.margin = margin(0, 0, 0, 0))

title2 <- ggdraw() +draw_label("Social Outcomes",fontface = 'bold',x = 0,hjust = 0) +
  theme(plot.margin = margin(0, 0, 0, 0))
Ciranka's avatar
Ciranka committed
1004
1005


1006
1007
1008
1009
1010
1011
1012
1013
1014
1015

cowplot::plot_grid(IndiQuant+guides(fill=F,color=F,shape=F),NULL,IndiQual+guides(fill=F,color=F,shape=F),leg,labels=c("A","","B",""),rel_widths = c(1,0.1,1,0.4),ncol = 4)->OutcomesSolo
plot_grid(title1,OutcomesSolo,ncol = 1,rel_heights = c(0.2, 1))

ggsave(filename = "../X_Figures/OutcomesSolo3.png",width = 9.5,height = 5)

cowplot::plot_grid(SocialQuant+guides(fill=F,color=F,shape=F),NULL,SocialQual+guides(fill=F,color=F,shape=F),leg,labels=c("A","","B",""),rel_widths = c(1,0.1,1,0.4),ncol = 4)->OutcomesSocial

plot_grid(title2,OutcomesSocial,ncol = 1,rel_heights = c(0.2, 1))
ggsave(filename = "../X_Figures/OutcomesSocial3.png",width = 9.5,height = 5)
Ciranka's avatar
Ciranka committed
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

```


# Compare Solo and Social Returns

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

# Plot Returns differently

hm not sure how nice his looks but it shows two things about adolescence well:
1) high variance and 2) the most severe losses are all "adolescents" 

```{r fig.width=15}
ggplot(AllSoc[AllSoc$Outcome=="Loss",],aes(howMuch,fill=Stage))+
  # geom_histogram()+
  #geom_density(aes(group=interaction(Stage,iter),color=Stage))+
  geom_density(alpha=0.8,color="#F8766D")+
  scale_fill_brewer(palette = "Greys",breaks=c("1","2","3"),labels=Plot_labels)+
  #  scale_fill_discrete("Developmental Stage",)+
  ggtitle("")+
1041
  theme_minimal(14)->LossesDitrsSoc
Ciranka's avatar
Ciranka committed
1042
1043


1044
ggplot(AllSoc[AllSoc$Outcome=="Gain",],aes(howMuch,fill=Stage))+
Ciranka's avatar
Ciranka committed
1045
1046
1047
1048
1049
1050
  #  geom_histogram()+
  #geom_density(aes(group=interaction(Stage,iter),color=Stage))+
  geom_density(alpha=0.8,color="#00BFC4")+
  scale_fill_brewer(palette = "Greys",breaks=c("1","2","3"),labels=Plot_labels)+
  #  scale_fill_discrete("Developmental Stage",)+
  ggtitle("")+
1051
  theme_minimal(14)->GainsDistrSoc
Ciranka's avatar
Ciranka committed
1052
1053
1054
1055
1056
1057
1058
1059
1060


ggplot(AllIndi[AllIndi$Outcome=="Loss",],aes(howMuch,fill=Stage))+
  # geom_histogram()+
  #geom_density(aes(group=interaction(Stage,iter),color=Stage))+
  geom_density(alpha=0.8,color="#F8766D")+
  scale_fill_brewer(palette = "Greys",breaks=c("1","2","3"),labels=Plot_labels)+
  #  scale_fill_discrete("Developmental Stage",)+
  ggtitle("Distribution of Losses")+
1061
  theme_minimal(14)->LossesDitrsIndi
Ciranka's avatar
Ciranka committed
1062

1063
ggplot(AllIndi[AllIndi$Outcome=="Gain",],aes(howMuch,fill=Stage))+
Ciranka's avatar
Ciranka committed
1064
1065
1066
1067
1068
1069
  #  geom_histogram()+
  #geom_density(aes(group=interaction(Stage,iter),color=Stage))+
  geom_density(alpha=0.8,color="#00BFC4")+
  scale_fill_brewer(palette = "Greys",breaks=c("1","2","3"),labels=Plot_labels)+
  #  scale_fill_discrete("Developmental Stage",)+
  ggtitle("Distribution of Gains")+
1070
  theme_minimal(14)->GainsDistrIndi
Ciranka's avatar
Ciranka committed
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085

#leg<-get_legend(LossesDitrs)
#cowplot::plot_grid(LossesDitrs+guides(fill=F),GainsDistr+guides(fill=F),leg,ncol = 3,rel_widths = 1,1,0.2)
```


```{r fig.width=7}
ggplot(AllSoc,aes(howMany,fill=Stage,color=Outcome))+
  geom_histogram()+
  #stat_summary()+
  #geom_density(aes(group=interaction(Stage,iter),color=Stage))+
  #geom_density(alpha=0.5)+
  scale_fill_brewer(palette = "Greys",breaks=c("1","2","3"),labels=Plot_labels)+
  scale_color_discrete("Outcome Type",)+
  ggtitle("")+
1086
  theme_minimal(14)->socialhist
Ciranka's avatar
Ciranka committed
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
```

```{r}
ggplot(AllIndi,aes(howMany,fill=Stage,color=Outcome))+
  geom_histogram()+
  #geom_density(aes(group=interaction(Stage,iter),color=Stage))+
  #geom_density(alpha=0.5)+
  scale_fill_brewer(palette = "Greys",breaks=c("1","2","3"),labels=Plot_labels)+
  scale_color_discrete("Outcome Type",)+
  ggtitle("Outcomes")+
1097
  theme_minimal(14)->solohist
Ciranka's avatar
Ciranka committed
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
```

### Alternative Panel Version

Not sure what to think of this, it looks cool but maybe the panel above is easier to understand. 
So now the different rows in the panel correspond to individual (upper) and social (lower) simulations.

The histogram is just a tally of how often the agent encountered a loss or a gain. One histogram correspons to the first three columns of the previous panel. The densities show the magnitude of the outcomes but also the spread. The previous panel only depicted losses, therefore there is more information here.

```{r fig.width=18, include=FALSE}


#create common x and y labels
library(grid)
library(gridExtra)

Solo.grob <- textGrob("Solo", 
                      gp=gpar(col="black", fontsize=25))
Social.grob <- textGrob("Social", 
                        gp=gpar(col="black", fontsize=25))


leg<-get_legend(solohist)

soloNew<-cowplot::plot_grid(NULL,NULL,NULL,
                            solohist+guides(color=F,fill=F),
                            LossesDitrsIndi+guides(color=F,fill=F),
                            GainsDistrIndi+guides(color=F,fill=F),nrow=2,ncol=3,rel_heights = c(0.02,1))

grid.arrange(arrangeGrob(soloNew, top = Solo.grob))->soloTitle

socialsNew<-cowplot::plot_grid(NULL,NULL,NULL,
                               socialhist+guides(color=F,fill=F),
                               LossesDitrsSoc+guides(color=F,fill=F),
                               GainsDistrSoc+guides(color=F,fill=F),nrow=2,ncol=3,rel_heights = c(0.005,1))

grid.arrange(arrangeGrob(socialsNew, top = Social.grob))->socialTitle

cowplot::plot_grid(soloTitle,NULL,socialTitle,nrow=3,rel_heights = c(1,0.2,1))->NoLeg
#ggsave(filename="../X_Figures/Solo_Social_OutcomesNew.png",plot = NoLeg, width = 11, height=6)
#print(NoLeg)

```

```{r fig.width=18}
cowplot::plot_grid(NoLeg,NULL,leg,rel_widths = c(1.7,0.1,0.2),ncol=3)
```

```{r}
#this is why i love dplyr!
#create count for each new decision.
1149
compute_sampling_strategySocial<-function(Plot_dat_social_All,subject){
Ciranka's avatar
Ciranka committed
1150
1151
  library(dplyr)
  
1152
  Plot_dat_social_All%>%filter(iter==subject)%>%group_by(x,y)%>%mutate(cumDens=cumsum(sample))%>%ungroup()%>% group_by(x,y, trials) %>%
Ciranka's avatar
Ciranka committed
1153
1154
1155
1156
1157
1158
1159
1160
1161
    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)
  }
1162
  newExpSoc$iter=subject
Ciranka's avatar
Ciranka committed
1163
1164
1165
1166
1167
1168
1169
  return(newExpSoc)
}

#saveRDS(newExpSoc,"Derivatives_TrialWise_Social.rds")
# to compute the derivative
# 
# #saveRDS(newExp,"Derivatives_TrialWise.rds")
1170
1171
# newExp_all_Social<-foreach(trials=1:ntrialss, .combine='rbind') %dopar%{
#   compute_sampling_strategySocial(Plot_dat_social_All,trials)
Ciranka's avatar
Ciranka committed
1172
1173
1174
# }

if(loadfromdisk==F){
1175
1176
  newExp_all_Social_socialOutcomes<-foreach(subject=1:ntrialss, .combine='rbind',.verbose=T) %dopar%{
    compute_sampling_strategySocial(Plot_dat_social_All,subject)
Ciranka's avatar
Ciranka committed
1177
  }
1178
  saveRDS(file="../A_GeneratedFiles/newExp_all_Social_socialOutcomes_2.rds",object = newExp_all_Social_socialOutcomes)
Ciranka's avatar
Ciranka committed
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
}else{
  newExp_all_Social_socialOutcomes<-readRDS(file="../A_GeneratedFiles/newExp_all_Social_socialOutcomes.rds")
}

```



```{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")+
1212
#   theme_minimal(14)
Ciranka's avatar
Ciranka committed
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
# ggsave("../X_Figures/TimecourseExplore_Spline.png")


newExp_all_Social_socialOutcomes%>%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(
1227
      (trials<401)~"Children",
Ciranka's avatar
Ciranka committed
1228
1229
1230
      (trials>400&trials<800)~"Adolescents",
      (trials>800)~"Adults"
    )
1231
1232
  )%>%#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
1233
1234
  ggplot(aes(x=trials,y=explore2))+
  stat_summary(geom="ribbon", fun.data="mean_sdl",alpha=0.2)+
1235
  #stat_summary(geom="line",fun.y = "mean",color="black")+
Ciranka's avatar
Ciranka committed
1236
1237
1238
1239
  #geom_jitter()+
  #geom_rect(aes(xmin=50,xmax=400,ymin=-5,ymax=100,fill="1"),alpha=0.1)+
  #geom_rect(aes(xmin=400,xmax=800,ymin=-5,ymax=100,fill="2"),alpha=0.1)+
  #geom_rect(aes(xmin=801,xmax=1200,ymin=-5,ymax=100,fill="3"),alpha=0.1)+
1240
  geom_spline(size=1)+
Ciranka's avatar
Ciranka committed
1241
1242
  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")+
1243
1244
1245
1246
1247
1248
1249
1250
  scale_shape_manual(name="Developmental\nStage",values=c(22,21,24))+
  geom_vline(xintercept = 420, linetype="dotted",color="red")+
  geom_vline(xintercept = 410, linetype="dotted",color="red")+
  geom_vline(xintercept = 800, linetype="dotted",color="red")+
  geom_vline(xintercept = 790, linetype="dotted",color="red")+
  annotate("text",x=150,y=60,label=c("Children"))+
  annotate("text",x=600,y=60,label=c("Adolescents"))+
  annotate("text",x=950,y=60,label=c("Adults"))+
Ciranka's avatar
Ciranka committed
1251
1252
  #scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
  coord_cartesian(ylim=c(0,60))+
1253
1254
  scale_y_continuous(name="Exploration decisions")+
  scale_x_continuous(name="trials")+
Ciranka's avatar
Ciranka committed
1255
  guides(linetype=F)+
1256
  theme_minimal(14)->ExploreSocPlot
Ciranka's avatar
Ciranka committed
1257
1258
1259
1260
1261
1262

ggsave(plot=ExploreSocPlot,"../X_Figures/TimecourseExplore_Raw_Social.png",width = 7,height = 4)

```

# Number of explorative decisions
1263
 In comparison to solo agents we can see that introducing social information and a social folloGaing rule, seems to lead to less exploration.
Ciranka's avatar
Ciranka committed
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
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337


# put stuff into the same graph
Lets start with exploration.

```{r}
#prepare data
newExp_all_Social_socialOutcomes%>%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)~"Children",
      (trials>400&trials<800)~"Adolescents",
      (trials>800)~"Adults"
    ),
  Which="Social"
  )%>%#filter(trials>36 & (trials <401 | trials >508))%>%
  filter(!is.na(Stage) & trials %in% round(seq(50,1200,length.out = 24)))->Social_Exp

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)~"Children",
      (trials>400&trials<800)~"Adolescents",
      (trials>800)~"Adults"
    ),
    Which="Solo"
  )%>%#filter(trials>36 & (trials <401 | trials >508))%>%
  filter(!is.na(Stage) & trials %in% round(seq(50,1200,length.out = 24)))->SoloExp

library("wesanderson")
rbind(SoloExp,Social_Exp)%>%
  ggplot(aes(x=trials,y=explore2,color=Which,linetype=Which))+
 # stat_summary(geom="ribbon", fun.data="mean_sdl",alpha=0.2)+
  #stat_summary(geom="line",fun.y = "mean",color="black")+
  geom_jitter(aes(shape=Which),size=2,alpha=.5)+
  #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=3)+
  stat_summary(aes(shape=Which),geom="pointrange",fun.data="mean_cl_boot",color="black",fill="white",size=1)+
  scale_shape_manual(name="",values=c(23,24))+
  geom_vline(xintercept = 420, linetype="dotted",size=1)+
  geom_vline(xintercept = 410, linetype="dotted",size=1)+
  geom_vline(xintercept = 800, linetype="dotted",size=1)+
  geom_vline(xintercept = 790, linetype="dotted",size=1)+
  annotate("text",x=150,y=55,label=c("Children"),size=6)+
  annotate("text",x=600,y=55,label=c("Adolescents"),size=6)+
  annotate("text",x=950,y=55,label=c("Adults"),size=6)+
  scale_color_manual(name="",values=c(wes_palette("Darjeeling1")[2],wes_palette("Darjeeling1")[3]))+
  #scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
  coord_cartesian(ylim=c(0,55),xlim=c(0,1150))+
  scale_y_continuous(name="Exploration")+
  scale_x_continuous(name="trials")+
  guides(linetype=F)+
  theme_minimal(16)->Social_Solo_ExplorePlot

Ciranka's avatar
Ciranka committed
1338
```
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
# Now outcomes; Start with loss.
```{r,fig.width=10,fig.height=5}
rbind(AllSoc%>%mutate(Which="Social"),AllIndi%>%mutate(Which="Solo"))%>%filter(Outcome=="Gain")%>%
  ggplot(aes(x=Stage,y=howMany,color=Which))+
  geom_jitter(aes(group=Which),alpha=0.2,position = position_dodge(0.5))+
  #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)+
  scale_y_continuous(name="")+
  scale_x_discrete("",breaks=c("1","2","3"),labels=c("","",""))+
  scale_color_manual(name="",values=c(wes_palette("Darjeeling1")[2],wes_palette("Darjeeling1")[3]))+
  coord_cartesian(ylim=c(0,400))+
  guides(fill=F,shape=F)+
  ggtitle("")+
  theme_minimal(14)+theme(axis.text.y = element_text(color="white"))->GainMany

rbind(AllSoc%>%mutate(Which="Social"),AllIndi%>%mutate(Which="Solo"))%>%filter(Outcome=="Loss")%>%
  ggplot(aes(x=Stage,y=howMany,color=Which))+
  geom_jitter(aes(group=Which),alpha=0.2,position = position_dodge(0.5))+
  #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)+
  scale_y_continuous(name="N outcomes")+
  scale_x_discrete("",breaks=c("1","2","3"),labels=c("","",""))+
  scale_color_manual(name="",values=c(wes_palette("Darjeeling1")[2],wes_palette("Darjeeling1")[3]))+
  coord_cartesian(ylim=c(0,400))+
  guides(fill=F,shape=F)+
  ggtitle("")+
  theme_minimal(14)->LossMany
Ciranka's avatar
Ciranka committed
1368
1369


1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
rbind(AllSoc%>%mutate(Which="Social"),AllIndi%>%mutate(Which="Solo"))%>%filter(Outcome=="Loss")%>%
  ggplot(aes(x=Stage,y=abs(howMuch),color=Which))+
  geom_jitter(aes(group=Which),alpha=0.2,position = position_dodge(0.5))+
  #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)+
  scale_y_continuous(name="magnitude [au]")+
  scale_x_discrete("",breaks=c("1","2","3"),labels=Plot_labels)+
  scale_color_manual(name="",values=c(wes_palette("Darjeeling1")[2],wes_palette("Darjeeling1")[3]))+
  guides(fill=F,shape=F)+
  ggtitle("")+
  theme_minimal(14)+theme(axis.text.y = element_blank())->LossMuch

rbind(AllSoc%>%mutate(Which="Social"),AllIndi%>%mutate(Which="Solo"))%>%filter(Outcome=="Gain")%>%
  ggplot(aes(x=Stage,y=abs(howMuch),color=Which))+
  geom_jitter(aes(group=Which),alpha=0.2,position = position_dodge(0.5))+
  #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)+
  scale_y_continuous(name="")+
  scale_x_discrete("",breaks=c("1","2","3"),labels=Plot_labels)+
  scale_color_manual(name="",values=c(wes_palette("Darjeeling1")[2],wes_palette("Darjeeling1")[3]))+
 # coord_cartesian(ylim=c(0,400))+
  guides(fill=F,shape=F)+
  ggtitle("")+
  theme_minimal(14)+theme(axis.text.y = element_blank())->GainMuch
leg=get_legend(LossMany)

one<-plot_grid(LossMany+guides(color=F),LossMuch+guides(color=F),nrow=2,labels=c("A","B"))
two<-plot_grid(GainMany+guides(color=F),GainMuch+guides(color=F),nrow=2,labels=c("C","D"))

together=plot_grid(one,NULL,two,leg,ncol=4,rel_widths = c(1,0.1,1,0.3))

ggsave(plot=together,filename = "All_Indices.png",width = 10,height = 5)
```

Ciranka's avatar
Ciranka committed
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
```{r}
# Area under the curve
newExp_all_Social_socialOutcomes%>%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))%>%
  ggplot(aes(x=Stage,y=AUC))+
  #geom_jitter(aes(group=iter,color=Stage),alpha=0.1)+
  stat_summary(aes(x=Stage,y=AUC,fill=Stage),geom="bar",color="black",fun.y = "mean",stat="identity")+
  stat_summary(aes(color=Stage),geom="pointrange",color="black",fun.data = "mean_cl_boot")+
  scale_x_discrete(name="Developmental Stage",breaks=c(1,2,3),labels=c("Kids","Adolescents","Adults"))+
  ggtitle("Exploration (AUC) - Social")+
  scale_fill_brewer(palette = "Set2",breaks=c(1,2,3),labels=c("Kids","Adolescents","Adults"))+
  scale_y_continuous(name=c("AUC Explore"),limits=c(0,ylimauc))+
1433
  theme_minimal(14)->AUCSocial
Ciranka's avatar
Ciranka committed
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
```

#Compare Solo & Social AUCs

```{r fig.width=10}
leg<-get_legend(AUCSocial)
cowplot::plot_grid(AUCSolo+guides(fill=F),AUCSocial+guides(fill=F)+theme(axis.title.y = element_text(color="white")),leg,ncol=3,rel_widths = c(1,1,0.2))
```



#to be done.
# 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


```{r}

1458
compute_SocialOutcomes<-function(newExp_all_Social_socialOutcomes,subject){
Ciranka's avatar
Ciranka committed
1459
1460
1461
  #for( i in 1:length(unique(newExpSoc$trials))){
  #If you explored a new option that was sampled my more than 0 others before.
  library(dplyr)
1462
  newExpSoc<-newExp_all_Social_socialOutcomes%>%filter(iter==subject)
Ciranka's avatar
Ciranka committed
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
  newExpSoc$GoToOthers=0
  newExpSoc$GoToNoone=0
  newExpSoc$StayWithOthers=0
  newExpSoc$StayWithNoone=0
  
  for (i in 2:length(unique(newExpSoc$trials))){
    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))
  }
  
  return (newExpSoc)
}
#   
#
# }
if(loadfromdisk==F){
1496
1497
  newExp_all_Social_socialOutcomes<-foreach(subject=1:ntrialss, .combine='rbind') %dopar%{
    compute_SocialOutcomes(newExp_all_Social_socialOutcomes,subject)
Ciranka's avatar
Ciranka committed
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
  }
  saveRDS(file="../A_GeneratedFiles/newExp_all_Social_socialOutcomes.rds",object = newExp_all_Social_socialOutcomes)
}else{
  #probably dont need ot do anything
  newExp_all_Social_socialOutcomes<-readRDS(file="../A_GeneratedFiles/newExp_all_Social_socialOutcomes.rds")
}


```



```{r}
newExp_all_Social_socialOutcomes%>%group_by(iter)%>%
  mutate(newCum=cumsum(GoToNoone))%>%
  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(
1522
      (trials<401)~"Children",
Ciranka's avatar
Ciranka committed
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
      (trials>400&trials<800)~"Adolescents",
      (trials>800)~"Adults"
    )
  )%>%filter(!is.na(Stage) & trials %in% round(seq(50,1200,length.out = 24)))%>%
  ggplot(aes(x=trials,y=explore2))+
  stat_summary(geom="ribbon", fun.data="mean_sdl",alpha=0.2)+
  stat_summary(geom="line",fun.y = "mean",color="black")+
  #geom_jitter()+
  #geom_rect(aes(xmin=50,xmax=400,ymin=-5,ymax=100,fill="1"),alpha=0.1)+
  #geom_rect(aes(xmin=400,xmax=800,ymin=-5,ymax=100,fill="2"),alpha=0.1)+
  #geom_rect(aes(xmin=801,xmax=1200,ymin=-5,ymax=100,fill="3"),alpha=0.1)+
  #geom_spline(size=1)+
  geom_point(aes(shape=Stage),size=1,alpha=0.1)+
  stat_summary(aes(shape=Stage),geom="point",fun.y = "mean",size=2.5,color="black",fill="white")+
  scale_shape_manual(name="Developmental Stage",values=c(22,21,24))+
  geom_vline(xintercept = 420, linetype="dotted",color="royalblue")+
  geom_vline(xintercept = 410, linetype="dotted",color="royalblue")+
  geom_vline(xintercept = 800, linetype="dotted",color="royalblue")+
  geom_vline(xintercept = 790, linetype="dotted",color="royalblue")+
1542
1543
1544
  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
1545
1546
  #scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
  coord_cartesian(ylim=c(0,60))+
1547
  scale_fill_brewer(name="Developmental\nStage",labels=c("Childhood","Adolescence","Adulthood"),palette = "Reds")+
Ciranka's avatar
Ciranka committed
1548
1549
1550
  scale_y_continuous(name="Decisions")+
  scale_x_continuous(name="trials")+
  ggtitle("Switch Where Noone Is")+
1551
  theme_minimal(14)
Ciranka's avatar
Ciranka committed
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
#ggsave("../X_Figures/TimecourseExplore_Raw_Social_Gotonoone.png")

```

```{r}
newExp_all_Social_socialOutcomes%>%group_by(iter)%>%
  mutate(newCum=cumsum(GoToOthers))%>%
  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(
1567
1568
   Stage=case_when(
      (trials<401)~"Children",
Ciranka's avatar
Ciranka committed
1569
1570
1571
      (trials>400&trials<800)~"Adolescents",
      (trials>800)~"Adults"
    )
1572
1573
  )%>%
  filter(!is.na(Stage) & trials %in% round(seq(50,1200,length.out = 24)))%>%
Ciranka's avatar
Ciranka committed
1574
  ggplot(aes(x=trials,y=explore2))+
1575
1576
 # stat_summary(geom="ribbon", fun.data="mean_sdl",alpha=0.2)+
  #stat_summary(geom="line",fun.y = "mean",color="black")+
Ciranka's avatar
Ciranka committed
1577
1578
1579
1580
  #geom_jitter()+
  #geom_rect(aes(xmin=50,xmax=400,ymin=-5,ymax=100,fill="1"),alpha=0.1)+
  #geom_rect(aes(xmin=400,xmax=800,ymin=-5,ymax=100,fill="2"),alpha=0.1)+
  #geom_rect(aes(xmin=801,xmax=1200,ymin=-5,ymax=100,fill="3"),alpha=0.1)+
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
  geom_jitter(size=2,alpha=.5,shape=21,color=wes_palette("Darjeeling1")[5])+
  #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=3,color=wes_palette("Darjeeling1")[5])+
  stat_summary(geom="pointrange",fun.data="mean_cl_boot",fill="white",size=1,shape=21,color="black")+
  geom_vline(xintercept = 420, linetype="dotted",color="black",size=1)+
  geom_vline(xintercept = 410, linetype="dotted",color="black",size=1)+
  geom_vline(xintercept = 800, linetype="dotted",color="black",size=1)+
  geom_vline(xintercept = 790, linetype="dotted",color="black",size=1)+
  guides(shape=F)+
Ciranka's avatar
Ciranka committed
1592
  #scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
1593
1594
1595
1596
1597
1598
1599
  coord_cartesian(ylim=c(0,55),xlim=c(0,1150))+
  #ggtitle("Following Others")+
  scale_y_continuous(name="Following others")+
  scale_x_continuous(name="timepoint")+
  theme_minimal(16)->following


Ciranka's avatar
Ciranka committed
1600
1601
1602

ggsave(filename = "../X_Figures/SwitchWhereOthersAre.png")
```
1603
1604
```{r fig.width=12,fig.height=6}

Ciranka's avatar
Ciranka committed
1605

1606
legsocialnonsocial<-get_legend(Social_Solo_ExplorePlot)
Ciranka's avatar
Ciranka committed
1607

1608
1609
1610
1611
1612
explore_social_plot=plot_grid(Social_Solo_ExplorePlot+scale_x_continuous(name="")+guides(color=F,shape=F),legsocialnonsocial,
          following,NULL,rel_widths = c(1,0.2),labels=c("A","","B",""))
  ggsave(explore_social_plot,filename = "SocialSolo_Explore_Follow.png",dpi = 320,width = 12,height = 6)
  
  explore_social_plot
Ciranka's avatar
Ciranka committed
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
```


```{r}
newExp_all_Social_socialOutcomes%>%group_by(iter)%>%
  mutate(newCum=cumsum(StayWithOthers))%>%
  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(
1628
      (trials<401)~"Children",
Ciranka's avatar
Ciranka committed
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
      (trials>400&trials<800)~"Adolescents",
      (trials>800)~"Adults"
    )
  )%>%filter(!is.na(Stage) & trials %in% round(seq(50,1200,length.out = 24)))%>%
  ggplot(aes(x=trials,y=explore2))+
  stat_summary(geom="ribbon", fun.data="mean_sdl",alpha=0.2)+
  stat_summary(geom="line",fun.y = "mean",color="black")+
  #geom_jitter()+
  #geom_rect(aes(xmin=50,xmax=400,ymin=-5,ymax=100,fill="1"),alpha=0.1)+
  #geom_rect(aes(xmin=400,xmax=800,ymin=-5,ymax=100,fill="2"),alpha=0.1)+
  #geom_rect(aes(xmin=801,xmax=1200,ymin=-5,ymax=100,fill="3"),alpha=0.1)+
  #geom_spline(size=1)+
  geom_point(aes(shape=Stage),size=1,alpha=0.1)+
  stat_summary(aes(shape=Stage),geom="point",fun.y = "mean",size=2.5,color="black",fill="white")+
  scale_shape_manual(name="Developmental Stage",values=c(22,21,24))+
  geom_vline(xintercept = 420, linetype="dotted",color="royalblue")+
  geom_vline(xintercept = 410, linetype="dotted",color="royalblue")+
  geom_vline(xintercept = 800, linetype="dotted",color="royalblue")+
  geom_vline(xintercept = 790, linetype="dotted",color="royalblue")+
1648
1649
1650
  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
1651
1652
  #scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
  coord_cartesian(ylim=c(0,60))+
1653
  #scale_fill_brewer(name="Developmental Stage",labels=c("Children","Adolescents","Adults"),palette = "Reds")+
Ciranka's avatar
Ciranka committed
1654
1655
1656
  scale_y_continuous(name="Decisions")+
  scale_x_continuous(name="trials")+
  ggtitle("Stay With Others")+
1657
  theme_minimal(14)
Ciranka's avatar
Ciranka committed
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
```


```{r}
newExp_all_Social_socialOutcomes%>%group_by(iter)%>%
  mutate(newCum=cumsum(StayWithNoone))%>%
  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(
1673
      (trials<401)~"Children",
Ciranka's avatar
Ciranka committed
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
      (trials>400&trials<800)~"Adolescents",
      (trials>800)~"Adults"
    )
  )%>%filter(!is.na(Stage) & trials %in% round(seq(50,1200,length.out = 24)))%>%
  ggplot(aes(x=trials,y=explore2))+
  stat_summary(geom="ribbon", fun.data="mean_sdl",alpha=0.2)+
  stat_summary(geom="line",fun.y = "mean",color="black")+
  #geom_jitter()+
  #geom_rect(aes(xmin=50,xmax=400,ymin=-5,ymax=100,fill="1"),alpha=0.1)+
  #geom_rect(aes(xmin=400,xmax=800,ymin=-5,ymax=100,fill="2"),alpha=0.1)+
  #geom_rect(aes(xmin=801,xmax=1200,ymin=-5,ymax=100,fill="3"),alpha=0.1)+
  #geom_spline(size=1)+
  geom_point(aes(shape=Stage),size=1,alpha=0.1)+
  stat_summary(aes(shape=Stage),geom="point",fun.y = "mean",size=2.5,color="black",fill="white")+
  scale_shape_manual(name="Developmental Stage",values=c(22,21,24))+
  geom_vline(xintercept = 420, linetype="dotted",color="royalblue")+
  geom_vline(xintercept = 410, linetype="dotted",color="royalblue")+
  geom_vline(xintercept = 800, linetype="dotted",color="royalblue")+
  geom_vline(xintercept = 790, linetype="dotted",color="royalblue")+
1693
1694
1695
  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
1696
1697
  #scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
  coord_cartesian(ylim=c(0,60))+
1698
  scale_fill_brewer(name="Developmental Stage",labels=c("Children","Adolescents","Adults"),palette = "Reds")+
Ciranka's avatar
Ciranka committed
1699
1700
1701
  scale_y_continuous(name="Decisions")+
  scale_x_continuous(name="trials")+
  ggtitle("Stay With Noone")+
1702
  theme_minimal(14)
Ciranka's avatar
Ciranka committed
1703
```