R/mml.fit.R

In wasabi1989/MiscPsycho: Miscellaneous Psychometric Analyses

mml.fit <- function(data, Q = 20, params, control = list(), ...){
	a <- params$'3pl'$a
    b <- params$'3pl'$b
    c <- params$'3pl'$c
	con <- list(D = 1.7, startVal = c(0,1))
    con[names(control)] <- control
	qq <- gauss.quad.prob(Q, dist = 'normal')
	L <- nrow(data)
	C <- ncol(data)
	rr1 <- matrix(0, nrow = Q, ncol = L)
	data <- as.matrix(data)
	fn <- function(params){
		u <- params[1]
		s <- params[2]
		for(j in 1:Q){
			for(i in 1:L){
				rr1[j,i] <- exp(sum(dbinom(data[i,], 1, c + (1 - c) / (1 + exp(- con$D * 
				a * (qq$nodes[j] - b))), log = TRUE))) * 
				((1/(s*sqrt(2*pi)))  * exp(- ((qq$nodes[j]-u)^2/(2*s^2))))/dnorm(qq$nodes[j]) * qq$weights[j]
			}
		}
	-sum(log(colSums(rr1)))
	}	
	opt <- optim(con$startVal, fn, hessian = TRUE)
	list("coefficients" = opt$par, "LogLik" = -opt$value, "Std.Error" = sqrt(diag(solve(opt$hessian))))
	}