Commit a609bf53 authored by Simon Ciranka's avatar Simon Ciranka

Added new Report

parent 845037f4
...@@ -34,7 +34,7 @@ MarbleDataTibble%>%mutate( ...@@ -34,7 +34,7 @@ MarbleDataTibble%>%mutate(
#this is actually really cool #this is actually really cool
MarbleDataTibble[keeps] %>% # check what i want to keep MarbleDataTibble[keeps] %>% # check what i want to keep
dplyr::filter(test_part=="SoloChoice" | test_part=="Solotrial" | test_part!="NULL") %>% dplyr::filter(test_part=="SoloChoice" | test_part=="Solotrial" | test_part!="NULL") %>%
dplyr::filter(subject %in% c(1:188))%>%# select only the parts I use for Dataanalysis dplyr::filter(subject %in% c(1:200))%>%# select only the parts I use for Dataanalysis
dplyr::filter(rt!="NULL")-> tbl1 dplyr::filter(rt!="NULL")-> tbl1
# check what i want to keep # check what i want to keep
...@@ -54,7 +54,7 @@ tbl1 %>% ...@@ -54,7 +54,7 @@ tbl1 %>%
# the same happens here for Social Choices # the same happens here for Social Choices
MarbleDataTibble[keeps] %>% # check what i want to keep MarbleDataTibble[keeps] %>% # check what i want to keep
dplyr::filter(test_part=="SocialChoice" | test_part=="SocialTrial" | test_part!="NULL") %>% dplyr::filter(test_part=="SocialChoice" | test_part=="SocialTrial" | test_part!="NULL") %>%
dplyr::filter(as.numeric(subject) %in% c(1:188))%>%# select only the parts I use for Dataanalysis dplyr::filter(as.numeric(subject) %in% c(1:200))%>%# select only the parts I use for Dataanalysis
dplyr::filter(rt!="NULL")-> tbl2 # check what i want to keep dplyr::filter(rt!="NULL")-> tbl2 # check what i want to keep
Subs<-unique(tbl2$subject) Subs<-unique(tbl2$subject)
...@@ -168,6 +168,9 @@ MarbleDataTibble%>%mutate( ...@@ -168,6 +168,9 @@ MarbleDataTibble%>%mutate(
)->MarbleDataTibble )->MarbleDataTibble
starttimes=unique(MarbleDataTibble[MarbleDataTibble$subject==153,]$startTime) starttimes=unique(MarbleDataTibble[MarbleDataTibble$subject==153,]$startTime)
starttimes2=unique(MarbleDataTibble[MarbleDataTibble$subject==169,]$startTime)
#starttimes3=unique(MarbleDataTibble[MarbleDataTibble$subject==159,]$startTime)
...@@ -178,8 +181,13 @@ MarbleDataTibble$test_part=as.character(MarbleDataTibble$test_part) ...@@ -178,8 +181,13 @@ MarbleDataTibble$test_part=as.character(MarbleDataTibble$test_part)
MarbleDataTibble[MarbleDataTibble$test_part=="SoloChoiceMarble",]$test_part="SoloChoice" MarbleDataTibble[MarbleDataTibble$test_part=="SoloChoiceMarble",]$test_part="SoloChoice"
Sub153<-MarbleDataTibble[MarbleDataTibble$startTime==starttimes[length(starttimes)],] Sub153<-MarbleDataTibble[MarbleDataTibble$startTime==starttimes[length(starttimes)],]
Sub169<-MarbleDataTibble[MarbleDataTibble$startTime==starttimes2[length(starttimes2)],]
MarbleDataTibble=MarbleDataTibble[MarbleDataTibble$subject!=153,] MarbleDataTibble=MarbleDataTibble[MarbleDataTibble$subject!=153,]
MarbleDataTibble=rbind(MarbleDataTibble,Sub153) MarbleDataTibble=rbind(MarbleDataTibble,Sub153)
MarbleDataTibble=MarbleDataTibble[MarbleDataTibble$subject!=169,]
MarbleDataTibble=rbind(MarbleDataTibble,Sub169)
MarbleDataTibble$startTime=as.Date(MarbleDataTibble$startTime) MarbleDataTibble$startTime=as.Date(MarbleDataTibble$startTime)
#this is actually really cool #this is actually really cool
MarbleDataTibble[keeps] %>% # check what i want to keep MarbleDataTibble[keeps] %>% # check what i want to keep
......
...@@ -20,6 +20,7 @@ source('../../../R/Helpers/R_rainclouds.R') ...@@ -20,6 +20,7 @@ source('../../../R/Helpers/R_rainclouds.R')
# Agenda # Agenda
TODO: Posterior predictives. TODO: Posterior predictives.
* I added a first model * I added a first model
* Fit a model not on the estimates but on the ditibutions as seen by the participants. How does this change estimates for rho? They will go up.
* no age correlations in any of the Parameters, which is wierd, I probably did not do it right * no age correlations in any of the Parameters, which is wierd, I probably did not do it right
* We are still waiting for 16 participants, But maybe we can already start thinking about this a little more * We are still waiting for 16 participants, But maybe we can already start thinking about this a little more
* Miniconference. * Miniconference.
...@@ -136,6 +137,7 @@ MarbleData%>%ggplot(aes(y=ChooseRisk,x=Agegroup,group=DFE1DFD0))+stat_summary(ma ...@@ -136,6 +137,7 @@ MarbleData%>%ggplot(aes(y=ChooseRisk,x=Agegroup,group=DFE1DFD0))+stat_summary(ma
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")+
ggtitle("Risky Choice") ggtitle("Risky Choice")
ggsave(filename ="X_Figures/RawData.pdf",height = 6,width=10) ggsave(filename ="X_Figures/RawData.pdf",height = 6,width=10)
# #
...@@ -155,6 +157,35 @@ Solo%>%ggplot(aes(y=Diff,fill=DFE1DFD0,x=Agegroup))+geom_bar(stat="identity",pos ...@@ -155,6 +157,35 @@ Solo%>%ggplot(aes(y=Diff,fill=DFE1DFD0,x=Agegroup))+geom_bar(stat="identity",pos
```
# Description Expierence Gap
IS REVERSED! By using representative samples, we squised the description expiereince gap.
```{r}
MarbleData%>%ggplot(aes(y=ChooseRisk,x=probGamble,group=interaction(DFE1DFD0,Social1Ind0)shape=Social1Ind0,linetype=Social1Ind0))+stat_summary(mapping=aes(color=DFE1DFD0,linetype=Social1Ind0),geom="line",fun.y = mean, size=3)+
#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))))+
#scale_x_discrete(name="Agegroup",breaks=c(0,1,2),labels=c("Kids","Adolescents","Adults"))+
scale_color_discrete(name="Uncertainty Condition",breaks=c(0,1),labels=c("Risk","Uncertainty"))+
geom_hline(mapping=aes(yintercept=0.45),linetype="dotdash")+
geom_hline(mapping=aes(yintercept=0.5),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.35),linetype="dotted",alpha=0.2)+
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(.~Agegroup
#labeller = labeller(Social1Ind0 = labels)
# OtherChoseRisk=labels2
)+
#coord_cartesian(ylim=c(0.3,0.6))+
scale_y_continuous(name="p Risky Choice")+
ggtitle("Risky Choice")
``` ```
# Within subject change. # Within subject change.
...@@ -237,7 +268,7 @@ MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%ggplot()+ ...@@ -237,7 +268,7 @@ 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(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(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")+ stat_summary(aes(y=as.numeric(as.character(PercentBlueShownRel))*100,x=PercentBlueShownRel),geom="pointrange",position = position_dodge(0.9),shape=3,color="red")+
scale_shape_manual(name="Distribution as Seen by Participant")+ 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_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")+
...@@ -304,17 +335,17 @@ labels <- c( ...@@ -304,17 +335,17 @@ labels <- c(
) )
MarbleData%>%filter(PercentBlueEstimate!="NULL")%>%mutate( MarbleData%>%filter(PercentBlueEstimate!="NULL")%>%mutate(
Error=(as.numeric(PercentBlueEstimate) - as.numeric(PercentBlueShownRel)) Error=abs((as.numeric(PercentBlueEstimate) - as.numeric(as.character(PercentBlueShownRel))*100))
)%>%ggplot(aes(x=Agegroup,y=as.numeric(Error)))+ )%>%ggplot(aes(x=Agegroup,y=as.numeric(Error)))+
stat_summary(geom="bar",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_discrete(name=" Agegroup")+ scale_x_discrete(name=" Agegroup")+
scale_y_continuous(name="Estimation Error")+ scale_y_continuous(name="Estimation Error")+
ggtitle(" Estimation Error and Confidence")+coord_cartesian(ylim=c(50,40)) ggtitle(" Estimation Error and Confidence")#+coord_cartesian(ylim=c(10,30))
``` ```
...@@ -337,15 +368,16 @@ labels <- c( ...@@ -337,15 +368,16 @@ labels <- c(
MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%mutate( MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%mutate(
delta=abs(as.numeric(PercentBlueShownRel)-PercentBlueEstimate) delta=abs(as.numeric(as.character(PercentBlueShownRel))*100-PercentBlueEstimate)
)%>%ggplot(aes(x=PercentBlueEstimate,y=HowSure))+ )%>%ggplot(aes(x=delta,y=HowSure))+
#geom_point()+
stat_summary(geom="point",fun.y = "mean",position="dodge")+ stat_summary(geom="point",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="Estimate")+ scale_x_continuous(name="Estimation Error")+
scale_y_continuous(name="Confidence") scale_y_continuous(name="Confidence")
``` ```
...@@ -489,11 +521,13 @@ The choice model takes the negative difference of these utilites $\Delta Ut$ and ...@@ -489,11 +521,13 @@ The choice model takes the negative difference of these utilites $\Delta Ut$ and
$$ $$
p_{ChooseRisk}=\frac{1}{1+e^{-\Delta Ut*\tau}} p_{ChooseRisk}=\frac{1}{1+e^{-\Delta Ut*\tau}}
$$ $$
# Parameter Estimates # Parameter Estimates
In what follows i Show yu the mean of the parameter Estiamtes. 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)
...@@ -506,6 +540,7 @@ ggplot(PosteriorMean,aes(x=Group,y=MeanAlphaAdd))+ ...@@ -506,6 +540,7 @@ ggplot(PosteriorMean,aes(x=Group,y=MeanAlphaAdd))+
``` ```
#Beta Scaling: q #Beta Scaling: q
```{r} ```{r}
ggplot(PosteriorMean,aes(x=Group,MeanBetaAdd))+ ggplot(PosteriorMean,aes(x=Group,MeanBetaAdd))+
...@@ -545,7 +580,7 @@ ggplot(PosteriorMean,aes(x=Group,y=meanTau))+ ...@@ -545,7 +580,7 @@ ggplot(PosteriorMean,aes(x=Group,y=meanTau))+
ggplot(PosteriorMean,aes(x=Group,meanOCURiskR))+ 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"))+ 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))+ # geom_jitter(aes(color=Group))+
scale_color_viridis_d(name="Agegroup")+ scale_color_viridis_d(name="Agegroup")+
geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2) geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2)
``` ```
...@@ -558,7 +593,7 @@ ggplot(PosteriorMean,aes(x=Group,meanOCURiskR))+ ...@@ -558,7 +593,7 @@ ggplot(PosteriorMean,aes(x=Group,meanOCURiskR))+
ggplot(PosteriorMean,aes(x=Group,meanOCURiskUnc))+ 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"))+ 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))+ #geom_jitter(aes(color=Group))+
scale_color_viridis_d(name="Agegroup")+ scale_color_viridis_d(name="Agegroup")+
geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2) geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2)
``` ```
...@@ -570,7 +605,7 @@ ggplot(PosteriorMean,aes(x=Group,meanOCURiskUnc))+ ...@@ -570,7 +605,7 @@ ggplot(PosteriorMean,aes(x=Group,meanOCURiskUnc))+
ggplot(PosteriorMean,aes(x=Group,meanOCUSafeR))+ 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"))+ 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))+ #geom_jitter(aes(color=Group))+
scale_color_viridis_d(name="Agegroup")+ scale_color_viridis_d(name="Agegroup")+
geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2) geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2)
``` ```
...@@ -583,12 +618,13 @@ ggplot(PosteriorMean,aes(x=Group,meanOCUSafeR))+ ...@@ -583,12 +618,13 @@ ggplot(PosteriorMean,aes(x=Group,meanOCUSafeR))+
ggplot(PosteriorMean,aes(x=Group,meanOCUSafeUnc))+ 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"))+ 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))+ #geom_jitter(aes(color=Group))+
scale_color_viridis_d(name="Agegroup")+ scale_color_viridis_d(name="Agegroup")+
geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2) geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2)
``` ```
# Social Influence and Learning? # Social Influence and Learning?
```{r} ```{r}
#lm(meanOcuR~poly(age,2),data=PosteriorMean) #lm(meanOcuR~poly(age,2),data=PosteriorMean)
......
...@@ -20,6 +20,7 @@ Simon ...@@ -20,6 +20,7 @@ Simon
- [The Learning Model](#the-learning-model) - [The Learning Model](#the-learning-model)
- [The Value Model](#the-value-model) - [The Value Model](#the-value-model)
- [The Choice Model](#the-choice-model) - [The Choice Model](#the-choice-model)
- [Parameter Estimates](#parameter-estimates)
- [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) - [Reward Sensitvity](#reward-sensitvity)
...@@ -33,7 +34,7 @@ Simon ...@@ -33,7 +34,7 @@ Simon
Agenda Agenda
====== ======
TODO: Posterior predictives. \* I added a first model \* no age correlations in any of the Parameters, which is wierd, I probably did not do it right \* We are still waiting for 16 participants, But maybe we can already start thinking about this a little more \* Miniconference. TODO: Posterior predictives. \* I added a first model \* Fit a model not on the estimates but on the ditibutions as seen by the participants. How does this change estimates for rho? They will go up. \* no age correlations in any of the Parameters, which is wierd, I probably did not do it right \* We are still waiting for 16 participants, But maybe we can already start thinking about this a little more \* Miniconference.
Marble Data Marble Data
=========== ===========
...@@ -156,7 +157,7 @@ MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%ggplot()+ ...@@ -156,7 +157,7 @@ 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(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(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")+ stat_summary(aes(y=as.numeric(as.character(PercentBlueShownRel))*100,x=PercentBlueShownRel),geom="pointrange",position = position_dodge(0.9),shape=3,color="red")+
scale_shape_manual(name="Distribution as Seen by Participant")+ 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_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")+
...@@ -234,17 +235,17 @@ labels <- c( ...@@ -234,17 +235,17 @@ labels <- c(
) )
MarbleData%>%filter(PercentBlueEstimate!="NULL")%>%mutate( MarbleData%>%filter(PercentBlueEstimate!="NULL")%>%mutate(
Error=(as.numeric(PercentBlueEstimate) - as.numeric(PercentBlueShownRel)) Error=abs((as.numeric(PercentBlueEstimate) - as.numeric(as.character(PercentBlueShownRel))*100))
)%>%ggplot(aes(x=Agegroup,y=as.numeric(Error)))+ )%>%ggplot(aes(x=Agegroup,y=as.numeric(Error)))+
stat_summary(geom="bar",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_discrete(name=" Agegroup")+ scale_x_discrete(name=" Agegroup")+
scale_y_continuous(name="Estimation Error")+ scale_y_continuous(name="Estimation Error")+
ggtitle(" Estimation Error and Confidence")+coord_cartesian(ylim=c(50,40)) ggtitle(" Estimation Error and Confidence")#+coord_cartesian(ylim=c(10,30))
``` ```
![](Analyze_files/figure-markdown_github/unnamed-chunk-8-1.png) ![](Analyze_files/figure-markdown_github/unnamed-chunk-8-1.png)
...@@ -264,22 +265,21 @@ labels <- c( ...@@ -264,22 +265,21 @@ labels <- c(
MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%mutate( MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%mutate(
delta=abs(as.numeric(PercentBlueShownRel)-PercentBlueEstimate) delta=abs(as.numeric(as.character(PercentBlueShownRel))*100-PercentBlueEstimate)
)%>%ggplot(aes(x=PercentBlueEstimate,y=HowSure))+ )%>%ggplot(aes(x=delta,y=HowSure))+
#geom_point()+
stat_summary(geom="point",fun.y = "mean",position="dodge")+ stat_summary(geom="point",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="Estimate")+ scale_x_continuous(name="Estimation Error")+
scale_y_continuous(name="Confidence") scale_y_continuous(name="Confidence")
``` ```
## Warning: Width not defined. Set with `position_dodge(width = ?)` ## Warning: Width not defined. Set with `position_dodge(width = ?)`
## Warning: Removed 13 rows containing missing values (geom_pointrange).
![](Analyze_files/figure-markdown_github/unnamed-chunk-9-1.png) ![](Analyze_files/figure-markdown_github/unnamed-chunk-9-1.png)
Models Models
...@@ -409,7 +409,9 @@ The choice model takes the negative difference of these utilites *Δ**U**t* and ...@@ -409,7 +409,9 @@ The choice model takes the negative difference of these utilites *Δ**U**t* and
$$ $$
p\_{ChooseRisk}=\\frac{1}{1+e^{-\\Delta Ut\*\\tau}} p\_{ChooseRisk}=\\frac{1}{1+e^{-\\Delta Ut\*\\tau}}
$$ $$
\# Parameter Estimates
Parameter Estimates
===================
In what follows i Show yu the mean of the parameter Estiamtes. In what follows i Show yu the mean of the parameter Estiamtes.
...@@ -497,7 +499,7 @@ OCU Risk Decisions from Description ...@@ -497,7 +499,7 @@ OCU Risk Decisions from Description
ggplot(PosteriorMean,aes(x=Group,meanOCURiskR))+ 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"))+ 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))+ # geom_jitter(aes(color=Group))+
scale_color_viridis_d(name="Agegroup")+ scale_color_viridis_d(name="Agegroup")+
geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2) geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2)
``` ```
...@@ -513,7 +515,7 @@ OCU Risk Decisions from Experience ...@@ -513,7 +515,7 @@ OCU Risk Decisions from Experience
ggplot(PosteriorMean,aes(x=Group,meanOCURiskUnc))+ 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"))+ 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))+ #geom_jitter(aes(color=Group))+
scale_color_viridis_d(name="Agegroup")+ scale_color_viridis_d(name="Agegroup")+
geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2) geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2)
``` ```
...@@ -528,7 +530,7 @@ OCU Safe Decisions from Description ...@@ -528,7 +530,7 @@ OCU Safe Decisions from Description
ggplot(PosteriorMean,aes(x=Group,meanOCUSafeR))+ 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"))+ 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))+ #geom_jitter(aes(color=Group))+
scale_color_viridis_d(name="Agegroup")+ scale_color_viridis_d(name="Agegroup")+
geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2) geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2)
``` ```
...@@ -543,7 +545,7 @@ OCU Safe Decisions from Experience ...@@ -543,7 +545,7 @@ OCU Safe Decisions from Experience
ggplot(PosteriorMean,aes(x=Group,meanOCUSafeUnc))+ 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"))+ 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))+ #geom_jitter(aes(color=Group))+
scale_color_viridis_d(name="Agegroup")+ scale_color_viridis_d(name="Agegroup")+
geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2) geom_smooth(method="lm")+geom_hline(aes(yintercept=0),linetype="dotdash",alpha=0.2)
``` ```
......
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