R/lmp.R

In rpf: Response Probability Functions

##' Create logistic function of a monotonic polynomial (LMP) model
##'
##' This model is a dichotomous response model originally proposed by
##' Liang (2007) and is implemented using the parameterization by
##' Falk & Cai (2016).
##'
##' The LMP model replaces the linear predictor part of the
##' two-parameter logistic function with a monotonic polynomial,
##' \eqn{m(\theta,\omega,\xi,\mathbf{\alpha},\mathbf{\tau})}{m(theta; omega, alpha, tau)},
##'
##' \deqn{\mathrm P(\mathrm{pick}=1|\omega,\xi,\mathbf{\alpha},\mathbf{\tau},\theta)
##' = \frac{1}{1+\exp(-(\xi + m(\theta;\omega,\mathbf{\alpha},\mathbf{\tau})))}
##' }{P(pick=1|omega,xi,alpha,tau,th) = 1/(1+exp(-(xi + m(theta;omega,alpha,tau))))}
##'
##' where \eqn{\mathbf{\alpha}}{alpha} and \eqn{\mathbf{\tau}}{tau} are vectors
##' of length q.
##'
##' The order of the polynomial is always odd and is controlled by
##' the user specified non-negative integer, q. The model contains
##' 2+2*q parameters and are used in conjunction with the \code{\link{rpf.prob}}
##' or \code{\link{rpf.dTheta}} function in the following order:
##' \eqn{\omega}{omega} - the natural log of the slope of the item model when q=0,
##' \eqn{\xi}{xi} - the intercept,
##' \eqn{\alpha}{alpha} and \eqn{\tau}{tau} - two parameters that control bends in
##' the polynomial. These latter parameters are repeated in the same order for
##' models with q>0. For example, a q=2 polynomial with have an item
##' parameter vector of: \eqn{\omega, \xi, \alpha_1, \tau_1, \alpha_2, \tau_2}{
##' omega, xi, alpha1, tau1, alpha2, tau2}.
##'
##' In general, the polynomial looks like the following:
##'
##' \deqn{m(\theta;\omega,\alpha,\tau) = b_1\theta + b_2\theta^2 + \dots + b_{2q+1}\theta^{2q+1}
##' }{m(theta;omega,alpha,tau) = b_1*theta + b_2*theta^2 + \dots + b_(2q+1)*theta^{2q+1}}
##'
##' However, the coefficients, b, are not directly estimated, but are a function of the
##' item parameters. In particular, the derivative \eqn{m'(\theta;\omega,\alpha,\tau)}{m'(theta;omega,alpha,tau)} is
##' parameterized in the following way:
##'
##'\deqn{m'(\theta;\omega,\alpha,\tau) = \left\{\begin{array}{ll}\exp(\omega) \prod_{u=1}^q(1-2\alpha_{u}\theta + (\alpha_{u}^2 + \exp(\tau_{u}))\theta^2) &  \mbox{if } q > 0 \\
##'  \exp(\omega) & \mbox{if } q = 0\end{array} \right.}{m'(theta) = m'(theta;omega,alpha,tau) = exp(omega) \prod_{u=1}^q (1-2*alpha_u*theta + (alpha_u^2 + exp(tau_u))*theta^2) (if q > 0) \\
##'  exp(omega) (if q = 0)}
##'
##'
##' See Falk & Cai (2016) for more details as to how the polynomial is constructed.
##' At the lowest order polynomial (q=0) the model reduces to the
##' two-parameter logistic (2PL) model. However, parameterization of the
##' slope parameter, \eqn{\omega}{omega}, is currently different than
##' the 2PL (i.e., slope = exp(\eqn{\omega}{omega})). This parameterization
##' ensures that the response function is always monotonically increasing
##' without requiring constrained optimization.
##'
##' For an alternative parameterization that releases constraints
##' on \eqn{\omega}{omega}, allowing for monotonically decreasing functions,
##' see \code{\link{rpf.grmp}}. And for polytomous items, see both
##' \code{\link{rpf.grmp}} and \code{\link{rpf.gpcmp}}.
##'
##' @param q a non-negative integer that controls the order of the
##' polynomial (2q+1) with a default of q=0 (1st order polynomial = 2PL).
##' @param multidimensional whether to use a multidimensional model.
##' Defaults to \code{FALSE}. The multidimensional version is not yet
##' available.
##' @return an item model
##' @references Falk, C. F., & Cai, L. (2016). Maximum marginal likelihood
##' estimation of a monotonic polynomial generalized partial credit model with
##' applications to multiple group analysis. \emph{Psychometrika, 81}, 434-460.
##' \doi{10.1007/s11336-014-9428-7}
##'
##' Liang (2007). \emph{A semi-parametric approach to estimating item response
##' functions}. Unpublished doctoral dissertation, Department of Psychology,
##' The Ohio State University.
##' @family response model
##' @examples
##' spec <- rpf.lmp(1) # 3rd order polynomial
##' theta<-seq(-3,3,.1)
##' p<-rpf.prob(spec, c(-.11,.37,.24,-.21),theta)
##'
##' spec <- rpf.lmp(2) # 5th order polynomial
##' p<-rpf.prob(spec, c(.69,.71,-.5,-8.48,.52,-3.32),theta)

rpf.lmp <- function(q=0, multidimensional=FALSE) {
  if(!(q%%1==0)){
    stop("q must be an integer >= 0")
  }
  if(multidimensional){
      stop("Multidimensional LMP model is not yet supported")
  }
  m <- NULL
  id <- -1
  id <- rpf.id_of("lmp")
  m <- new("rpf.1dim.lmp",
           outcomes=2,
           factors=1)
  m@spec <- c(id, 2, m@factors, q)
  m
}

setMethod("rpf.rparam", signature(m="rpf.1dim.lmp"),
          function(m, version) {
            n <- 1
            q<-m$spec[4] ## ok to hardcode this index?
            ret<-c(omega=rnorm(n, 0, .5),xi=rnorm(n, 0, .75))
            if(q>0){
                for(i in 1:q){
                    ret<-c(ret,runif(n,-1,1),log(runif(n,.0001,1)))
                    names(ret)[(3+(i-1)*2):(2+(i*2))]<-c(paste("alpha",i,sep=""),paste("tau",i,sep=""))
                }
            }
            ret
        })