added latest probabilistic sims and new figures

B_AnalysisCode/AdaptiveAdolescentrProject.Rmd

@@ -34,7 +34,7 @@ Specificly i re sample the reward if it is over 120. Now, as you may see below,
 I am not really happy with that because now, the normative solution is to seek out variance and the story about risk taking is that there is no such normative solution isnt it? 
 
 ```{r fig.width=12,fig.height=6}
-
+library("viridis")
 envirionmentMeanKids=seq(-50,50,length.out=5)#define the range of kid envirionemt
 envirionmentVarianceKids=seq(1,10,length.out=5)
 EnvirionemntKids=expand.grid(Mean=envirionmentMeanKids,Variance=envirionmentVarianceKids)# we sample from this later
@@ -47,28 +47,23 @@ EnvirionemntAdol%>%ungroup()
 
 EnvirionemntAdol%>%dplyr::rowwise()%>%mutate(value=rnorm(1,mean = Mean,sd=Variance))%>%
   ggplot(aes(x=Mean,y=Variance,fill=value))+geom_tile()+
-  scale_fill_distiller(name="Outcome",palette = "Spectral",trans = "reverse")+
+  scale_fill_viridis(name="Outcome",option="plasma",direction = -1)+
   geom_hline(aes(yintercept=40),size=2)+
   geom_vline(aes(xintercept=0),size=2)+
   annotate("text",x=50,y=38,label=c("Low Risk / Reward"))+
   annotate("text",x=-50,y=38,label=c("Low Risk / Loss"))+
   annotate("text",x=50,y=42,label=c("High Risk / Reward"))+
   annotate("text",x=-50,y=42,label=c("High Risk / Loss"))+
-  ggtitle("Adolescent Environment")+theme_cowplot()->Adolescent
+  ggtitle("Adolescent Environment")+theme_minimal()+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())->Adolescent
 
 
 EnvirionemntAdol%>%dplyr::rowwise()%>%mutate(value=rnorm(1,mean = Mean,sd=Variance))%>%
   ggplot(aes(x=Mean,y=Variance,fill=value,alpha=Mean>-46&Variance<40&Mean<46))+geom_tile()+
-  scale_fill_distiller(name="Outcome",palette = "Spectral",trans = "reverse")+
-  scale_alpha_discrete(range = c(0.2, 1))+
+  scale_fill_viridis(name="Outcome",option="plasma",direction = -1)+
+  scale_alpha_discrete(range = c(1, 0.6))+
   geom_hline(aes(yintercept=40),size=2)+
   geom_vline(aes(xintercept=0),size=2)+
-  annotate("text",x=50,y=38,label=c("Low Risk / Reward"))+
-  annotate("text",x=-50,y=38,label=c("Low Risk / Loss"))+
-  annotate("text",x=50,y=42,label=c("High Risk / Reward"))+
-  annotate("text",x=-50,y=42,label=c("High Risk / Loss"))+
-  guides(alpha=F)+
-  ggtitle("Kids Environment")+theme_cowplot()->Kid
+  guides(alpha=F)+theme_minimal()+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())->Kid
 
 legend=cowplot::get_legend(Kid)
 cowplot::plot_grid(Kid+theme(legend.position="none"),
@@ -76,11 +71,124 @@ cowplot::plot_grid(Kid+theme(legend.position="none"),
                                     axis.title.y = element_text(colour="white")),
                    legend,ncol =3,rel_widths = c(1,1,0.2))
 
+ggsave(plot=Kid,filename = "/X_Figures/Environment_new2.png")
+
 ggsave(filename = "../X_Figures/Environments.png")
 ```
 
