Skip to content

GitLab

B
BayesianLearning
Commit a609bf53 authored by Simon Ciranka's avatar Simon Ciranka
Browse files
Options

Added new Report

parent 845037f4
Show whitespace changes
Inline Side-by-side
Showing with 78 additions and 32 deletions
Developing_Marbles/A_RawData/TidyMarble_JointTask copy.R
View file @ a609bf53
......@@ -34,7 +34,7 @@ MarbleDataTibble%>%mutate(
#this is actually really cool
MarbleDataTibble[keeps] %>% # check what i want to keep
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
# check what i want to keep
......@@ -54,7 +54,7 @@ tbl1 %>%
# the same happens here for Social Choices
MarbleDataTibble[keeps] %>% # check what i want to keep
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
Subs<-unique(tbl2$subject)
......@@ -168,6 +168,9 @@ MarbleDataTibble%>%mutate(
)->MarbleDataTibble
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)
MarbleDataTibble[MarbleDataTibble$test_part=="SoloChoiceMarble",]$test_part="SoloChoice"
Sub153<-MarbleDataTibble[MarbleDataTibble$startTime==starttimes[length(starttimes)],]
Sub169<-MarbleDataTibble[MarbleDataTibble$startTime==starttimes2[length(starttimes2)],]
MarbleDataTibble=MarbleDataTibble[MarbleDataTibble$subject!=153,]
MarbleDataTibble=rbind(MarbleDataTibble,Sub153)
MarbleDataTibble=MarbleDataTibble[MarbleDataTibble$subject!=169,]
MarbleDataTibble=rbind(MarbleDataTibble,Sub169)
MarbleDataTibble$startTime=as.Date(MarbleDataTibble$startTime)
#this is actually really cool
MarbleDataTibble[keeps] %>% # check what i want to keep
......
Developing_Marbles/Analyze.Rmd
View file @ a609bf53
......@@ -20,6 +20,7 @@ source('../../../R/Helpers/R_rainclouds.R')
# Agenda
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.
......@@ -136,6 +137,7 @@ MarbleData%>%ggplot(aes(y=ChooseRisk,x=Agegroup,group=DFE1DFD0))+stat_summary(ma
coord_cartesian(ylim=c(0.3,0.6))+
scale_y_continuous(name="p Risky Choice")+
ggtitle("Risky Choice")
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
```
# 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.
......@@ -237,7 +268,7 @@ 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")+
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_color_viridis_d(name="Agegroup",breaks=c("0","1","2"),labels=c("Pre Adolescence","Adolescence","Young Adults"))+
scale_x_discrete(name="Actual Distribution")+
......@@ -304,17 +335,17 @@ labels <- c(
)
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)))+
stat_summary(geom="bar",fun.y = "mean",position="dodge")+
#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))+
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))
ggtitle(" Estimation Error and Confidence")#+coord_cartesian(ylim=c(10,30))
```
......@@ -337,15 +368,16 @@ labels <- c(
MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%mutate(
delta=abs(as.numeric(PercentBlueShownRel)-PercentBlueEstimate)
)%>%ggplot(aes(x=PercentBlueEstimate,y=HowSure))+
delta=abs(as.numeric(as.character(PercentBlueShownRel))*100-PercentBlueEstimate)
)%>%ggplot(aes(x=delta,y=HowSure))+
#geom_point()+
stat_summary(geom="point",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))+
#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="Estimate")+
scale_x_continuous(name="Estimation Error")+
scale_y_continuous(name="Confidence")
```
......@@ -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}}
$$
# Parameter Estimates
In what follows i Show yu the mean of the parameter Estiamtes.
#Alpha Scaling: p
```{r}
library(lme4)
#lm(MeanAlphaAdd~age,data=PosteriorMean)
......@@ -506,6 +540,7 @@ ggplot(PosteriorMean,aes(x=Group,y=MeanAlphaAdd))+
```
#Beta Scaling: q
```{r}
ggplot(PosteriorMean,aes(x=Group,MeanBetaAdd))+
......@@ -545,7 +580,7 @@ ggplot(PosteriorMean,aes(x=Group,y=meanTau))+
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))+
# 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)
```
......@@ -558,7 +593,7 @@ ggplot(PosteriorMean,aes(x=Group,meanOCURiskR))+
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))+
#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)
```
......@@ -570,7 +605,7 @@ ggplot(PosteriorMean,aes(x=Group,meanOCURiskUnc))+
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))+
#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)
```
......@@ -583,12 +618,13 @@ ggplot(PosteriorMean,aes(x=Group,meanOCUSafeR))+
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))+
#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)
......
Developing_Marbles/README.md
View file @ a609bf53
......@@ -20,6 +20,7 @@ Simon
- [The Learning Model](#the-learning-model)
- [The Value Model](#the-value-model)
- [The Choice Model](#the-choice-model)
- [Parameter Estimates](#parameter-estimates)
- [Alpha Scaling: p](#alpha-scaling-p)
- [Beta Scaling: q](#beta-scaling-q)
- [Reward Sensitvity](#reward-sensitvity)
......@@ -33,7 +34,7 @@ Simon
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
===========
......@@ -156,7 +157,7 @@ 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")+
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_color_viridis_d(name="Agegroup",breaks=c("0","1","2"),labels=c("Pre Adolescence","Adolescence","Young Adults"))+
scale_x_discrete(name="Actual Distribution")+
......@@ -234,17 +235,17 @@ labels <- c(
)
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)))+
stat_summary(geom="bar",fun.y = "mean",position="dodge")+
#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))+
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))
ggtitle(" Estimation Error and Confidence")#+coord_cartesian(ylim=c(10,30))
```
![](Analyze_files/figure-markdown_github/unnamed-chunk-8-1.png)
......@@ -264,22 +265,21 @@ labels <- c(
MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%mutate(
delta=abs(as.numeric(PercentBlueShownRel)-PercentBlueEstimate)
)%>%ggplot(aes(x=PercentBlueEstimate,y=HowSure))+
delta=abs(as.numeric(as.character(PercentBlueShownRel))*100-PercentBlueEstimate)
)%>%ggplot(aes(x=delta,y=HowSure))+
#geom_point()+
stat_summary(geom="point",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))+
#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="Estimate")+
scale_x_continuous(name="Estimation Error")+
scale_y_continuous(name="Confidence")
```
## 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)
Models
......@@ -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}}
$$
\# Parameter Estimates
Parameter Estimates
===================
In what follows i Show yu the mean of the parameter Estiamtes.
......@@ -497,7 +499,7 @@ OCU Risk Decisions from Description
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))+
# 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)
```
......@@ -513,7 +515,7 @@ OCU Risk Decisions from Experience
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))+
#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)
```
......@@ -528,7 +530,7 @@ OCU Safe Decisions from Description
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))+
#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)
```
......@@ -543,7 +545,7 @@ OCU Safe Decisions from Experience
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))+
#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)
```
......
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