Adaptive_Adolescence_Multi.Rmd 71 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
1001
1002
1003
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
1004
  coord_cartesian(ylim=c(0,400))+
1005
1006
  guides(fill=F,shape=F)+
  ggtitle("")+
Ciranka's avatar
Ciranka committed
1007
1008
  theme_minimal(14)->IndiQual

1009
1010
1011
1012
1013
1014
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
1015
1016


1017
1018
1019
1020
1021
1022
1023
1024
1025
1026

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
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051

```


# 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("")+
1052
  theme_minimal(14)->LossesDitrsSoc
Ciranka's avatar
Ciranka committed
1053
1054


1055
ggplot(AllSoc[AllSoc$Outcome=="Gain",],aes(howMuch,fill=Stage))+
Ciranka's avatar
Ciranka committed
1056
1057
1058
1059
1060
1061
  #  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("")+
1062
  theme_minimal(14)->GainsDistrSoc
Ciranka's avatar
Ciranka committed
1063
1064
1065
1066
1067
1068
1069
1070
1071


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")+
1072
  theme_minimal(14)->LossesDitrsIndi
Ciranka's avatar
Ciranka committed
1073

1074
ggplot(AllIndi[AllIndi$Outcome=="Gain",],aes(howMuch,fill=Stage))+
Ciranka's avatar
Ciranka committed
1075
1076
1077
1078
1079
1080
  #  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")+
1081
  theme_minimal(14)->GainsDistrIndi
Ciranka's avatar
Ciranka committed
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096

#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("")+
1097
  theme_minimal(14)->socialhist
Ciranka's avatar
Ciranka committed
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
```

```{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")+
1108
  theme_minimal(14)->solohist
Ciranka's avatar
Ciranka committed
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
```

### 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.
1160
compute_sampling_strategySocial<-function(Plot_dat_social_All,subject){
Ciranka's avatar
Ciranka committed
1161
1162
  library(dplyr)
  
1163
  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
1164
1165
1166
1167
1168
1169
1170
1171
1172
    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)
  }
1173
  newExpSoc$iter=subject
Ciranka's avatar
Ciranka committed
1174
1175
1176
1177
1178
1179
1180
  return(newExpSoc)
}

#saveRDS(newExpSoc,"Derivatives_TrialWise_Social.rds")
# to compute the derivative
# 
# #saveRDS(newExp,"Derivatives_TrialWise.rds")
1181
1182
# newExp_all_Social<-foreach(trials=1:ntrialss, .combine='rbind') %dopar%{
#   compute_sampling_strategySocial(Plot_dat_social_All,trials)
Ciranka's avatar
Ciranka committed
1183
1184
1185
# }

if(loadfromdisk==F){
1186
1187
  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
1188
  }
1189
  saveRDS(file="../A_GeneratedFiles/newExp_all_Social_socialOutcomes_2.rds",object = newExp_all_Social_socialOutcomes)
Ciranka's avatar
Ciranka committed
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
}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")+
1223
#   theme_minimal(14)
Ciranka's avatar
Ciranka committed
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
# 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(
1238
      (trials<401)~"Children",
Ciranka's avatar
Ciranka committed
1239
1240
1241
      (trials>400&trials<800)~"Adolescents",
      (trials>800)~"Adults"
    )
1242
1243
  )%>%#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
1244
1245
  ggplot(aes(x=trials,y=explore2))+
  stat_summary(geom="ribbon", fun.data="mean_sdl",alpha=0.2)+
1246
  #stat_summary(geom="line",fun.y = "mean",color="black")+
Ciranka's avatar
Ciranka committed
1247
1248
1249
1250
  #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)+
1251
  geom_spline(size=1)+
Ciranka's avatar
Ciranka committed
1252
1253
  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")+
1254
1255
1256
1257
1258
1259
1260
1261
  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
1262
1263
  #scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
  coord_cartesian(ylim=c(0,60))+
1264
1265
  scale_y_continuous(name="Exploration decisions")+
  scale_x_continuous(name="trials")+
Ciranka's avatar
Ciranka committed
1266
  guides(linetype=F)+
1267
  theme_minimal(14)->ExploreSocPlot
Ciranka's avatar
Ciranka committed
1268
1269
1270
1271
1272
1273

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

```

# Number of explorative decisions
1274
 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
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
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348


# 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
1349
```
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
# 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("")+
1364
  theme_minimal(14)->GainMany
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378

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
1379
1380


1381
rbind(AllSoc%>%mutate(Which="Social"),AllIndi%>%mutate(Which="Solo"))%>%filter(Outcome=="Loss")%>%
1382
  ggplot(aes(x=Stage,y=abs(howMuch)/40000,color=Which))+
1383
1384
1385
1386
  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)+
1387
  scale_y_continuous(name="mean magnitude")+
1388
1389
1390
1391
  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("")+
1392
  theme_minimal(14)->LossMuch
1393
1394

rbind(AllSoc%>%mutate(Which="Social"),AllIndi%>%mutate(Which="Solo"))%>%filter(Outcome=="Gain")%>%
1395
  ggplot(aes(x=Stage,y=abs(howMuch)/40000,color=Which))+
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
  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("")+
