R/mapping_ucminf.R

In trajeR: Group Based Modeling Trajectory

# LOGIT
LLOGIT = function(x, ng, nx, n ,  A , Y, X, nbeta,
                  nw, TCOV){
  tour = get_tour()
  storelik = get_storelik()
  lik = -likelihoodLOGIT_cpp(x,ng = ng, nx = nx, n = n,  A = A, Y = Y, X = X, nbeta = nbeta,
                             nw = nw, TCOV = TCOV)
  if(storelik>lik){
    cat(sprintf("iter %3d value ", tour))
    cat(sprintf("%.6f\n", lik))
    set_tour(tour + 1); 
    set_storelik(lik);
  }
  return(lik)
}
difLLOGIT = function(x,ng, nx, n ,  A ,  Y, X, nbeta,
                     nw, TCOV){
  return(-difLLOGIT_cpp(x, ng = ng, nx = nx, n = n,  A = A, Y = Y, X = X, nbeta = nbeta,
                        nw = nw, TCOV = TCOV))
}

# CNORM
LCNORM = function(x, ng, nx, n ,  A , Y, X, nbeta,
                  nw, TCOV, ymin, ymax, ssigma){
  tour = get_tour()
  storelik = get_storelik()
  lik = -Likelihoodalpha_cpp(x, ng = ng, nx = nx, n =n, A = A, Y = Y, X = X, nbeta = nbeta,
                             ymin = ymin, ymax = ymax, nw = nw, TCOV = TCOV, ssigma = ssigma)
  if(storelik>lik){
    cat(sprintf("iter %3d value ", tour))
    cat(sprintf("%.6f\n", lik))
    set_tour(tour + 1); 
    set_storelik(lik);
  }
  return(lik)
}
difLCNORM = function(x, ng, nx, n ,  A ,  Y, X, nbeta,
                     nw, TCOV, ymin, ymax, ssigma){
  return(-difLalpha_cpp(x, ng = ng, nx = nx, n =n, A = A, Y = Y, X = X, nbeta = nbeta,
                        ymin = ymin, ymax = ymax, nw = nw, TCOV = TCOV, ssigma = ssigma))
}
# CNORM same sigma
difLCNORMss = function(x, ng, nx, n ,  A ,  Y, X, nbeta,
                       nw, TCOV, ymin, ymax, ssigma){
  return(-difLalphaunique_cpp(x, ng = ng, nx = nx, n =n, A = A, Y = Y, X = X, nbeta = nbeta,
                              ymin = ymin, ymax = ymax, nw = nw, TCOV = TCOV, ssigma = ssigma))
}

# ZIP
LZIP = function(x, ng, nx, n ,  A , Y, X, nbeta, nnu,
                  nw, TCOV){
  tour = get_tour()
  storelik = get_storelik()
  lik = -likelihoodZIP_cpp(x, ng = ng, nx = nx, n = n,  A = A, Y = Y, X = X, nbeta = nbeta, nnu = nnu,
                           nw = nw, TCOV = TCOV)
  if(storelik>lik){
    cat(sprintf("iter %3d value ", tour))
    cat(sprintf("%.6f\n", lik))
    set_tour(tour + 1); 
    set_storelik(lik);
  }
  return(lik)
}
difLZIP = function(x,ng, nx, n ,  A ,  Y, X, nbeta, nnu,
                     nw, TCOV){
  return(-difLZIP_cpp(x, ng = ng, nx = nx, n = n,  A = A, Y = Y, X = X, nbeta = nbeta, 
                      nnu = nnu, nw = nw, TCOV = TCOV))
}

# BETA
LBETA = function(x, ng, nx, n ,  A , Y, X, nbeta, nphi,
                 nw, TCOV){
  tour = get_tour()
  storelik = get_storelik()
  lik = -LikelihoodBETA_cpp(x, ng = ng, nx = nx, n = n,  A = A, Y = Y, X = X, nbeta = nbeta, nphi = nphi,
                            nw = nw, TCOV = TCOV)
  if(storelik>lik){
    cat(sprintf("iter %3d value ", tour))
    cat(sprintf("%.6f\n", lik))
    set_tour(tour + 1); 
    set_storelik(lik);
  }
  return(lik)
}
difLBETA = function(x,ng, nx, n ,  A ,  Y, X, nbeta, nphi,
                    nw, TCOV){
  return(-difLBETA_cpp(x, ng = ng, nx = nx, n = n,  A = A, Y = Y, X = X, nbeta = nbeta,
                       nphi = nphi, nw = nw, TCOV = TCOV))
}