R/fitPFm.R

In LuchTiarna/PsyMetFuns: Package for extrapolating psychometric information

#'fitPFm
#'
#'Provides the frame for psycometrics function models. Combines the sigmoid and core function.
#'@param gamma sets the loves boundary of function
#'@param lambda sets the highes boundary of function
#'@param sigmoid determines the sigmoid of the fuction
#'@param core dermines the core of the function
#'@param x the vector of level values
#'@param ... specifies the parametres or core function
#'@param type specifies, whether function is CDF of PDF type
#'@param inverse specifies, whether to compute the inverse function
#'
#'@return vector of return values
#'@export
fitPFm <- function(formula, data, sigmoid, core, gamma=NULL, lambda=NULL, split_by=NULL,
                   par=NULL, fn=NULL, gr=NULL, type="hitPercentage", ...,
                   method = c("Nelder-Mead", "BFGS", "CG", "L-BFGS-B", "SANN","Brent"),
                   lower = -Inf, upper = Inf,
                   control = list(), hessian = FALSE){
  pf <- fitPF(formula=formula, data=data, sigmoid=sigmoid, core=core, gamma=gamma, lambda=lambda, split_by=split_by, type=type,
              par=par, fn=fn, gr=gr,  ...,
              method=method,
              lower=lower, upper=upper,
              control=control, hessian=hessian)

  if(is.null(split_by)){
    pfm <- pfCONVpfm(pf, data, formula)
  }else{
    tryDD <- tryCatch({  split(x=data, f=split_by, drop=TRUE, lex.order = FALSE) })
    if(!is.list(tryDD) || nrow(tryDD[[1]]) == nrow(data)){
      error <- tryDD
      tryDD <- tryCatch({
        split_by <- as.list(data[unlist(split_by)])
        split(x=data, f=split_by, drop = TRUE, lex.order = FALSE)
      })
    }
    if(!is.list(tryDD)){ stop(error, tryDD) }
    data <- tryDD
    pfm <- mapply(FUN=pfCONVpfm, pf, data, SIMPLIFY=FALSE, MoreArgs = list(formula))
  }
  return(pfm)
}

pfCONVpfm <- function(pf, data, formula){
  pfm <- pf
  pfm$data <- data
  pfm$formula <- formula
  class(pfm) <- c(class(pfm),"PFm")
  return(pfm)
}