1406
  theme_minimal(14)->GainMuch
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
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
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
```{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))+
1444
  theme_minimal(14)->AUCSocial
Ciranka's avatar
Ciranka committed
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
```

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

1469
compute_SocialOutcomes<-function(newExp_all_Social_socialOutcomes,subject){
Ciranka's avatar
Ciranka committed
1470
1471
1472
  #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)
1473
  newExpSoc<-newExp_all_Social_socialOutcomes%>%filter(iter==subject)
Ciranka's avatar
Ciranka committed
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
  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){
1507
1508
  newExp_all_Social_socialOutcomes<-foreach(subject=1:ntrialss, .combine='rbind') %dopar%{
    compute_SocialOutcomes(newExp_all_Social_socialOutcomes,subject)
Ciranka's avatar
Ciranka committed
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
  }
  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(
1533
      (trials<401)~"Children",
Ciranka's avatar
Ciranka committed
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
      (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")+
1553
1554
1555
  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
1556
1557
  #scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
  coord_cartesian(ylim=c(0,60))+
1558
  scale_fill_brewer(name="Developmental\nStage",labels=c("Childhood","Adolescence","Adulthood"),palette = "Reds")+
Ciranka's avatar
Ciranka committed
1559
1560
1561
  scale_y_continuous(name="Decisions")+
  scale_x_continuous(name="trials")+
  ggtitle("Switch Where Noone Is")+
1562
  theme_minimal(14)
Ciranka's avatar
Ciranka committed
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
#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(
1578
1579
   Stage=case_when(
      (trials<401)~"Children",
Ciranka's avatar
Ciranka committed
1580
1581
1582
      (trials>400&trials<800)~"Adolescents",
      (trials>800)~"Adults"
    )
1583
1584
  )%>%
  filter(!is.na(Stage) & trials %in% round(seq(50,1200,length.out = 24)))%>%
Ciranka's avatar
Ciranka committed
1585
  ggplot(aes(x=trials,y=explore2))+
1586
1587
 # 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
1588
1589
1590
1591
  #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)+
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
  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
1603
  #scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
1604
1605
1606
1607
1608
1609
1610
  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
1611
1612
1613

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

Ciranka's avatar
Ciranka committed
1616

1617
legsocialnonsocial<-get_legend(Social_Solo_ExplorePlot)
Ciranka's avatar
Ciranka committed
1618

1619
1620
1621
1622
1623
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
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
```


```{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(
1639
      (trials<401)~"Children",
Ciranka's avatar
Ciranka committed
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
      (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")+
1659
1660
1661
  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
1662
1663
  #scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
  coord_cartesian(ylim=c(0,60))+
1664
  #scale_fill_brewer(name="Developmental Stage",labels=c("Children","Adolescents","Adults"),palette = "Reds")+
Ciranka's avatar
Ciranka committed
1665
1666
1667
  scale_y_continuous(name="Decisions")+
  scale_x_continuous(name="trials")+
  ggtitle("Stay With Others")+
1668
  theme_minimal(14)
Ciranka's avatar
Ciranka committed
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
```


```{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(
1684
      (trials<401)~"Children",
Ciranka's avatar
Ciranka committed
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
      (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")+
1704
1705
1706
  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
1707
1708
  #scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
  coord_cartesian(ylim=c(0,60))+
1709
  scale_fill_brewer(name="Developmental Stage",labels=c("Children","Adolescents","Adults"),palette = "Reds")+
Ciranka's avatar
Ciranka committed
1710
1711
1712
  scale_y_continuous(name="Decisions")+
  scale_x_continuous(name="trials")+
  ggtitle("Stay With Noone")+
1713
  theme_minimal(14)
Ciranka's avatar
Ciranka committed
1714
```
1715
1716
1717
1718
1719


# Arbitrary choice Exploration
```{r}
Plot_datAll%>%
1720
  mutate(Criterion=case_when((sample==1 & sig>38)~1,TRUE~0)
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
  )%>%mutate(newCum=cumsum(Criterion))%>%
  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"
    )
  )%>%filter(!is.na(Stage) & trials %in% round(seq(50,1200,length.out = 24)))%>%
  ggplot(aes(x=trials,y=explore2))+
1737
1738
1739
 # stat_summary(geom="ribbon", fun.data="mean_sdl",alpha=0.2)+
  #stat_summary(geom="line",fun.y = "mean",color="black")+
  geom_jitter(size=2,alpha=.5,color=wes_palette("Darjeeling1")[1])+
1740
1741
1742
  #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)+
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
  geom_spline(size=3)+
  stat_summary(geom="pointrange",fun.data="mean_cl_boot",color="black",fill="white",size=1,shape=23)+
  #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]))+
1754
  #scale_fill_brewer(name="Developmental Stage",labels=c("Kids","Adolescents","Adults"),palette = "YlGnBu")+
1755
1756
  coord_cartesian(ylim=c(0,55),xlim=c(0,1150))+
  scale_y_continuous(name="Exploration")+
1757
  scale_x_continuous(name="trials")+
1758
1759
1760
  guides(linetype=F)+
  theme_minimal(16)+
  ggtitle("Sample Where Agents is Uncertain")+
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
  theme_minimal(14)





%>%
  ggplot(aes(x=trials,y=sig,color=iter))+
  geom_point()
  #stat_summary()
```