R/func.gr.oprobit.vign.C.R

In anchors: Statistical analysis of surveys with anchoring vignettes

#######################################################################
## Function: gr.oprobit()
## Author  : Jonathan Wand (jwand@latte.harvard.edu)
##
## Calculate gradient of ordered probit
##
## Created:   2003-05-05
## Modified:  $Date: 2004/07/07 04:08:44 $
## Revision:  $Revision: 1.2 $
## RCS-ID:    $Id: func.gr.oprobit.vign.C.R,v 1.2 2004/07/07 04:08:44 jwand Exp $
##
##
## INPUT: 
##   Y:    matrix (n x n.cat) with counts of choices
##   Xb:   vector of means
##   se:   standard deviation of normal
##   taus: matrix (n x (n.cat-1)) with cumulative cutpoints
##   n.cat:number of categories per question
##
## OUTPUT:
##   vector of gradients
#######################################################################

gr.oprobit.vign.C <- function(Y,Xb,se,taus,V,V1,n.cat,do.test=0,verbose=FALSE)
{

  n    <- length(Xb)
  #nvarX <- NCOL(X)
  nvarV <- NCOL(V)
  nvarV1<- NCOL(V1)

  taus <- matrix(taus,nrow=n)

  if (verbose) {
    cat("GR.oprobit.vign\n")
    cat("n.cat",n.cat,
        "se",se,
        "dim taus",dim(taus),
        "n",n,
        "nvarV",nvarV,
        "nvarV1",nvarV1,
#        "nvarX",nvarX,
        "\n")
  }

  dLdTheta  <- 0.0
  dLdGamma <- rep(0.0, nvarV*(n.cat-2))
  dLdGamma1 <- rep(0.0, nvarV1)
  dLdSigma <- 0.0

  
  z <- .C("opllgrvign",
            as.integer(n), 
            as.integer(n.cat),  
          #as.integer(nvarX),  
            as.integer(nvarV),  
            as.integer(nvarV1),  
            as.double(se), 
            as.integer(Y), 
            as.double(Xb), 
            as.double(taus), 
            as.double(V),
            as.double(V1),
          #as.double(X),
          dLdSigma = as.double(dLdSigma),
          dLdTheta  = as.double(dLdTheta),
          dLdGamma = as.double(dLdGamma),
          dLdGamma1= as.double(dLdGamma1),
          PACKAGE = "anchors"
            );
  

  return( list(theta=z$dLdTheta ,
               sigma=z$dLdSigma,
               gamma=z$dLdGamma,
               gamma1=z$dLdGamma1))

}