Commit 845037f4 authored by Simon Ciranka's avatar Simon Ciranka

first model based analyiss

parent 990f82b2
...@@ -3,3 +3,4 @@ ...@@ -3,3 +3,4 @@
*.RData *.RData
*.Ruserdata *.Ruserdata
.Rproj.user .Rproj.user
*.rds
\ No newline at end of file
This diff is collapsed.
...@@ -155,7 +155,7 @@ keeps<-c("startTime","rt","key_press","riskyKey","red_marbles","blue_marbles", ...@@ -155,7 +155,7 @@ keeps<-c("startTime","rt","key_press","riskyKey","red_marbles","blue_marbles",
"OtherChoseRisk","ChooseRisk","valueGamble","probGamble","Social1Ind0","payoff","cumulatedPayoff","valueSure","trialID","PercentBlueEstimate", "OtherChoseRisk","ChooseRisk","valueGamble","probGamble","Social1Ind0","payoff","cumulatedPayoff","valueSure","trialID","PercentBlueEstimate",
"HowSure","test_part","sex","age","subject","subjectNumber") "HowSure","test_part","sex","age","subject","subjectNumber")
MarbleData<-read.csv2("A_RawData/MarbleOCU_vlabNew.csv") MarbleData<-read.csv("A_RawData/MarbleOCU_vlabNew.csv")
colnames(MarbleData)<-names colnames(MarbleData)<-names
MarbleDataTibble<-as_tibble(MarbleData) MarbleDataTibble<-as_tibble(MarbleData)
......
...@@ -66,28 +66,28 @@ Lets check it. ...@@ -66,28 +66,28 @@ Lets check it.
MarbleData%>%group_by(subject)%>%mutate( MarbleData%>%group_by(subject)%>%mutate(
FinalPayoff=max(cumulatedPayoff) FinalPayoff=max(cumulatedPayoff)
)%>%ggplot(aes(x=Agegroup,y=FinalPayoff,alpha=Agegroup))+ )%>%ggplot(aes(x=Agegroup,y=FinalPayoff,alpha=Agegroup))+
stat_summary(geom="bar",fun.y="mean")+ stat_summary(geom="bar",fun.y="mean")+
stat_summary(geom="pointrange",fun.y=mean,fun.ymin =function(x) mean(x)-1.96*(sd(x)/sqrt(length(x))),fun.ymax=function(x) mean(x)+1.96*(sd(x)/sqrt(length(x))),position = position_dodge(0.9),alpha=0.7)+ stat_summary(geom="pointrange",fun.y=mean,fun.ymin =function(x) mean(x)-1.96*(sd(x)/sqrt(length(x))),fun.ymax=function(x) mean(x)+1.96*(sd(x)/sqrt(length(x))),position = position_dodge(0.9),alpha=0.7)+
scale_x_discrete(name="Agegroup",breaks=c(0,1,2),labels=c("Kids","Adolescents","Adults"))+ scale_x_discrete(name="Agegroup",breaks=c(0,1,2),labels=c("Kids","Adolescents","Adults"))+
scale_y_continuous(name="Final Payoff (Bonuspoints)")+ scale_y_continuous(name="Final Payoff (Bonuspoints)")+
coord_cartesian(ylim=c(1975,2025))+ coord_cartesian(ylim=c(1975,2025))+
guides(alpha=F) guides(alpha=F)
#facet_grid(.~Social1Ind0) #facet_grid(.~Social1Ind0)
ggtitle("Points Collected by Agegroup") ggtitle("Points Collected by Agegroup")
MarbleData%>%group_by(subject)%>%filter(Social1Ind0==0)%>%mutate( MarbleData%>%group_by(subject)%>%filter(Social1Ind0==0)%>%mutate(
FinalPayoff=max(cumulatedPayoff) FinalPayoff=max(cumulatedPayoff)
)%>%ggplot(aes(x=Agegroup,y=FinalPayoff,alpha=Agegroup))+ )%>%ggplot(aes(x=Agegroup,y=FinalPayoff,alpha=Agegroup))+
stat_summary(geom="bar",fun.y="mean")+ stat_summary(geom="bar",fun.y="mean")+
stat_summary(geom="pointrange",fun.y=mean,fun.ymin =function(x) mean(x)-1.96*(sd(x)/sqrt(length(x))),fun.ymax=function(x) mean(x)+1.96*(sd(x)/sqrt(length(x))),position = position_dodge(0.9),alpha=0.7)+ stat_summary(geom="pointrange",fun.y=mean,fun.ymin =function(x) mean(x)-1.96*(sd(x)/sqrt(length(x))),fun.ymax=function(x) mean(x)+1.96*(sd(x)/sqrt(length(x))),position = position_dodge(0.9),alpha=0.7)+
scale_x_discrete(name="Agegroup",breaks=c(0,1,2),labels=c("Kids","Adolescents","Adults"))+ scale_x_discrete(name="Agegroup",breaks=c(0,1,2),labels=c("Kids","Adolescents","Adults"))+
scale_y_continuous(name="Final Payoff (Bonuspoints)") scale_y_continuous(name="Final Payoff (Bonuspoints)")
# coord_cartesian(ylim=c(1800,2000)) # coord_cartesian(ylim=c(1800,2000))
#guides(alpha=F) #guides(alpha=F)
ggsave(filename = "X_Figures/Winner.pdf") ggsave(filename = "X_Figures/Winner.pdf")
``` ```
lol. Adolescents. This is going to be interesting. lol. Adolescents. This is going to be interesting.
...@@ -112,8 +112,8 @@ labels2 <- c( ...@@ -112,8 +112,8 @@ labels2 <- c(
) )
# #
MarbleData%>%group_by(Agegroup,DFE1DFD0,Social1Ind0)%>%summarise( MarbleData%>%group_by(Agegroup,DFE1DFD0,Social1Ind0)%>%summarise(
PercentRiskyChoice=mean(ChooseRisk), PercentRiskyChoice=mean(ChooseRisk),
ci=1.96*sd(ChooseRisk)/sqrt(dplyr::n()) ci=1.96*sd(ChooseRisk)/sqrt(dplyr::n())
)%>%ungroup()%>%group_by(Agegroup,DFE1DFD0)%>%filter(Social1Ind0==1)->Social )%>%ungroup()%>%group_by(Agegroup,DFE1DFD0)%>%filter(Social1Ind0==1)->Social
...@@ -127,11 +127,11 @@ MarbleData%>%ggplot(aes(y=ChooseRisk,x=Agegroup,group=DFE1DFD0))+stat_summary(ma ...@@ -127,11 +127,11 @@ MarbleData%>%ggplot(aes(y=ChooseRisk,x=Agegroup,group=DFE1DFD0))+stat_summary(ma
geom_hline(mapping=aes(yintercept=0.4),linetype="dotted",alpha=0.4)+ geom_hline(mapping=aes(yintercept=0.4),linetype="dotted",alpha=0.4)+
geom_hline(mapping=aes(yintercept=0.55),linetype="dotted",alpha=0.2)+ geom_hline(mapping=aes(yintercept=0.55),linetype="dotted",alpha=0.2)+
geom_hline(mapping=aes(yintercept=0.35),linetype="dotted",alpha=0.2)+ geom_hline(mapping=aes(yintercept=0.35),linetype="dotted",alpha=0.2)+
geom_hline(mapping=aes(yintercept=0.6),linetype="dotted",alpha=0.1)+ geom_hline(mapping=aes(yintercept=0.6),linetype="dotted",alpha=0.1)+
geom_hline(mapping=aes(yintercept=0.3),linetype="dotted",alpha=0.1)+ geom_hline(mapping=aes(yintercept=0.3),linetype="dotted",alpha=0.1)+
facet_grid(.~Social1Ind0, facet_grid(.~Social1Ind0,
labeller = labeller(Social1Ind0 = labels) labeller = labeller(Social1Ind0 = labels)
# OtherChoseRisk=labels2 # OtherChoseRisk=labels2
)+ )+
coord_cartesian(ylim=c(0.3,0.6))+ coord_cartesian(ylim=c(0.3,0.6))+
scale_y_continuous(name="p Risky Choice")+ scale_y_continuous(name="p Risky Choice")+
...@@ -142,18 +142,18 @@ ggsave(filename ="X_Figures/RawData.pdf",height = 6,width=10) ...@@ -142,18 +142,18 @@ ggsave(filename ="X_Figures/RawData.pdf",height = 6,width=10)
# maybe # maybe
MarbleData%>%group_by(Agegroup,DFE1DFD0,Social1Ind0)%>%summarise( MarbleData%>%group_by(Agegroup,DFE1DFD0,Social1Ind0)%>%summarise(
PercentRiskyChoice=mean(ChooseRisk), PercentRiskyChoice=mean(ChooseRisk),
ci=sd(ChooseRisk)/sqrt(n()) ci=sd(ChooseRisk)/sqrt(n())
)%>%ungroup()%>%group_by(Agegroup,DFE1DFD0)%>%filter(Social1Ind0==0)->Solo )%>%ungroup()%>%group_by(Agegroup,DFE1DFD0)%>%filter(Social1Ind0==0)->Solo
Solo$Diff<-Social$PercentRiskyChoice-Solo$PercentRiskyChoice Solo$Diff<-Social$PercentRiskyChoice-Solo$PercentRiskyChoice
Solo%>%ggplot(aes(y=Diff,fill=DFE1DFD0,x=Agegroup))+geom_bar(stat="identity",position = "dodge",color= "black")+ Solo%>%ggplot(aes(y=Diff,fill=DFE1DFD0,x=Agegroup))+geom_bar(stat="identity",position = "dodge",color= "black")+
scale_x_discrete(name="Agegroup",breaks=c(0,1,2),labels=c("Kids","Adolescents","Adults"))+ scale_x_discrete(name="Agegroup",breaks=c(0,1,2),labels=c("Kids","Adolescents","Adults"))+
geom_errorbar( mapping=aes(y=Diff, ymin=Diff-ci, ymax=Diff+ci),position="dodge")+ geom_errorbar( mapping=aes(y=Diff, ymin=Diff-ci, ymax=Diff+ci),position="dodge")+
scale_y_continuous(name="Mean Difference Social Solo")+ scale_y_continuous(name="Mean Difference Social Solo")+
scale_fill_discrete(name="Social Condition",breaks=c(0,1),labels=c("Risk","Uncertainty")) scale_fill_discrete(name="Social Condition",breaks=c(0,1),labels=c("Risk","Uncertainty"))
``` ```
...@@ -233,12 +233,16 @@ these distributions. For this i treat the real distributions as factors. ...@@ -233,12 +233,16 @@ these distributions. For this i treat the real distributions as factors.
```{r} ```{r}
MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%ggplot(aes(x=PercentBlueShownRel,y=PercentBlueEstimate,fill=Agegroup))+ MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%ggplot()+
stat_summary(geom="bar",fun.y = "mean",position="dodge")+ #stat_summary(geom="bar",fun.y = "mean",position="dodge")+
stat_summary(geom="pointrange",fun.y=mean,fun.ymin =function(x) mean(x)-(sd(x)/sqrt(length(x))),fun.ymax=function(x) mean(x)+(sd(x)/sqrt(length(x))),position = position_dodge(0.9))+ stat_summary(aes(x=PercentBlueShownRel,y=PercentBlueEstimate,color=Agegroup),geom="pointrange",fun.y=mean,fun.ymin =function(x) mean(x)-(sd(x)/sqrt(length(x))),fun.ymax=function(x) mean(x)+(sd(x)/sqrt(length(x))),position = position_dodge(0.9))+
stat_summary(aes(y=as.numeric(PercentBlueShownRel)*10,x=PercentBlueShownRel),geom="pointrange",position = position_dodge(0.9),shape=3,color="red")+
scale_shape_manual(name="Distribution as Seen by Participant")+
scale_color_viridis_d(name="Agegroup",breaks=c("0","1","2"),labels=c("Pre Adolescence","Adolescence","Young Adults"))+
scale_x_discrete(name="Actual Distribution")+ scale_x_discrete(name="Actual Distribution")+
scale_y_continuous(name="Participants Estimate")+ scale_y_continuous(name="Participants Estimate")+
coord_cartesian(ylim=c(30,70))+ #coord_cartesian(ylim=c(30,70))+
ggtitle("Estimation Accuracy") ggtitle("Estimation Accuracy")
``` ```
...@@ -299,18 +303,18 @@ labels <- c( ...@@ -299,18 +303,18 @@ labels <- c(
"2" = "Adults" "2" = "Adults"
) )
MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%mutate( MarbleData%>%filter(PercentBlueEstimate!="NULL")%>%mutate(
SquaredError=(as.numeric(PercentBlueEstimate) - as.numeric(PercentBlueShownRel)) Error=(as.numeric(PercentBlueEstimate) - as.numeric(PercentBlueShownRel))
)%>%ggplot(aes(x=SquaredError,y=as.numeric(HowSure)))+ )%>%ggplot(aes(x=Agegroup,y=as.numeric(Error)))+
stat_summary(geom="point",fun.y = "mean",position="dodge")+ stat_summary(geom="bar",fun.y = "mean",position="dodge")+
stat_smooth(method="loess")+ stat_smooth(method="loess")+
stat_summary(geom="pointrange",fun.y=mean,fun.ymin =function(x) mean(x)-(sd(x)/sqrt(length(x))),fun.ymax=function(x) mean(x)+(sd(x)/sqrt(length(x))),position = position_dodge(0.9))+ #stat_summary(geom="pointrange",fun.y=mean,fun.ymin =function(x) mean(x)-(sd(x)/sqrt(length(x))),fun.ymax=function(x) mean(x)+(sd(x)/sqrt(length(x))),position = position_dodge(0.9))+
facet_grid(.~Agegroup, #facet_grid(.~Agegroup,
labeller = labeller(Agegroup = labels) # labeller = labeller(Agegroup = labels)
)+ #)+
scale_x_continuous(name=" Estimation Error")+ scale_x_discrete(name=" Agegroup")+
scale_y_continuous(name="Confidence")+ scale_y_continuous(name="Estimation Error")+
ggtitle(" Estimation Error and Confidence") ggtitle(" Estimation Error and Confidence")+coord_cartesian(ylim=c(50,40))
``` ```
...@@ -360,45 +364,71 @@ We can look at it indivdually later on but i think this can provide a good first ...@@ -360,45 +364,71 @@ We can look at it indivdually later on but i think this can provide a good first
For this I need to retrieve the real Values at some point. For this I need to retrieve the real Values at some point.
```{r} ```{r}
ModelParamsFull=list()
load("C_ModelFits/FullLearningModel") subCount=1
Parameters<-(rstan::extract(fitSep)) for (j in 1:length(unique(MarbleData$Agegroup))){
library(tidyverse)
fitSep<-readRDS(paste0("C_ModelFits/Marbles_Model_3Age_",j,".rds"))
#Bin_Update_Data<-Bin_Update_Data[Bin_Update_Data$typeRA=="1",]# keep only The Risk trails. Parameters<-(rstan::extract(fitSep))
Bin_Update_Data<-MarbleData%>%arrange(Agegroup)# i order it first so i can make sure that library(tidyverse)
Agegroups<-unique(Bin_Update_Data$Age.bins)# for indexing my agegroups.
#Bin_Update_Data<-Bin_Update_Data[Bin_Update_Data$typeRA=="1",]# keep only The Risk trails.
#make it fit with my stan file. Bin_Update_Data<-MarbleData%>%arrange(Agegroup)# i order it first so i can make sure that
Bin_Update_Data<-Bin_Update_Data%>%dplyr::mutate( Agegroups<-unique(Bin_Update_Data$Age.bins)# for indexing my agegroups.
OtherChoseRisk = case_when(
OtherChoseRisk=="NULL" ~ 2,# i dont need this but i restricted the numbers in stan between 1 and 3 #make it fit with my stan file.
OtherChoseRisk=="1" ~ 3,# risky choices are coded as 3 in my stan code Bin_Update_Data<-Bin_Update_Data%>%dplyr::mutate(
OtherChoseRisk=="0" ~ 1,# safe choices are coded as 1 in my stan code OtherChoseRisk = case_when(
TRUE~0 # keep the rest. OtherChoseRisk=="NULL" ~ 2,# i dont need this but i restricted the numbers in stan between 1 and 3
) OtherChoseRisk=="1" ~ 3,# risky choices are coded as 3 in my stan code
)#end PeerChoice. OtherChoseRisk=="0" ~ 1,# safe choices are coded as 1 in my stan code
#subset it to fit on only one agegroup. TRUE~0 # keep the rest.
#Bin_Update_Data%>%filter(Agegroup==2)->Bin_Update_Data )
#Bin_Update_Data%>%filter(DFE1DFD0==0)->Bin_Update_Data )#end PeerChoice.
#subset it to fit on only one agegroup.
# now check how many participants we have. #Bin_Update_Data%>%filter(Agegroup==2)->Bin_Update_Data
Bin_Update_Data$subject<-as.numeric(Bin_Update_Data$subject) #Bin_Update_Data%>%filter(DFE1DFD0==0)->Bin_Update_Data
#change colname of subject into subjID
numSubjs<-length(unique(Bin_Update_Data$subject))#Total Number of Subs # now check how many participants we have.
subjList <- unique(Bin_Update_Data$subject)###### Bin_Update_Data$subject<-as.numeric(Bin_Update_Data$subject)
#change colname of subject into subjID
ageList<-Bin_Update_Data%>%group_by(subject)%>%dplyr::summarize( numSubjs<-length(unique(Bin_Update_Data$subject))#Total Number of Subs
age=mean(age) subjList <- unique(Bin_Update_Data$subject)######
)%>%select(age)%>%ungroup() ageList<-Bin_Update_Data%>%group_by(subject)%>%dplyr::summarize(
age=mean(age)
ageList=as.vector(ageList$age) )%>%select(age)%>%ungroup()
ageList=as.vector(ageList$age)
confList<-Bin_Update_Data%>%filter(HowSure!=102)%>%group_by(subject)%>%dplyr::summarise(
Confidence=mean(HowSure)
confList<-Bin_Update_Data%>%filter(HowSure!=102)%>%group_by(subject)%>%dplyr::summarise(
Confidence=mean(HowSure)
) )
confList=as.vector(confList$Confidence) confList=as.vector(confList$Confidence)
datalist = list()
for(i in 1:dim(Parameters$alpha_add)[2]){
df=data.frame(
alphaAdd=as.vector(Parameters$alpha_add[,i]),
betaAdd=as.vector(Parameters$beta_add[,i]),
rho=as.vector(Parameters$rho[,i]),
tau=as.vector(Parameters$tau[,i]),
ocusafeRisk=as.vector(Parameters$ocu_safe_Risk[,i]),
ocusafeUncertainty=as.vector(Parameters$ocu_safe_Uncertainty[,i]),
ocuriskRisk=as.vector(Parameters$ocu_risk_Risk[,i]),
ocuriskUncertainty=as.vector(Parameters$ocu_risk_Uncertainty[,i]),
subject=subjList[subCount],
age=ageList[subCount],# Here i need to get some kind of dictionary.
conf=confList[subCount]
)
subCount=subCount+1
datalist[[i]] <- df
}
ModelParamsFull[[j]] <- do.call(rbind, datalist)
}
big_data<-do.call(rbind, ModelParamsFull)
``` ```
In what follows i look at the Whole parameter Distributions. In what follows i look at the Whole parameter Distributions.
...@@ -408,35 +438,28 @@ In what follows i look at the Whole parameter Distributions. ...@@ -408,35 +438,28 @@ In what follows i look at the Whole parameter Distributions.
After i collect the fits, we can actually nicely concatenate them. After i collect the fits, we can actually nicely concatenate them.
```{r}
datalist = list()
for(i in 1:117){
df<-data.frame(
alphaAdd=as.vector(Parameters$alpha_add[,i]),
betaAdd=as.vector(Parameters$beta_add[,i]),
rho=as.vector(Parameters$rho[,i]),
tau=as.vector(Parameters$tau[,i]),
ocuRisk=as.vector(Parameters$ocu_Risk[,i]),
ocuUncertainty=as.vector(Parameters$ocu_Uncertainty[,i]),
subject=subjList[i],
age=ageList[i],# Here i need to get some kind of dictionary.
conf=confList[i]
)
datalist[[i]] <- df
}
big_data = do.call(rbind, datalist)
```
```{r} ```{r}
PosteriorMean<-big_data%>%group_by(subject,age,conf)%>%dplyr::summarise( PosteriorMean<-big_data%>%dplyr::group_by(subject,age,conf)%>%dplyr::summarise(
MeanAlphaAdd=mean(alphaAdd), MeanAlphaAdd=mean(alphaAdd),
MeanBetaAdd=mean(betaAdd), MeanBetaAdd=mean(betaAdd),
MeanRho=mean(rho), MeanRho=mean(rho),
meanTau=mean(tau), meanTau=mean(tau),
meanOcuR=mean(ocuRisk), meanOCURiskR=mean(ocuriskRisk),
meanOCUUnc=mean(ocuUncertainty) meanOCURiskUnc=mean(ocuriskUncertainty),
meanOCUSafeR=mean(ocusafeRisk),
meanOCUSafeUnc=mean(ocusafeUncertainty)
)%>%dplyr::mutate(
MeanBoth=(((MeanAlphaAdd+MeanBetaAdd)/2)),
TotalInfluenceUnc=abs(meanOCUSafeUnc+meanOCURiskUnc)/2,
TotalInfluenceRisk=abs(meanOCUSafeR+meanOCURiskR)/2,
#MeanBoth=(9^((MeanAlphaAdd+MeanBetaAdd)/2)),
Group=case_when(
age<13~"1",
(age>12 & age <19)~"2",
age>=19~"3"
#TRUE
)
) )
``` ```
...@@ -473,44 +496,106 @@ In what follows i Show yu the mean of the parameter Estiamtes. ...@@ -473,44 +496,106 @@ In what follows i Show yu the mean of the parameter Estiamtes.
#Alpha Scaling: p #Alpha Scaling: p
```{r} ```{r}
library(lme4) library(lme4)
lm(MeanAlphaAdd~age,data=PosteriorMean) #lm(MeanAlphaAdd~age,data=PosteriorMean)
ggplot(PosteriorMean,aes(x=age,y=MeanAlphaAdd))+ ggplot(PosteriorMean,aes(x=Group,y=MeanAlphaAdd))+
geom_point()+geom_smooth(method="lm") stat_summary(fun.data = "mean_se")+scale_x_discrete(name="Agegroup",breaks=c("1","2","3"),labels=c("Age 10-12","Age 13-18","Age >18"))+ geom_jitter(aes(color=Group))+
scale_color_viridis_d(name="Agegroup")+
stat_summary(fun.data = "mean_se")+scale_x_discrete(name="Agegroup",breaks=c("1","2","3"),labels=c("Age 10-12","Age 13-18","Age >18"))+
geom_hline(aes(yintercept=1),linetype="dotdash",alpha=0.2)#geom_jitter(aes(color=Group),alpha=0.1)+coord_cartesian(ylim=c(0.4,1))
``` ```
#Beta Scaling: q #Beta Scaling: q
```{r} ```{r}
ggplot(PosteriorMean,aes(x=Group,MeanBetaAdd))+
stat_summary(fun.data = "mean_se")+scale_x_discrete(name="Agegroup",breaks=c("1","2","3"),labels=c("Age 10-12","Age 13-18","Age >18"))+ geom_jitter(aes(color=Group))+
scale_color_viridis_d(name="Agegroup")+
stat_summary(fun.data = "mean_se")+scale_x_discrete(name="Agegroup",breaks=c("1","2","3"),labels=c("Age 10-12","Age 13-18","Age >18"))+
geom_hline(aes(yintercept=1),linetype="dotdash",alpha=0.2)#geom_jitter(aes(color=Group),alpha=0.1)+coord_cartesian(ylim=c(0.4,1))
```
ggplot(PosteriorMean,aes(x=age,y=MeanBetaAdd))+ #Reward Sensitvity
geom_jitter()+geom_smooth(method="lm")
```{r}
#lm(meanTau~poly(age,2),data=PosteriorMean)
ggplot(PosteriorMean,aes(x=Group,y=MeanRho))+
geom_jitter(aes(color=Group))+
scale_color_viridis_d(name="Agegroup")+
stat_summary(fun.data = "mean_se")+scale_x_discrete(name="Agegroup",breaks=c("1","2","3"),labels=c("Age 10-12","Age 13-18","Age >18"))+
geom_hline(aes(yintercept=1),linetype="dotdash",alpha=0.2)
```
#Stochastizity?
```{r}
#lm(meanTau~poly(age,2),data=PosteriorMean)
ggplot(PosteriorMean,aes(x=Group,y=meanTau))+
geom_jitter(aes(color=Group))+
scale_color_viridis_d(name="Agegroup")+
stat_summary(fun.data = "mean_se")+scale_x_discrete(name="Agegroup",breaks=c("1","2","3"),labels=c("Age 10-12","Age 13-18","Age >18"))
``` ```
# OCU Risk Decisions from Description
```{r} ```{r}
lm(MeanRho~poly(age,2),data=PosteriorMean) #lm(meanOcuR~poly(age,2),data=PosteriorMean)
ggplot(PosteriorMean,aes(x=age,MeanRho))+ ggplot(PosteriorMean,aes(x=Group,meanOCURiskR))+
geom_point()+geom_smooth(method="lm") stat_summary(fun.data = "mean_se")+scale_x_discrete(name="Agegroup",breaks=c("1","2","3"),labels=c("Age 10-12","Age 13-18","Age >18"))+
geom_jitter(aes(color=Group))+
scale_color_viridis_d(name="Agegroup")+
geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2)
``` ```
# OCU Risk Decisions from Experience
```{r} ```{r}
lm(meanTau~poly(age,2),data=PosteriorMean) #lm(meanOcuR~poly(age,2),data=PosteriorMean)
ggplot(PosteriorMean,aes(x=age,y=meanTau))+
geom_point()+geom_smooth(method="lm") ggplot(PosteriorMean,aes(x=Group,meanOCURiskUnc))+
stat_summary(fun.data = "mean_se")+scale_x_discrete(name="Agegroup",breaks=c("1","2","3"),labels=c("Age 10-12","Age 13-18","Age >18"))+
geom_jitter(aes(color=Group))+
scale_color_viridis_d(name="Agegroup")+
geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2)
``` ```
# OCU Safe Decisions from Description
```{r} ```{r}
lm(meanOcuR~poly(age,2),data=PosteriorMean) #lm(meanOcuR~poly(age,2),data=PosteriorMean)
ggplot(PosteriorMean,aes(x=age,meanOcuR))+ ggplot(PosteriorMean,aes(x=Group,meanOCUSafeR))+
geom_point()+geom_smooth(method="lm") stat_summary(fun.data = "mean_se")+scale_x_discrete(name="Agegroup",breaks=c("1","2","3"),labels=c("Age 10-12","Age 13-18","Age >18"))+
geom_jitter(aes(color=Group))+
scale_color_viridis_d(name="Agegroup")+
geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2)
``` ```
# OCU Safe Decisions from Experience
```{r} ```{r}
lm(meanOCUUnc~poly(age,2),data=PosteriorMean) #lm(meanOcuR~poly(age,2),data=PosteriorMean)
ggplot(PosteriorMean,aes(x=conf,y=meanOCUUnc))+ ggplot(PosteriorMean,aes(x=Group,meanOCUSafeUnc))+
geom_point()+geom_smooth(method="lm") stat_summary(fun.data = "mean_se")+scale_x_discrete(name="Agegroup",breaks=c("1","2","3"),labels=c("Age 10-12","Age 13-18","Age >18"))+
geom_jitter(aes(color=Group))+
scale_color_viridis_d(name="Agegroup")+
geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2)
``` ```
# Social Influence and Learning?
```{r}
#lm(meanOcuR~poly(age,2),data=PosteriorMean)
ggplot(PosteriorMean,aes(x=TotalInfluenceUnc,MeanBoth))+
stat_summary(fun.data = "mean_se")+#scale_x_continuous(name="SocialInfluence Uncertainty",breaks=c("1","2","3"),labels=c("Age 10-12","Age 13-18","Age >18"))+
geom_jitter(aes(color=Group))+
scale_color_viridis_d(name="Agegroup")+
geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2)+
ggtitle("Social Influence And Uncertainty")
```
\ No newline at end of file
...@@ -22,6 +22,13 @@ Simon ...@@ -22,6 +22,13 @@ Simon
- [The Choice Model](#the-choice-model) - [The Choice Model](#the-choice-model)
- [Alpha Scaling: p](#alpha-scaling-p) - [Alpha Scaling: p](#alpha-scaling-p)
- [Beta Scaling: q](#beta-scaling-q) - [Beta Scaling: q](#beta-scaling-q)
- [Reward Sensitvity](#reward-sensitvity)
- [Stochastizity?](#stochastizity)
- [OCU Risk Decisions from Description](#ocu-risk-decisions-from-description)
- [OCU Risk Decisions from Experience](#ocu-risk-decisions-from-experience)
- [OCU Safe Decisions from Description](#ocu-safe-decisions-from-description)
- [OCU Safe Decisions from Experience](#ocu-safe-decisions-from-experience)
- [Social Influence and Learning?](#social-influence-and-learning)
Agenda Agenda
====== ======
...@@ -145,15 +152,21 @@ How Good were they at Estimating? ...@@ -145,15 +152,21 @@ How Good were they at Estimating?
In the Decisions from Expierience trials we asked Pariticpants about what they thing the outcome Ditribution really was. So now see if there are age differnces in estimating these distributions. For this i treat the real distributions as factors. In the Decisions from Expierience trials we asked Pariticpants about what they thing the outcome Ditribution really was. So now see if there are age differnces in estimating these distributions. For this i treat the real distributions as factors.
``` r ``` r
MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%ggplot(aes(x=PercentBlueShownRel,y=PercentBlueEstimate,fill=Agegroup))+ MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%ggplot()+
stat_summary(geom="bar",fun.y = "mean",position="dodge")+ #stat_summary(geom="bar",fun.y = "mean",position="dodge")+
stat_summary(geom="pointrange",fun.y=mean,fun.ymin =function(x) mean(x)-(sd(x)/sqrt(length(x))),fun.ymax=function(x) mean(x)+(sd(x)/sqrt(length(x))),position = position_dodge(0.9))+ stat_summary(aes(x=PercentBlueShownRel,y=PercentBlueEstimate,color=Agegroup),geom="pointrange",fun.y=mean,fun.ymin =function(x) mean(x)-(sd(x)/sqrt(length(x))),fun.ymax=function(x) mean(x)+(sd(x)/sqrt(length(x))),position = position_dodge(0.9))+
stat_summary(aes(y=as.numeric(PercentBlueShownRel)*10,x=PercentBlueShownRel),geom="pointrange",position = position_dodge(0.9),shape=3,color="red")+
scale_shape_manual(name="Distribution as Seen by Participant")+
scale_color_viridis_d(name="Agegroup",breaks=c("0","1","2"),labels=c("Pre Adolescence","Adolescence","Young Adults"))+
scale_x_discrete(name="Actual Distribution")+ scale_x_discrete(name="Actual Distribution")+
scale_y_continuous(name="Participants Estimate")+ scale_y_continuous(name="Participants Estimate")+
coord_cartesian(ylim=c(30,70))+ #coord_cartesian(ylim=c(30,70))+
ggtitle("Estimation Accuracy") ggtitle("Estimation Accuracy")
``` ```
## No summary function supplied, defaulting to `mean_se()
![](Analyze_files/figure-markdown_github/unnamed-chunk-5-1.png) ![](Analyze_files/figure-markdown_github/unnamed-chunk-5-1.png)
Turns out they were accurate and captured the trends. While estimating similarly well, Children & Adolescents tended to be overoptimistic in their estimation. Is this a linear trend? This effect looks smaller with higher proportions of blue marbles. Participants also were all Optimistic for low probabilites and Pessimistic for high ones. Turns out they were accurate and captured the trends. While estimating similarly well, Children & Adolescents tended to be overoptimistic in their estimation. Is this a linear trend? This effect looks smaller with higher proportions of blue marbles. Participants also were all Optimistic for low probabilites and Pessimistic for high ones.
...@@ -220,24 +233,20 @@ labels <- c( ...@@ -220,24 +233,20 @@ labels <- c(
"2" = "Adults" "2" = "Adults"
) )
MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%mutate( MarbleData%>%filter(PercentBlueEstimate!="NULL")%>%mutate(
SquaredError=(as.numeric(PercentBlueEstimate) - as.numeric(PercentBlueShownRel)) Error=(as.numeric(PercentBlueEstimate) - as.numeric(PercentBlueShownRel))
)%>%ggplot(aes(x=SquaredError,y=as.numeric(HowSure)))+ )%>%ggplot(aes(x=Agegroup,y=as.numeric(Error)))+
stat_summary(geom="point",fun.y = "mean",position="dodge")+ stat_summary(geom="bar",fun.y = "mean",position="dodge")+
stat_smooth(method="loess")+ stat_smooth(method="loess")+
stat_summary(geom="pointrange",fun.y=mean,fun.ymin =function(x) mean(x)-(sd(x)/sqrt(length(x))),fun.ymax=function(x) mean(x)+(sd(x)/sqrt(length(x))),position = position_dodge(0.9))+ #stat_summary(geom="pointrange",fun.y=mean,fun.ymin =function(x) mean(x)-(sd(x)/sqrt(length(x))),fun.ymax=function(x) mean(x)+(sd(x)/sqrt(length(x))),position = position_dodge(0.9))+
facet_grid(.~Agegroup, #facet_grid(.~Agegroup,