Commit 1e2e9098 authored by Simon Ciranka's avatar Simon Ciranka
Browse files

added latest probabilistic sims and new figures

parent 57c72c28
No preview for this file type
......@@ -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,10 +71,123 @@ 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.
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment