Commit 36a7b8a1 authored by Simon Ciranka's avatar Simon Ciranka
Browse files

include analysis/recovery code

parent 70e7564d
This diff is collapsed.
This diff is collapsed.
---
title: "Online"
author: "Simon"
date: "06/08/2020"
output:
html_document:
toc: true
code_folding: hide
---
```{r setup_onlineprob, include=FALSE}
pacman::p_load("tidyverse","DEoptim","cowplot","tidybayes","ggpubr","R.matlab","doParallel","foreach","GGally","viridis","ggbeeswarm")
source("../../../../../../R/Helpers/R_rainclouds.R")
# functions for fitting are hidden
source("A_Models/TI_Models.R")
source("A_Models/Fit_Parralel_negLR.R")
loadfromdisk=1
#####setup parralel
#cl <- makeCluster(35)
#registerDoParallel(cl)
#DEctrl <- DEoptim.control(trace=TRUE,parallelType=0,packages=c(),parVar=c())
#####
#loadfromdisk=0
set.seed(5)
SIMmodellist=list(Model1Sim,Model2Sim,Model3Sim,Model4Sim,Model5Sim,Model6Sim,Model7Sim,Model8Sim,Model9Sim,Model10Sim)
modellist=list(Model1,Model2,Model3,Model4,Model5,Model6,Model7,Model8,Model9,Model10)
modelnames_fig_title=c("Model I2",
"Model I1",
"Model I2t",
"Model I1t",
"Model P",
"Model Pt",
"Model I2t+P",
"Model I1t+P",
"Model I2t+P",
"Model I1t+Pi")
models=1:10
parameters=c(3,2,4,3,2,3,6,5,7,6)# number of parameters per model
asymParam=c(0,1,0,1,1,1,0,1,0,1)# which model is asymmetric (neeeded for fits and simulating)
modelnames_fig_axis=c("I2","I1","Ii2","Ii1","P","Pi","Ii2+P","Ii1+P","Ii2+Pi","Ii1+Pi")
###
### Define boundaries for fitting parameters
###
# ParamBoundaries=list()
# #Only Itemlevel Asym (A)
# ParamBoundaries[[1]]<-tibble(
# lb=c(0,0,0.1), # lower bounds
# ub=c(1,1,3) # upper bounds
# )
#
# #Only Itemlevel Sym (B)
# ParamBoundaries[[2]]<-tibble(
# lb=c(0,0.1), # lower bounds
# ub=c(1,3) # upper bounds
# )
#
# #Only Item TI Asym (C)
# ParamBoundaries[[3]]<-tibble(
# lb=c(0,0,0,0.1), # lower bounds
# ub=c(1,1,10,3) # upper bounds
# )
#
# #Only Item TI Sym (D)
# ParamBoundaries[[4]]<-tibble(
# lb=c(0,0,0.1), # lower bounds
# ub=c(1,10,3) # upper bounds
# )
#
# #Only Pairs (E)
# ParamBoundaries[[5]]<-tibble(
# lb=c(0,0.1), # lower bounds
# ub=c(2,3) # upper bounds
# )
#
# #Pair TI (F)
# ParamBoundaries[[6]]<-tibble(
# lb=c(0,0.1,0.1), # lower bounds
# ub=c(2,10,3) # upper bounds
# )
#
#
# # mixture Item TI & Pair _NO_ TI & ASYM learning rate for items (G)
# ParamBoundaries[[7]]<-tibble(
# lb=c(0,0,0,0,0.1,0.1), # lower bounds
# ub=c(1,1,10,2,3,3) # upper bounds
# )
#
# # mixture Item TI & Pair _NO_ TI & SYM learning rate for items (H)
# ParamBoundaries[[8]]<-tibble(
# lb=c(0,0,0,0.1,0.1), # lower bounds
# ub=c(1,10,2,3,3) # upper bounds
# )
#
# # mixture Item TI & Pair TI & ASYM learning rate for items (I)
# ParamBoundaries[[9]]<-tibble(
# lb=c(0,0,0,0,0.1,0.1,0.1), # lower bounds
# ub=c(1,1,10,2,10,3,3) # upper bounds
# )
#
# # mixture Item TI & Pair TI & SYM learning rate for items (J)
# ParamBoundaries[[10]]<-tibble(
# lb=c(0,0,0,0.1,0.1,0.1), # lower bounds
# ub=c(1,10,2,10,3,3) # upper bounds
# )
ParamNames=list(
c("lr1_up","lr2_down","noise_item"),
c("lr1_up","noise_item"),
c("lr1_up","lr2_down","TI","noise_item"),
c("lr1_up","TI","noise_item"),
c("lrPairs","noise_pair"),
c("lrPairs","Pairs_TI","noise_item","noise_pair"),
c("lr1_up","lr2_down","TI","lrPairs","noise_item","noise_pair"),
c("lr1_up","TI","lrPairs","noise_item","noise_pair"),
c("lr1_up","lr2_down","TI","lrPairs","Pairs_TI","noise_item","noise_pair"),
c("lr1_up","TI","lrPairs","Pairs_TI","noise_item","noise_pair")
)
```
This experiment was collected online but is the same as the EEG experiment.
```{r}
puppydata_TI_prob_online<-readMat("../../Matlab/data/behavdat_TI_prob_online.mat")
#puppydata1<-readMat("../Matlab/data/behave_data_goodEEGsubs.mat")
data_TI_prob_online<-puppydata_TI_prob_online$behav.result.mat
# 1st dim, Trials (1-77) per block
# 2nd dim,Data columns:
# ,1,: 1st stim (Value 1-8)
# ,2,: 2nd stim (Value 1-8)
# ,3,: Subject's choice (1: 1st; 2: 2nd)
# ,4,: Feedback; 0:incorrect; 1:correct; 3:no Feedback (also means the pair was not a neighbour
# 3rd dim, Blocks (1-8), yields overall 616 trials per sub
# 4th dim, subjects (1-19 EEG-clean; 1-30 all subs, incl. bad EEG or chance-level performance)
data_TI_prob_online_long=data.frame()
for (sub in 1:length(data_TI_prob_online[1,1,1,])){#subjects
for(block in 1:length(data_TI_prob_online[1,1,,1])){#blocks
subset=data.frame(data_TI_prob_online[,1:6,block,sub])
subset$subject=sub
subset$block=block
data_TI_prob_online_long=rbind(data_TI_prob_online_long,subset)
}
}
# transform the data so that choice equals 1 if the higher valued item was chosen and 0 if it wasnt chosen.
data_TI_prob_online_long%>%magrittr::set_colnames(c("stim1","stim2","choice","feedback","valueChosen","time_(idk)","subject","block"))%>%
rowwise()%>%
mutate(choice_right1wrong0=case_when(
(valueChosen==max(c(stim1,stim2)))~1,
(valueChosen==min(c(stim1,stim2)))~0
),
trial=row_number()
)%>%mutate(
FBtru=case_when(
(choice_right1wrong0==feedback & feedback!=3)~1,
(choice_right1wrong0!=feedback & feedback!=3)~0,
(feedback==3)~3
)
)->data_long_Choice10_TI_prob_online
#take out missings.
data_long_Choice10_TI_prob_online=data_long_Choice10_TI_prob_online[!is.na(data_long_Choice10_TI_prob_online$choice),]
# do what berni does: kick out bad subs (should we???)!
goodsubsPvals<-data_long_Choice10_TI_prob_online%>%
filter(block>6)%>%
group_by(subject)%>%
group_map(~binom.test(x=sum(.$choice_right1wrong0),
n=length(.$choice_right1wrong0),
p = 0.5,alternative = c("greater"),
conf.level = 0.95)
)%>%map(.,function(x) return(x$p.value))%>%unlist()
goodsubs=which(goodsubsPvals < 0.01)
SubDf<-data.frame(pval=goodsubsPvals,
sub=1:length(goodsubsPvals))
ggplot(SubDf,aes(x=pval,fill=pval<0.01))+geom_histogram(binwidth=20)+
theme_minimal()+
stat_bin(aes(y=..count.., label=..count..), geom="text",binwidth=20)+
ggtitle("Droplog Online")->OnlineDrop
data_long_Choice10_TI_prob_online%>%filter(block>6)%>%
group_by(subject)%>%summarize(mCh=mean(choice_right1wrong0))%>%
ggplot(aes(x=mCh,fill=mCh>0.6))+geom_histogram(binwidth=20)+
theme_minimal()+
stat_bin(aes(y=..count.., label=..count..), geom="text",binwidth=20)+
ggtitle("Droplog Online Percent")->OnlineDropPercent
ntrialsSub_TI_prob_online<-data_long_Choice10_TI_prob_online%>%filter()%>%group_by(subject)%>%summarize(n=n())
#unique
data_long_Choice10_TI_prob_online<-data_long_Choice10_TI_prob_online%>%filter(subject %in% goodsubs)
```
```{r}
se <- function(x) sqrt(var(x)/length(x))
data_long_Choice10_TI_prob_online%>%filter(FBtru==3)%>%group_by(subject)%>%
summarize(mean_choice=mean(choice_right1wrong0))->meanOnline
wilcox.test(x=meanOnline$mean_choice,y=NULL, mu = 0.5, alternative = "two.sided")
#effectsize::effectsize()
meanOnline%>%summarise(m=mean(mean_choice),
sem=se(mean_choice))
```
## Fit and compare via AIC
```{r }
if(loadfromdisk==0){
fullModelspaceParams_TI_prob_online=tibble()
# how can i do it with purrr?
for(m in models){
print(m)
fullModelspaceParams_TI_prob_online<-rbind(
fullModelspaceParams_TI_prob_online,
FitModel(m,data=data_long_Choice10_TI_prob_online,modelcode=modellist[[m]],NULL)#%>%rbind()
)
}
saveRDS("./B_Modelfits/behavdat_TI_prob_online_neglr.rds",object = fullModelspaceParams_TI_prob_online)
}else {
fullModelspaceParams_TI_prob_online<-readRDS("./B_Modelfits/behavdat_TI_prob_online_flip.rds")
}
fullModelspaceParams_TI_prob_online%>%rowwise()%>%
mutate(BIC=Gsq+log(ntrialsSub_TI_prob_online$n[subject])*parameters[model])->BICpars_TI_prob_online
```
### SaveBIC for ExeedanceProb
```{r}
matLL_TI_prob_online<-BICpars_TI_prob_online%>%mutate(BICn=-1*BIC)%>%select(subject,model,BICn)%>%unique()%>%
pivot_wider(names_from = model,values_from=BICn)%>%select(-subject)%>%as.matrix()
writeMat("../../Matlab/Exeedance_SC/LL_behavdat_TI_prob_online_flip.mat",m=matLL_TI_prob_online)
```
```{r}
BICpars_TI_prob_online%>%
group_by(model)%>%select(model,BIC,subject)%>%unique()%>%#summarise(BIC=mean(BIC))%>%
rowwise()%>%
mutate(Rsq = 1-(BIC/(-2*log(0.5) * (ntrialsSub_TI_prob_online$n[subject]))))%>%
ggplot(aes(x=model,y=Rsq,group=model))+
geom_quasirandom( position = position_jitter(width = .1), size = 1, varwidth=F,alpha=0.1) +
geom_boxplot(aes(x=model),width = .2, guides = FALSE, outlier.shape = NA, alpha = 0, color = 'black') +
stat_summary(fun.y = mean, geom='point', shape = 5, color = 'black', fill = NA)+
#stat_summary(geom="bar")+
scale_x_continuous(name="model",breaks=c(1,2,3,4,5,6,7,8,9,10),labels=modelnames_fig_axis)+
scale_y_continuous(name=expression("Rsq"))+
ggtitle("ModelComparison")+theme_cowplot()
BICpars_TI_prob_online%>%
group_by(model)%>%dplyr::summarise(
mean=mean(BIC),sem=se(BIC)
)
```
## Check which model wins
```{r }
#check which mo
winner_TI_prob_online<-fullModelspaceParams_TI_prob_online%>%rowwise()%>%
mutate(AIC=Gsq+log(ntrialsSub_TI_prob_online$n[subject])*parameters[model])%>%
group_by(model)%>%summarise(AIC=mean(AIC))%>%
mutate(diff=AIC-min(AIC))%>%filter(diff==0)%>%.$model
fullModelspaceParams_TI_prob_online%>%rowwise()%>%
mutate(BIC=Gsq+log(ntrialsSub_TI_prob_online$n[subject])*parameters[model])%>%
group_by(model,subject)%>%summarise(BIC=mean(BIC))%>%
group_by(subject)%>%
mutate(diff=min(BIC)==BIC)%>%
ggplot(aes(x=model,y=BIC))+
stat_summary(geom="pointrange")+
geom_point(aes(color=diff),position = position_dodge(0.9))+
scale_x_continuous(breaks=1:10,labels=modelnames_fig_axis)+
scale_color_discrete(name="Smallest BIC\nWithin Sub")+theme_cowplot(14)+
theme(axis.text.x = element_text(angle=45))
print(as.numeric(winner_TI_prob_online))
```
## Parametercorelations
```{r }
fullModelspaceParams_TI_prob_online<-fullModelspaceParams_TI_prob_online%>%rowwise()%>%
mutate(ParName=ParamNames[[model]][par])
fullModelspaceParams_TI_prob_online%>%filter(model==as.numeric(winner_TI_prob_online))%>%select(-Gsq,-model,-par)%>%
pivot_wider(names_from = "ParName",values_from="est")%>%select(-subject)%>%
ggcorr(., palette = "RdBu", label = TRUE)+
ggtitle("Parameter correlations winning model")
# pivot_longer(cols=-subject)%>%filter(name!="mix")
```
## A closer look
```{r }
fullModelspaceParams_TI_prob_online%>%filter(model==as.numeric(winner_TI_prob_online))%>%select(-Gsq,-model,-par)%>%
pivot_wider(names_from = "ParName",values_from="est")%>%select(-subject)%>%
ggpairs(progress = F)+theme_minimal()
```
## Simualte Data from fitted models
```{r results='hide'}
SIMmodellist=list(Model1Sim,Model2Sim,Model3Sim,Model4Sim,Model5Sim,Model6Sim,Model7Sim,Model8Sim,Model9Sim,Model10Sim)
Modelchoice_TI_prob_online=list()
subcnt=1
for(sub in unique(data_long_Choice10_TI_prob_online$subject)){
#vector that tells the algorithm whether it should fit the asym or the sym model
#concataneate trial values.
trials=cbind(data_long_Choice10_TI_prob_online[data_long_Choice10_TI_prob_online$subject==sub,]$stim1,
data_long_Choice10_TI_prob_online[data_long_Choice10_TI_prob_online$subject==sub,]$stim2)
fb=data_long_Choice10_TI_prob_online[data_long_Choice10_TI_prob_online$subject==sub,]$FBtru
#get teh recoded choice
choice=data_long_Choice10_TI_prob_online[data_long_Choice10_TI_prob_online$subject==sub,]$choice_right1wrong0
data_TI_prob_online=data.frame(
trials,
FBtru=fb,
subcho=choice,
asym=asymParam[1]
)
#get the recoded choice
#choice=data_long_Choice10[data_long_Choice10$subject==sub,]$choice_right1wrong0
#simulate data from all models
print(subcnt)
Modelchoice_TI_prob_online[[subcnt]]<-get(paste0("Model",1,"SimCP"))(fullModelspaceParams_TI_prob_online%>%filter(model==1 & subject==sub)%>%.$est,data_TI_prob_online)
for (i in 2:10){
data_TI_prob_online=data.frame(
trials,
FBtru=fb,
subcho=choice,
asym=asymParam[i]
)
Modelchoice_TI_prob_online[[subcnt]]<-cbind(Modelchoice_TI_prob_online[[subcnt]],
get(paste0("Model",i,"SimCP"))(fullModelspaceParams_TI_prob_online%>%filter(model==i & subject==sub)%>%.$est,data_TI_prob_online)
)
}
subcnt=subcnt+1
}
data_long_Choice10_TI_prob_online_Sims<-cbind(data_long_Choice10_TI_prob_online,do.call("rbind",Modelchoice_TI_prob_online))
```
## plot model predictions
```{r fig.width=30,fig.height=20}
nModels=10
nSubs=length(unique(data_long_Choice10_TI_prob_online$subject))
prefmatMod_TI_prob_online=array(99,dim=c(8,8,nSubs,nModels))
prefmatSub_TI_prob_online=array(99,dim=c(8,8,nSubs))
submat=1
for(sub in unique(data_long_Choice10_TI_prob_online$subject)){
for (model in 1:nModels){
#for (sub in unique(data_long_Choice10$subject)){
#concataneate trial values.
trials=cbind(data_long_Choice10_TI_prob_online[data_long_Choice10_TI_prob_online$subject==sub,]$stim1,
data_long_Choice10_TI_prob_online[data_long_Choice10_TI_prob_online$subject==sub,]$stim2)
choice=data_long_Choice10_TI_prob_online[data_long_Choice10_TI_prob_online$subject==sub,]$choice_right1wrong0
sim=data_long_Choice10_TI_prob_online_Sims[data_long_Choice10_TI_prob_online_Sims$subject==sub,]%>%select(as.character(model))
prefmatMod_TI_prob_online[,,submat,model]=choiceRDM(trials,sim[[1]],1:8)
#print(prefmatMod[,,submat,model])
prefmatSub_TI_prob_online[,,submat]=choiceRDM(trials,choice,1:8)
}
submat=submat+1
}
#function
prefmatSub_TI_prob_online%>%rowMeans(.,na.rm=T,dims = 2)%>%reshape::melt()%>%ggplot(aes(x=-X2,y=X1))+
geom_tile(aes(fill = value),stat = "identity")+
scale_fill_viridis_c(name="p_correct",na.value="white",option="viridis",limits=c(0.5,0.94))+
ggtitle("Accuracy - TI_prob_online subs")+
scale_x_continuous(name="item 2")+
scale_y_continuous(name="item 1",breaks=c(-2,-4,-6,-8),labels=c(2,4,6,8))+
theme_minimal(10)+theme(plot.title = element_text(size = 12))->one_TI_prob_online
#+coord_flip()
modelplotlist_TI_prob_online<-list()
for (i in 1:nModels){
modelplotlist_TI_prob_online[[i]]<-prefmatMod_TI_prob_online[,,,i]%>%rowMeans(.,na.rm=T,dims = 2)%>%reshape::melt()%>%ggplot(aes(x=-X2,y=X1))+
geom_tile(aes(fill = value),stat = "identity")+
scale_fill_viridis_c(name="p_correct",na.value="white",option="viridis",limits=c(0.5,0.94))+
ggtitle(modelnames_fig_title[i])+
scale_x_continuous(name="item 2")+
scale_y_continuous(name="item 1",breaks=c(-2,-4,-6,-8),labels=c(2,4,6,8))+
theme_minimal(10)+theme(plot.title = element_text(size = 12))
# print(p)
}
cowplot::plot_grid(one_TI_prob_online,modelplotlist_TI_prob_online[[1]],modelplotlist_TI_prob_online[[2]],modelplotlist_TI_prob_online[[3]],modelplotlist_TI_prob_online[[4]],modelplotlist_TI_prob_online[[5]],modelplotlist_TI_prob_online[[6]],modelplotlist_TI_prob_online[[7]],modelplotlist_TI_prob_online[[8]],modelplotlist_TI_prob_online[[9]],modelplotlist_TI_prob_online[[10]])
```
## Matrix PCorrect & PP
```{r }
prefmatSub_TI_prob_online%>%rowMeans(.,na.rm=T,dims = 2)%>%t()%>%reshape::melt()%>%ggplot(aes(x=X2,y=-X1))+
geom_tile(aes(fill = value),stat = "identity")+
scale_fill_viridis_c(name="p_correct",limits=c(0.4,1),na.value="white",option="inferno")+
ggtitle("Accuracy - TI_prob_online subs")+
scale_x_continuous(name="stim1")+
scale_y_continuous(name="stim2",breaks=c(-2,-4,-6,-8),labels=c(2,4,6,8))+
theme_cowplot()->three_TI_prob_online
#+coord_flip()
prefmatMod_TI_prob_online[,,,as.numeric(winner_TI_prob_online)]%>%rowMeans(.,na.rm=T,dims = 2)%>%t()%>%reshape::melt()%>%ggplot(aes(x=X2,y=-X1))+
geom_tile(aes(fill = value),stat = "identity")+
scale_fill_viridis_c(name="p_correct",limits=c(0.4,1),na.value="white",option="inferno")+
ggtitle("Accuracy - Model")+
scale_x_continuous(name="stim1")+
scale_y_continuous(name="stim2",breaks=c(-2,-4,-6,-8),labels=c(2,4,6,8))+
theme_cowplot()->four_TI_prob_online
cowplot::plot_grid(three_TI_prob_online,four_TI_prob_online)
```
## Pairwise P_Correct & Simulations from fitted parameters
```{r fig.width=18,fig.height=12}
data_long_Choice10_TI_prob_online_Sims%>%group_by(stim1,stim2)%>%pivot_longer(cols = c(choice_right1wrong0,as.character(winner_TI_prob_online),-stim1,-stim2),names_to="SubsOrSim",values_to="p_correct")%>%
ggplot(aes(x=interaction(stim1,stim2),y=p_correct))+
stat_summary(aes(color=SubsOrSim),size=2)+
scale_color_viridis_d(name="",breaks=c(as.character(winner_TI_prob_online),"choice_right1wrong0"),labels=c("Model Simulation","Subject Response"),option="plasma")+
stat_summary(aes(color=SubsOrSim,group=SubsOrSim),geom="line",size=1.3)+
scale_x_discrete(name="pair")+
coord_cartesian(ylim=c(0.4,1))+
geom_hline(aes(yintercept=0.5))+
annotate("text", x = "7.1", y = 0.53, label = "Chance",size=10)+
scale_y_continuous(name="p_correct")+theme_cowplot(20)+
theme(axis.text.x = element_text(size=7))+ggtitle(paste0("TI_prob_online Subs & ModelPreds \n",
"Best Model: ",modelnames_fig_title[winner_TI_prob_online]))
```
# compare elo vat & q2*
```{r}
library(parallel)
#overwriteboundaries
ParamBoundaries=list()
# ELOPWINLOSE
ParamBoundaries[[1]]<-tibble(
lb=c(0,0,0,0,0), # lower bounds
ub=c(1,1,1,1,1) # upper bounds
)
#ELOP
ParamBoundaries[[2]]<-tibble(
lb=c(0,0,0,0), # lower bounds
ub=c(1,1,1,1) # upper bounds
)
#ELO
ParamBoundaries[[3]]<-tibble(
lb=c(0,0), # lower bounds
ub=c(1,1) # upper bounds
)
#VAT_P_WINLOOSE
ParamBoundaries[[4]]<-tibble(
lb=c(0,0,0,0,0,0), # lower bounds
ub=c(1,1,1,1,5,5) # upper bounds
)
#VAT_P
ParamBoundaries[[5]]<-tibble(
lb=c(0,0,0,0,0), # lower bounds
ub=c(1,1,1,5,5) # upper bounds
)
#VAT
ParamBoundaries[[6]]<-tibble(
lb=c(0,0,0,0), # lower bounds
ub=c(1,1,1,5) # upper bounds
)
# mixture Item TI & Pair _NO_ TI & ASYM learning rate for items (G)
ParamBoundaries[[7]]<-tibble(
lb=c(0,0,0,0,0,0), # lower bounds
ub=c(0.2,0.2,10,1,1,1) # upper bounds
)
fullModelspaceParams_TI_ELO_VAT_Q2=tibble()
modellistELOVAT=list(RL_ELO_P_WinLoose,RL_ELO_P,RL_ELO,VatPWinLoose,VatP,Vat,Model7)
models=1:7
# how can i do it with purrr?
for(m in models){
print(m)
fullModelspaceParams_TI_ELO_VAT_Q2<-rbind(
fullModelspaceParams_TI_ELO_VAT_Q2,
FitModelELOVAT(m,data=data_long_Choice10_TI_prob_online,modelcode=modellistELOVAT[[m]],NULL)#%>%rbind()
)
}
parameters=c(5,4,2,6,5,3,6)
fullModelspaceParams_TI_ELO_VAT_Q2%>%rowwise()%>%
mutate(BIC=Gsq+log(ntrialsSub_TI_prob_online$n[subject])*parameters[model])->BICpars_fullModelspaceParams_TI_ELO_VAT_Q2
saveRDS("./B_Modelfits/ELOVAT_prob_online_flip.rds",object = BICpars_fullModelspaceParams_TI_ELO_VAT_Q2)
```
```{r}
```
\ No newline at end of file
---
title: "Deterministic Feedback"
author: "Simon"
date: "06/08/2020"
output:
html_document:
toc: true
code_folding: hide
---
```{r setup_Det, include=FALSE}
pacman::p_load("tidyverse","DEoptim","cowplot","tidybayes","ggpubr","R.matlab","doParallel","foreach","GGally","viridis","ggbeeswarm")
source("../../../../../../R/Helpers/R_rainclouds.R")
# functions for fitting are hidden
source("A_Models/TI_Models.R")
source("A_Models/Fit_Parralel_negLR.R")
loadfromdisk=1
set.seed(5)
#####setup parralel
cl <- makeCluster(35)
registerDoParallel(cl)
vDEctrl <- DEoptim.control(trace=TRUE,parallelType=0,packages=c(),parVar=c())
#####
#loadfromdisk=0
SIMmodellist=list(Model1Sim,Model2Sim,Model3Sim,Model4Sim,Model5Sim,Model6Sim,Model7Sim,Model8Sim,Model9Sim,Model10Sim)
modellist=list(Model1,Model2,Model3,Model4,Model5,Model6,Model7,Model8,Model9,Model10)
modelnames_fig_title=c("Model I2",
"Model I1",
"Model I2t",
"Model I1t",
"Model P",
"Model Pt",
"Model I2t+P",
"Model I1t+P",
"Model I2t+P",
"Model I1t+Pi")
models=1:10
parameters=c(3,2,4,3,2,3,6,5,7,6)# number of parameters per model
asymParam=c(0,1,0,1,1,1,0,1,0,1)# which model is asymmetric (neeeded for fits and simulating)
modelnames_fig_axis=c("I2","I1","Ii2","Ii1","P","Pi","Ii2+P","Ii1+P","Ii2+Pi","Ii1+Pi")
###
### Define boundaries for fitting parameters
# ###
# ParamBoundaries=list()
# #Only Itemlevel Asym (A)
# ParamBoundaries[[1]]<-tibble(
# lb=c(0,0,0.1), # lower bounds
# ub=c(1,1,3) # upper bounds
# )
#
# #Only Itemlevel Sym (B)
# ParamBoundaries[[2]]<-tibble(
# lb=c(0,0.1), # lower bounds
# ub=c(1,3) # upper bounds
# )
#
# #Only Item TI Asym (C)
# ParamBoundaries[[3]]<-tibble(
# lb=c(0,0,0,0.1), # lower bounds
# ub=c(1,1,10,3) # upper bounds
# )
#
# #Only Item TI Sym (D)
# ParamBoundaries[[4]]<-tibble(
# lb=c(0,0,0.1), # lower bounds
# ub=c(1,10,3) # upper bounds
# )
#
# #Only Pairs (E)
# ParamBoundaries[[5]]<-tibble(
# lb=c(0,0.1), # lower bounds
# ub=c(2,3) # upper bounds
# )
#
# #Pair TI (F)
# ParamBoundaries[[6]]<-tibble(
# lb=c(0,0.1,0.1), # lower bounds
# ub=c(2,10,3) # upper bounds
# )
#
#
# # mixture Item TI & Pair _NO_ TI & ASYM learning rate for items (G)
# ParamBoundaries[[7]]<-tibble(
# lb=c(0,0,0,0,0.1,0.1), # lower bounds
# ub=c(1,1,10,2,3,3) # upper bounds
# )