Commit 7af6d6ac authored by Ciranka's avatar Ciranka

now its the right model code my friends

parent 0655500b
......@@ -368,7 +368,7 @@ MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%mutate(
delta=abs(as.numeric(as.character(PercentBlueShownRel))*100-as.numeric(PercentBlueEstimate))
)%>%ggplot(aes(x=delta,y=(HowSure),color=Agegroup,group=Agegroup))+
#geom_point()+
stat_summary(geom="point",fun.y = "mean",position="dodge")+
stat_summary(geom="point",fun.y = "mean",position="dodge",alpha=0.3)+
stat_smooth(method="lm")+
scale_color_viridis_d(name="Agegroup",breaks=c("0","1","2"),labels=c("Pre Adol","Adol","Young Adult"),option = "D")+
#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))+
......@@ -388,8 +388,10 @@ MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%mutate(
# Models
I outsourced Modelfitting to the tardis
Here i fit a first model for ALL subjects We should look at the stuff with distributional assumptions afterwards, but judging superficially, there is nothing much going on agetrend wise.
Here i fit a model that assumes different hyperdistributions for age groups.
We can look at it indivdually later on but i think this can provide a good first look. First i need to concatanete the subject parameters.
For this I need to retrieve the real Values at some point.
......@@ -523,7 +525,7 @@ In what follows i Show yu the mean of the parameter Estiamtes. This all makes s
Younger participants follow advice stronger, not only risky but also safe advice. There is no adolecent peak but always seemingly linear effects.
#Learning Scaling: p
A lot of values are close to 0. Maybe we should talk about the boundaries for this parameter. Even if the exponent is negative, it will only approximate 0, but never get negative in itself so mathematically it would still make sense but we would allow subjects to be EVEN MORE UNCERTAIN. I mean, thats reasonable?
```{r}
library(lme4)
#lm(MeanAlphaAdd~age,data=PosteriorMean)
......@@ -541,7 +543,7 @@ ggplot(PosteriorMean,aes(x=Group,y=MeanAlphaAdd))+
#lm(meanTau~poly(age,2),data=PosteriorMean)
ggplot(PosteriorMean,aes(x=Group,y=MeanRho))+
geom_jitter(aes(color=Group))+
geom_jitter(aes(color=Group),alpha=0.3)+
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)
......@@ -553,7 +555,7 @@ ggplot(PosteriorMean,aes(x=Group,y=MeanRho))+
#lm(meanTau~poly(age,2),data=PosteriorMean)
ggplot(PosteriorMean,aes(x=Group,y=meanTau))+
geom_jitter(aes(color=Group))+
geom_jitter(aes(color=Group),alpha=0.3)+
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"))
```
......@@ -564,8 +566,8 @@ ggplot(PosteriorMean,aes(x=Group,y=meanTau))+
#lm(meanOcuR~poly(age,2),data=PosteriorMean)
ggplot(PosteriorMean,aes(x=Group,meanOCURiskR))+
geom_jitter(aes(color=Group),alpha=0.3)+
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)
```
......@@ -577,8 +579,8 @@ ggplot(PosteriorMean,aes(x=Group,meanOCURiskR))+
ggplot(PosteriorMean,aes(x=Group,meanOCURiskUnc))+
geom_jitter(aes(color=Group),alpha=0.3)+
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)
```
......@@ -589,8 +591,8 @@ ggplot(PosteriorMean,aes(x=Group,meanOCURiskUnc))+
#lm(meanOcuR~poly(age,2),data=PosteriorMean)
ggplot(PosteriorMean,aes(x=Group,meanOCUSafeR))+
geom_jitter(aes(color=Group),alpha=0.3)+
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)
```
......@@ -602,21 +604,21 @@ ggplot(PosteriorMean,aes(x=Group,meanOCUSafeR))+
#lm(meanOcuR~poly(age,2),data=PosteriorMean)
ggplot(PosteriorMean,aes(x=Group,meanOCUSafeUnc))+
geom_jitter(aes(color=Group),alpha=0.3)+
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?
The smaller alpha, the more uncertainty, the more social influence.
```{r}
#lm(meanOcuR~poly(age,2),data=PosteriorMean)
ggplot(PosteriorMean,aes(x=TotalInfluenceUnc,y = MeanAlphaAdd))+
geom_point(aes(color=Group),alpha=0.3)+
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)+
geom_smooth(method="lm")+geom_hline(aes(yintercept=1),linetype="dotdash",alpha=0.2)+
ggtitle("Social Influence And Uncertainty")
```
\ No newline at end of file
This diff is collapsed.
......@@ -300,7 +300,7 @@ MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%mutate(
delta=abs(as.numeric(as.character(PercentBlueShownRel))*100-as.numeric(PercentBlueEstimate))
)%>%ggplot(aes(x=delta,y=(HowSure),color=Agegroup,group=Agegroup))+
#geom_point()+
stat_summary(geom="point",fun.y = "mean",position="dodge")+
stat_summary(geom="point",fun.y = "mean",position="dodge",alpha=0.3)+
stat_smooth(method="lm")+
scale_color_viridis_d(name="Agegroup",breaks=c("0","1","2"),labels=c("Pre Adol","Adol","Young Adult"),option = "D")+
#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))+
......@@ -322,7 +322,9 @@ MarbleData%>%filter(DFE1DFD0=="1"&PercentBlueEstimate!="NULL")%>%mutate(
Models
======
I outsourced Modelfitting to the tardis Here i fit a first model for ALL subjects We should look at the stuff with distributional assumptions afterwards, but judging superficially, there is nothing much going on agetrend wise. We can look at it indivdually later on but i think this can provide a good first look. First i need to concatanete the subject parameters. For this I need to retrieve the real Values at some point.
I outsourced Modelfitting to the tardis Here i fit a model that assumes different hyperdistributions for age groups.
We can look at it indivdually later on but i think this can provide a good first look. First i need to concatanete the subject parameters. For this I need to retrieve the real Values at some point.
``` r
ModelParamsFull=list()
......@@ -454,6 +456,8 @@ In what follows i Show yu the mean of the parameter Estiamtes. This all makes se
Learning Scaling: p
===================
A lot of values are close to 0. Maybe we should talk about the boundaries for this parameter. Even if the exponent is negative, it will only approximate 0, but never get negative in itself so mathematically it would still make sense but we would allow subjects to be EVEN MORE UNCERTAIN. I mean, thats reasonable?
``` r
library(lme4)
```
......@@ -489,7 +493,7 @@ Reward Sensitvity
#lm(meanTau~poly(age,2),data=PosteriorMean)
ggplot(PosteriorMean,aes(x=Group,y=MeanRho))+
geom_jitter(aes(color=Group))+
geom_jitter(aes(color=Group),alpha=0.3)+
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)
......@@ -504,7 +508,7 @@ Stochastizity?
#lm(meanTau~poly(age,2),data=PosteriorMean)
ggplot(PosteriorMean,aes(x=Group,y=meanTau))+
geom_jitter(aes(color=Group))+
geom_jitter(aes(color=Group),alpha=0.3)+
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"))
```
......@@ -518,8 +522,8 @@ OCU Risk Decisions from Description
#lm(meanOcuR~poly(age,2),data=PosteriorMean)
ggplot(PosteriorMean,aes(x=Group,meanOCURiskR))+
geom_jitter(aes(color=Group),alpha=0.3)+
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)
```
......@@ -534,8 +538,8 @@ OCU Risk Decisions from Experience
ggplot(PosteriorMean,aes(x=Group,meanOCURiskUnc))+
geom_jitter(aes(color=Group),alpha=0.3)+
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)
```
......@@ -549,8 +553,8 @@ OCU Safe Decisions from Description
#lm(meanOcuR~poly(age,2),data=PosteriorMean)
ggplot(PosteriorMean,aes(x=Group,meanOCUSafeR))+
geom_jitter(aes(color=Group),alpha=0.3)+
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)
```
......@@ -564,8 +568,8 @@ OCU Safe Decisions from Experience
#lm(meanOcuR~poly(age,2),data=PosteriorMean)
ggplot(PosteriorMean,aes(x=Group,meanOCUSafeUnc))+
geom_jitter(aes(color=Group),alpha=0.3)+
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)
```
......@@ -575,14 +579,16 @@ ggplot(PosteriorMean,aes(x=Group,meanOCUSafeUnc))+
Social Influence and Learning?
==============================
The smaller alpha, the more uncertainty, the more social influence.
``` r
#lm(meanOcuR~poly(age,2),data=PosteriorMean)
ggplot(PosteriorMean,aes(x=TotalInfluenceUnc,y = MeanAlphaAdd))+
geom_point(aes(color=Group),alpha=0.3)+
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)+
geom_smooth(method="lm")+geom_hline(aes(yintercept=1),linetype="dotdash",alpha=0.2)+
ggtitle("Social Influence And Uncertainty")
```
......
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