R/gfunction.R

Defines functions gfun_inv dgfun gfun

gfun <- function(pars_obj, intercept=F){
  gfun_index = which(sapply(pars_obj, function(x)x$type)=="gfun")
  #if (length(gfun_index)!=1) stop("Something when wrong with the g function. There are either too many or none of them in the pars_obj.")
  out = pars_obj[[gfun_index]]$mat  %*% pars_obj[[gfun_index]]$pars
  if (intercept){
    fix_index = which(sapply(pars_obj, function(x)x$type)=="fix.eff")
    out <- out + pars_obj[[fix_index]]$pars[1]
  }
  out
}

dgfun <- function(pars_obj){
  gfun_index = which(sapply(pars_obj, function(x)x$type)=="gfun")
  #if (length(gfun_index)!=1) stop("Something when wrong with the g function. There are either too many or none of them in the pars_obj.")
  pars_obj[[gfun_index]]$mat1 %*% pars_obj[[gfun_index]]$pars
}

gfun_inv <- function(W, pars_obj){
  gfun_index = which(sapply(pars_obj, function(x)x$type)=="gfun")
  #fix_index = which(sapply(pars_obj, function(x)x$type)=="fix.eff")
  v <- pars_obj[[gfun_index]]$v
  #W0 <- gfun(pars_obj) +pars_obj[[fix_index]]$pars[1]
  W0 <- gfun(pars_obj, intercept = TRUE)
  ind <- findInterval(W, W0)
  vv=c(0,v,1)
  vv=(vv[ind+1]+vv[ind+2])/2
  return(vv)
}

Try the ordinalCont package in your browser

Any scripts or data that you put into this service are public.

ordinalCont documentation built on Dec. 3, 2020, 1:06 a.m.