first model based analyiss

.gitignore

@@ -3,3 +3,4 @@
 *.RData
 *.Ruserdata
 .Rproj.user
+*.rds
\ No newline at end of file

Developing_Marbles/A_RawData/TidyMarble_JointTask copy.R

@@ -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",
          "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
 MarbleDataTibble<-as_tibble(MarbleData)
 

Developing_Marbles/Analyze.Rmd

@@ -66,28 +66,28 @@ Lets check it.
 MarbleData%>%group_by(subject)%>%mutate(
   FinalPayoff=max(cumulatedPayoff)
 )%>%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)+
   scale_x_discrete(name="Agegroup",breaks=c(0,1,2),labels=c("Kids","Adolescents","Adults"))+
   scale_y_continuous(name="Final Payoff (Bonuspoints)")+
   coord_cartesian(ylim=c(1975,2025))+
   guides(alpha=F)
-  #facet_grid(.~Social1Ind0)
-  ggtitle("Points Collected by Agegroup")
-  
-  
-  
-  
-  MarbleData%>%group_by(subject)%>%filter(Social1Ind0==0)%>%mutate(
+#facet_grid(.~Social1Ind0)
+ggtitle("Points Collected by Agegroup")
+
+
+
+
+MarbleData%>%group_by(subject)%>%filter(Social1Ind0==0)%>%mutate(
   FinalPayoff=max(cumulatedPayoff)
 )%>%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)+
   scale_x_discrete(name="Agegroup",breaks=c(0,1,2),labels=c("Kids","Adolescents","Adults"))+
   scale_y_continuous(name="Final Payoff (Bonuspoints)")
- # coord_cartesian(ylim=c(1800,2000))
-  #guides(alpha=F)
-  ggsave(filename = "X_Figures/Winner.pdf")
+# coord_cartesian(ylim=c(1800,2000))
+#guides(alpha=F)
+ggsave(filename = "X_Figures/Winner.pdf")
 ```
 
 lol. Adolescents. This is going to be interesting.
@@ -112,8 +112,8 @@ labels2 <- c(
 )
 # 
 MarbleData%>%group_by(Agegroup,DFE1DFD0,Social1Ind0)%>%summarise(
- PercentRiskyChoice=mean(ChooseRisk),
- ci=1.96*sd(ChooseRisk)/sqrt(dplyr::n())
+  PercentRiskyChoice=mean(ChooseRisk),
+  ci=1.96*sd(ChooseRisk)/sqrt(dplyr::n())
 )%>%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
   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.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)+
   facet_grid(.~Social1Ind0,
              labeller = labeller(Social1Ind0 = labels)
-           #  OtherChoseRisk=labels2
+             #  OtherChoseRisk=labels2
   )+
   coord_cartesian(ylim=c(0.3,0.6))+
   scale_y_continuous(name="p Risky Choice")+
@@ -142,18 +142,18 @@ ggsave(filename ="X_Figures/RawData.pdf",height = 6,width=10)
 
 # maybe
 MarbleData%>%group_by(Agegroup,DFE1DFD0,Social1Ind0)%>%summarise(
- PercentRiskyChoice=mean(ChooseRisk),
-ci=sd(ChooseRisk)/sqrt(n())
+  PercentRiskyChoice=mean(ChooseRisk),
+  ci=sd(ChooseRisk)/sqrt(n())
 )%>%ungroup()%>%group_by(Agegroup,DFE1DFD0)%>%filter(Social1Ind0==0)->Solo
 
 Solo$Diff<-Social$PercentRiskyChoice-Solo$PercentRiskyChoice
 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")+
   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.
 
 ```{r}
 
-MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%ggplot(aes(x=PercentBlueShownRel,y=PercentBlueEstimate,fill=Agegroup))+
-  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))+
+MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%ggplot()+
+  #stat_summary(geom="bar",fun.y = "mean",position="dodge")+
+  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_y_continuous(name="Participants Estimate")+
-  coord_cartesian(ylim=c(30,70))+
+  #coord_cartesian(ylim=c(30,70))+
   ggtitle("Estimation Accuracy")
 
 ```
@@ -299,18 +303,18 @@ labels <- c(
   "2" = "Adults"
 )
 
-MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%mutate(
-  SquaredError=(as.numeric(PercentBlueEstimate) - as.numeric(PercentBlueShownRel))
-)%>%ggplot(aes(x=SquaredError,y=as.numeric(HowSure)))+
-  stat_summary(geom="point",fun.y = "mean",position="dodge")+
+MarbleData%>%filter(PercentBlueEstimate!="NULL")%>%mutate(
+  Error=(as.numeric(PercentBlueEstimate) - as.numeric(PercentBlueShownRel))
+)%>%ggplot(aes(x=Agegroup,y=as.numeric(Error)))+
+  stat_summary(geom="bar",fun.y = "mean",position="dodge")+
   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))+
-  facet_grid(.~Agegroup,
-             labeller = labeller(Agegroup = labels)
-  )+
-  scale_x_continuous(name=" Estimation Error")+
-  scale_y_continuous(name="Confidence")+
-  ggtitle(" Estimation Error and Confidence")
+  #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,
+  #           labeller = labeller(Agegroup = labels)
+  #)+
+  scale_x_discrete(name=" Agegroup")+
+  scale_y_continuous(name="Estimation Error")+
+  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
 For this I need to retrieve the real Values at some point.
 
 ```{r}
-
-load("C_ModelFits/FullLearningModel")
-Parameters<-(rstan::extract(fitSep))
-library(tidyverse)
-
-#Bin_Update_Data<-Bin_Update_Data[Bin_Update_Data$typeRA=="1",]# keep only The Risk trails.
-Bin_Update_Data<-MarbleData%>%arrange(Agegroup)# i order it first so i can make sure that 
-Agegroups<-unique(Bin_Update_Data$Age.bins)# for indexing my agegroups.
-
-#make it fit with my stan file.
-Bin_Update_Data<-Bin_Update_Data%>%dplyr::mutate(
-  OtherChoseRisk = case_when(
-    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
-    OtherChoseRisk=="0" ~ 1,# safe choices are coded as 1 in my stan code
-    TRUE~0 # keep the rest.
-  )
-)#end PeerChoice.
-#subset it to fit on only one agegroup. 
-#Bin_Update_Data%>%filter(Agegroup==2)->Bin_Update_Data
-#Bin_Update_Data%>%filter(DFE1DFD0==0)->Bin_Update_Data
-
-# now check how many participants we have.
-Bin_Update_Data$subject<-as.numeric(Bin_Update_Data$subject)
-#change colname of subject into subjID
-numSubjs<-length(unique(Bin_Update_Data$subject))#Total Number of Subs
-subjList <- unique(Bin_Update_Data$subject)######
-
-ageList<-Bin_Update_Data%>%group_by(subject)%>%dplyr::summarize(
-  age=mean(age)
-)%>%select(age)%>%ungroup()
-
-ageList=as.vector(ageList$age)
-
-
-confList<-Bin_Update_Data%>%filter(HowSure!=102)%>%group_by(subject)%>%dplyr::summarise(
- Confidence=mean(HowSure)
+ModelParamsFull=list()
+subCount=1
+for (j in 1:length(unique(MarbleData$Agegroup))){
+  
+  fitSep<-readRDS(paste0("C_ModelFits/Marbles_Model_3Age_",j,".rds"))
+  Parameters<-(rstan::extract(fitSep))
+  library(tidyverse)
+  
+  #Bin_Update_Data<-Bin_Update_Data[Bin_Update_Data$typeRA=="1",]# keep only The Risk trails.
+  Bin_Update_Data<-MarbleData%>%arrange(Agegroup)# i order it first so i can make sure that 
+  Agegroups<-unique(Bin_Update_Data$Age.bins)# for indexing my agegroups.
+  
+  #make it fit with my stan file.
+  Bin_Update_Data<-Bin_Update_Data%>%dplyr::mutate(
+    OtherChoseRisk = case_when(
+      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
+      OtherChoseRisk=="0" ~ 1,# safe choices are coded as 1 in my stan code
+      TRUE~0 # keep the rest.
+    )
+  )#end PeerChoice.
+  #subset it to fit on only one agegroup. 
+  #Bin_Update_Data%>%filter(Agegroup==2)->Bin_Update_Data
+  #Bin_Update_Data%>%filter(DFE1DFD0==0)->Bin_Update_Data
+  
+  # now check how many participants we have.
+  Bin_Update_Data$subject<-as.numeric(Bin_Update_Data$subject)
+  #change colname of subject into subjID
+  numSubjs<-length(unique(Bin_Update_Data$subject))#Total Number of Subs
+  subjList <- unique(Bin_Update_Data$subject)######
+  ageList<-Bin_Update_Data%>%group_by(subject)%>%dplyr::summarize(
+    age=mean(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=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.
@@ -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.
 
 
-```{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}
-PosteriorMean<-big_data%>%group_by(subject,age,conf)%>%dplyr::summarise(
+PosteriorMean<-big_data%>%dplyr::group_by(subject,age,conf)%>%dplyr::summarise(
   MeanAlphaAdd=mean(alphaAdd),
   MeanBetaAdd=mean(betaAdd),
   MeanRho=mean(rho),
   meanTau=mean(tau),
-  meanOcuR=mean(ocuRisk),
-  meanOCUUnc=mean(ocuUncertainty)
+  meanOCURiskR=mean(ocuriskRisk),
+  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.
 #Alpha Scaling: p
 ```{r}
 library(lme4)
-lm(MeanAlphaAdd~age,data=PosteriorMean)
+#lm(MeanAlphaAdd~age,data=PosteriorMean)
 
-ggplot(PosteriorMean,aes(x=age,y=MeanAlphaAdd))+
-geom_point()+geom_smooth(method="lm")
+ggplot(PosteriorMean,aes(x=Group,y=MeanAlphaAdd))+
+  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
 ```{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))+
-geom_jitter()+geom_smooth(method="lm")
+#Reward Sensitvity
+
+```{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}
-lm(MeanRho~poly(age,2),data=PosteriorMean)
+#lm(meanOcuR~poly(age,2),data=PosteriorMean)
 
-ggplot(PosteriorMean,aes(x=age,MeanRho))+
-geom_point()+geom_smooth(method="lm")
+ggplot(PosteriorMean,aes(x=Group,meanOCURiskR))+
+  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}
-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}
-lm(meanOcuR~poly(age,2),data=PosteriorMean)
+#lm(meanOcuR~poly(age,2),data=PosteriorMean)
 
-ggplot(PosteriorMean,aes(x=age,meanOcuR))+
-geom_point()+geom_smooth(method="lm")
+ggplot(PosteriorMean,aes(x=Group,meanOCUSafeR))+
+  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}
-lm(meanOCUUnc~poly(age,2),data=PosteriorMean)
+#lm(meanOcuR~poly(age,2),data=PosteriorMean)
 
-ggplot(PosteriorMean,aes(x=conf,y=meanOCUUnc))+
-geom_point()+geom_smooth(method="lm")
+ggplot(PosteriorMean,aes(x=Group,meanOCUSafeUnc))+
+  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

Developing_Marbles/README.md

@@ -22,6 +22,13 @@ Simon
     -   [The Choice Model](#the-choice-model)
 -   [Alpha Scaling: p](#alpha-scaling-p)
 -   [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
 ======
@@ -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.
 
 ``` r
-MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%ggplot(aes(x=PercentBlueShownRel,y=PercentBlueEstimate,fill=Agegroup))+
-  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))+
+MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%ggplot()+
+  #stat_summary(geom="bar",fun.y = "mean",position="dodge")+
+  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_y_continuous(name="Participants Estimate")+
-  coord_cartesian(ylim=c(30,70))+
+  #coord_cartesian(ylim=c(30,70))+
   ggtitle("Estimation Accuracy")
 ```
 
+    ## No summary function supplied, defaulting to `mean_se()
+
 ![](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.
@@ -220,24 +233,20 @@ labels <- c(
   "2" = "Adults"
 )
 
-MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%mutate(
-  SquaredError=(as.numeric(PercentBlueEstimate) - as.numeric(PercentBlueShownRel))
-)%>%ggplot(aes(x=SquaredError,y=as.numeric(HowSure)))+
-  stat_summary(geom="point",fun.y = "mean",position="dodge")+
+MarbleData%>%filter(PercentBlueEstimate!="NULL")%>%mutate(
+  Error=(as.numeric(PercentBlueEstimate) - as.numeric(PercentBlueShownRel))
+)%>%ggplot(aes(x=Agegroup,y=as.numeric(Error)))+
+  stat_summary(geom="bar",fun.y = "mean",position="dodge")+
   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))+
-  facet_grid(.~Agegroup,
+  #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,