+```{r, fig.width=5,fig.height=5}
+x=-300:300
+
+  tibble(y=dnorm(x,mean=100,sd=80),
+                 x=x)%>%
+  ggplot(aes(y=y,x=x,color=x>0))+geom_line(size=3)+
+    scale_y_continuous(name="probability")+
+    scale_x_continuous(name="Outcome value")+
+    scale_color_discrete(name="Outcome",breaks=c("TRUE","FALSE"),labels=c("Loss","Win"))+
+    theme_cowplot()+theme(axis.text.y = element_blank(),
+                          panel.border = element_rect(colour = "black", fill=NA, size=2),
+                          legend.position = c(0.75,0.8))
+  ggsave("../X_Figures/HighRiskHighRew.png",dpi=300,height = 5,width = 5)
+  
+    tibble(y=dnorm(x,mean=100,sd=10),
+                 x=x)%>%
+ggplot(aes(y=y,x=x,color=x>0))+geom_line(size=3)+
+    scale_y_continuous(name="probability")+
+    scale_x_continuous(name="Outcome value")+
+    scale_color_discrete(name="Outcome",breaks=c("TRUE","FALSE"),labels=c("Loss","Win"))+
+    theme_cowplot()+theme(axis.text.y = element_blank(),
+                          panel.border = element_rect(colour = "black", fill=NA, size=2),
+                          legend.position = c(0.75,0.8))
+  ggsave("../X_Figures/LowRiskHighRew.png",dpi=300,height = 5,width = 5)
+
+      tibble(y=dnorm(x,mean=-100,sd=80),
+                 x=x)%>%
+  ggplot(aes(y=y,x=x,color=x>0))+geom_line(size=3)+
+    scale_y_continuous(name="probability")+
+    scale_x_continuous(name="Outcome value")+
+    scale_color_discrete(name="Outcome",breaks=c("TRUE","FALSE"),labels=c("Loss","Win"))+
+    theme_cowplot()+theme(axis.text.y = element_blank(),
+                          panel.border = element_rect(colour = "black", fill=NA, size=2),
+                          legend.position = c(0.75,0.8))
+  ggsave("../X_Figures/HighRiskLowRew.png",dpi=300,height = 5,width = 5)
+
+    tibble(y=dnorm(x,mean=-100,sd=10),
+                 x=x)%>%
+ggplot(aes(y=y,x=x,color=x>0))+geom_line(size=3)+
+    scale_y_continuous(name="probability")+
+    scale_x_continuous(name="Outcome value")+
+    scale_color_discrete(name="Outcome",breaks=c("TRUE","FALSE"),labels=c("Loss","Win"))+
+    theme_cowplot()+theme(axis.text.y = element_blank(),
+                          panel.border = element_rect(colour = "black", fill=NA, size=2),
+                          legend.position = c(0.75,0.8))
+  ggsave("../X_Figures/LowRiskLowRew.png",dpi=300,height = 5,width = 5)
+
+```
 
 
+# Bayes update
+```{r}
+library(viridis)
+x=-20:50
+NormalSamples=tibble(values=rnorm(20,mean=25,sd=6))
+
+rbind(
+tibble(y=dnorm(x,mean=20,sd=10),x=x)%>%mutate(type="1"),
+tibble(y=dnorm(x,mean=25,sd=6),x=x)%>%mutate(type="2")
+)%>%
+ggplot()+
+  geom_line(aes(y=y,x=x,color=type),size=3)+
+  scale_color_viridis_d(name="",option="plasma")+
+  #scale_alpha_discrete(range=c(0.4,1))+
+  geom_dotplot(data = NormalSamples,aes(x=values,color="3"),fill="#F1F592",binwidth = 1,dotsize = 1.5)+
+  #scale_fill_viridis()+
+  coord_cartesian(ylim=c(0,0.15))+
+  theme_cowplot(20)+
+  theme(axis.line.y=element_blank(),
+        axis.title.y =element_blank(),
+        axis.text.y =element_blank(),
+        axis.ticks.y=element_blank()
+        )->Posterior
+
+rbind(
+tibble(y=dnorm(x,mean=20,sd=10),x=x)%>%mutate(type="1")
+#tibble(y=dnorm(x,mean=25,sd=3),x=x)%>%mutate(type="Posterior")
+)%>%
+ggplot()+
+  geom_line(aes(y=y,x=x,color=type),size=3)+
+  scale_color_viridis_d(name="",option="plasma")+
+  #geom_dotplot(data = NormalSamples,aes(x=values,color="Observations (Likelihood)"),fill="grey",binwidth = 1,dotsize = 1.5)+
+  #scale_fill_viridis()+
+  theme_cowplot(20)+
+  coord_cartesian(ylim=c(0,0.15))+
+  theme(axis.line.y=element_blank(),
+        axis.title.y =element_blank(),
+        axis.text.y =element_blank(),
+        axis.ticks.y=element_blank()
+        )->Prior
+
+rbind(
+tibble(y=dnorm(x,mean=20,sd=10),x=x)%>%mutate(type="1")
+#tibble(y=dnorm(x,mean=25,sd=3),x=x)%>%mutate(type="Posterior")
+)%>%
+ggplot()+
+  geom_line(aes(y=y,x=x,color=type),size=3)+
+  scale_color_viridis_d(name="",option="plasma")+
+  geom_dotplot(data = NormalSamples,aes(x=values,color="2"),fill="#F1F592",binwidth = 1,dotsize = 1.5)+
+  #scale_fill_viridis()+
+  coord_cartesian(ylim=c(0,0.15))+theme_cowplot(20)+
+  theme(axis.line.y=element_blank(),
+        axis.title.y =element_blank(),
+        axis.text.y =element_blank(),
+        axis.ticks.y=element_blank()
+        )->Outcomes
+
+ggsave(plot=Posterior,filename="../X_Figures/Posterior.png",dpi=330)
+ggsave(plot=Outcomes,filename="../X_Figures/Outcomes.png",dpi=330)
+ggsave(plot=Prior,filename="../X_Figures/Prior.png",dpi=330)
+
+```
+
 # load the kalman filter and the UCB rule
 Here i define the kalman filter and the choice rule.
 The Kalman Agent explores the bandits by representing their mean reward rate and its uncertainty about that mean. Both, beliefs about the mean reward rate and uncertainty about that belief are updated every iteration after observing a new outcome. The Agents behavior can be gouverend by 3 parameters: 
