Skip to content

Commit

Permalink
Bugfix IG model
Browse files Browse the repository at this point in the history
ManuelRausch committed Apr 18, 2024
1 parent 30f6876 commit b979361
Showing 5 changed files with 14 additions and 10 deletions.
6 changes: 4 additions & 2 deletions R/int_fit2Chan.R
Original file line number Diff line number Diff line change
@@ -86,11 +86,13 @@ fit2Chan <-
res[paste("d_",1:nCond, sep="")] <- as.vector(cumsum(exp(fit$par[1:(nCond)])))
res$c <- as.vector(fit$par[nCond+nRatings])
res[,paste("theta_minus.",(nRatings-1):1, sep="")] <-
exp(fit$par[nCond + nRatings*2]) * as.vector(fit$par[nCond+nRatings]) -
#exp(fit$par[nCond + nRatings*2]) *
as.vector(fit$par[nCond+nRatings]) -
rev( cumsum(c(exp(fit$par[(nCond+1):(nCond+nRatings-1)]))))

res[,paste("theta_plus.",1:(nRatings-1), sep="")] <-
exp(fit$par[nCond + nRatings*2]) * as.vector(fit$par[nCond+nRatings]) +
#exp(fit$par[nCond + nRatings*2]) *
as.vector(fit$par[nCond+nRatings]) +
cumsum(c(exp(fit$par[(nCond+nRatings+1):(nCond + nRatings*2-1)])))

res$m <- exp(fit$par[nCond + nRatings*2])
1 change: 0 additions & 1 deletion R/int_fitITG.R
Original file line number Diff line number Diff line change
@@ -186,7 +186,6 @@ fitITGc <-
if(!inherits(fit, "try-error")){
k <- length(fit$par)


res[paste("d_",1:nCond, sep="")] <- as.vector(cumsum(exp(fit$par[1:(nCond)])))
res$c <- as.vector(fit$par[nCond+nRatings])
res[,paste("theta_minus.",(nRatings-1):1, sep="")] <-
13 changes: 8 additions & 5 deletions R/int_fitMetaDprime.R
Original file line number Diff line number Diff line change
@@ -25,16 +25,19 @@ int_fitMetaDprime <- function(ratings, stimulus, correct,
# compute type 1 parameters based on formulae

dprime <- ratingHrs[nRatings] - ratingFrs[nRatings]
if (dprime < 0){
stop("Cannot reasonably estimate meta-d'/d'because type 1 performance is below chance.")
}
cs <- (-.5 * ( ratingHrs + ratingFrs))
cprime <- cs[nRatings]/dprime

# use a coarse grid search to identify the most promising starting parameters
temp <- expand.grid(d = seq(0, 5, length.out = 10),
temp <- expand.grid(d = seq(0.1, 5, length.out = 10),
tauMin = seq(.1,2,length.out=10), # position of the most conservative confidence criterion related to stimulus A
tauRange = seq(0.5,5,length.out=10)) # range of rating criteria stimulus B # position of the most liberal confidence criterion with respect to thet

inits <- data.frame(matrix(data=NA, nrow= nrow(temp), ncol = 1 + (nRatings-1)*2))
inits[,1] <- temp$d # qnorm((temp$d + 10)/ 20)
inits[,1] <- log(temp$d) # qnorm((temp$d + 10)/ 20)
if (nRatings == 3){
inits[,2] <-
log(mapply(function(tauRange) rep(tauRange/(nRatings-1), nRatings-2),
@@ -123,7 +126,7 @@ int_fitMetaDprime <- function(ratings, stimulus, correct,

if(exists("fit")){
if(is.list(fit)){
result$metaD = fit$par[1]
result$metaD = exp(fit$par[1])
result$Ratio = result$metaD / dprime

}
@@ -133,7 +136,7 @@ int_fitMetaDprime <- function(ratings, stimulus, correct,
}

negLoglMetaD <- function(parameters, nC_rS1,nI_rS1, nC_rS2,nI_rS2,nRatings, cprime){
metadprime <- parameters[1] # pnorm(parameters[1])*20 - 10
metadprime <- exp(parameters[1]) # pnorm(parameters[1])*20 - 10
S1mu <- -metadprime/2
S2mu <- metadprime/2
meta_c <- metadprime*cprime
@@ -161,7 +164,7 @@ negLoglMetaD <- function(parameters, nC_rS1,nI_rS1, nC_rS2,nI_rS2,nRatings, cpri
}

negLoglFleming <- function(parameters, nC_rS1,nI_rS1, nC_rS2,nI_rS2,nRatings, type1_c){
metadprime <- parameters[1] # pnorm(parameters[1])*20 - 10
metadprime <- exp(parameters[1]) # pnorm(parameters[1])*20 - 10
S1mu <- -metadprime/2
S2mu <- metadprime/2
t2_rS1 <- c(-Inf, type1_c - rev(cumsum(exp(parameters[2:nRatings]))), type1_c)
2 changes: 1 addition & 1 deletion R/int_ll2Chan.R
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
ll2Chan <-
function(p, N_SA_RA,N_SA_RB, N_SB_RA, N_SB_RB, nRatings, nCond){
function(p, N_SA_RA,N_SA_RB, N_SB_RA, N_SB_RB, nRatings, nCond){
p <- c(t(p))
ds <- exp(p[1:nCond])
locA1 <- - ds /2
2 changes: 1 addition & 1 deletion R/int_llITG.R
Original file line number Diff line number Diff line change
@@ -67,7 +67,7 @@ ll_MratioF <-
metads <- m_ratio * ds
locA2 <- -metads/2
locB2 <- metads/2
meta_c <- theta # this is the version of the model used vy Fleming (2017)
meta_c <- theta # this is the version of the model used by Fleming (2017)
c_RA <- c(-Inf,
meta_c - rev(cumsum(c(exp(p[(nCond+1):(nCond+nRatings-1)])))),
meta_c)

0 comments on commit b979361

Please sign in to comment.