@@ -110,7 +218,7 @@ bayesianMeanTracker <- function(x, y, theta, prevPost=NULL,mu0Par,var0Par){
   allopts<-expand.grid(1:12, 1:12)
   chosen <- which(allopts$Var1==x[1] & allopts$Var2==x[2])
   #Kalman gain
-  kGain <- predictions$sig[chosen] / (predictions$sig[chosen] + EnvirionemntAdol$Variance[chosen]^2)# feed the uncertainty in here.
+  kGain <- predictions$sig[chosen] / (predictions$sig[chosen] + 360)#EnvirionemntAdol$Variance[chosen]^2)# feed the uncertainty in here.
   #update mean
   predictions$mu[chosen] <- predictions$mu[chosen] + (kGain * (y-predictions$mu[chosen]))
   #update variance for observed arm
@@ -157,7 +265,7 @@ beta<-0# this scales risk attitude.
 #get tau
 tau<-0.8
 mu0<-100#exploration bonus
-var0<-5
+var0<-80
 #create a parameter vector
 parVec <- c(lambda, lambda, 1, .0001) 
 #
@@ -392,6 +500,8 @@ for( i in 1:length(unique(newExp$trials))){
 
 saveRDS(newExp,"Derivatives_TrialWise.rds")
 # to compute the derivative
+#newExp<-readRDS("Derivatives_TrialWise.rds")
+
 ```
 
 # Plot
@@ -435,6 +545,7 @@ newExp%>%ungroup()%>%
   ggtitle("Exploration -> Solo")+
   guides(linetype=F)+
   theme_cowplot()
+
 ggsave("../X_Figures/TimecourseExplore.png",width=7,height=4)
 ```
 # Area under the curve