1checkBhhhGrad <- function( g, theta, analytic, fixed=NULL) {
2   ## This function controls if the user-supplied analytic or
3   ## numeric gradient of the right dimension.
4   ## If not, signals an error.
5   ##
6   ## analytic:   logical, do we have a user-supplied analytic
7   ##             gradient?
8   if(is.null(fixed)) {
9      activePar <- rep(T, length=length(theta))
10   }
11   else {
12      activePar <- !fixed
13   }
14   if( analytic ) {
15         ## Gradient supplied by the user.
16         ## Check whether the gradient has enough rows (about enough
17         ## observations in data)
18         if( !is.matrix( g ) ) {
19            stop("gradient is not a matrix but of class '", class( g ), "';\n",
20                 "the BHHH method requires that the gradient function\n",
21                 "(argument 'grad') returns a numeric matrix,\n",
22                 "where each row must correspond to the gradient(s)\n",
23                 "of the log-likelihood function at an individual\n",
24                 "(independent) observation and each column must\n",
25                 "correspond to a parameter" )
26         } else if( nrow( g ) < length( theta[activePar] ) ) {
27            stop( "the matrix returned by the gradient function",
28               " (argument 'grad') must have at least as many",
29               " rows as the number of parameters (", length( theta ), "),",
30               " where each row must correspond to the gradients",
31               " of the log-likelihood function of an individual",
32               " (independent) observation:\n",
33               " currently, there are (is) ", length( theta ), " parameter(s)",
34               " but the gradient matrix has only ", nrow( g ), " row(s)" )
35         } else if( ncol( g ) != length( theta ) ) {
36            stop( "the matrix returned by the gradient function",
37               " (argument 'grad') must have exactly as many columns",
38               " as the number of parameters:\n",
39               " currently, there are (is) ", length( theta ), " parameter(s)",
40               " but the gradient matrix has ", ncol( g ), " columns" )
41         }
42      } else {
43         ## numeric gradient
44         ## Check whether the gradient has enough rows.  This is the case
45         ## if and only if loglik has enough rows, hence the error message
46         ## about loglik.
47         if( !is.matrix( g ) || nrow( g ) == 1 ) {
48            stop( "if the gradients (argument 'grad') are not provided by the user,",
49               " the BHHH method requires that the log-likelihood function",
50               " (argument 'fn') returns a numeric vector,",
51               " where each element must be the log-likelihood value corresponding",
52               " to an individual (independent) observation" )
53         }
54         if( nrow( g ) < length( theta ) ) {
55            stop( "the vector returned by the log-likelihood function",
56               " (argument 'fn') must have at least as many elements",
57               " as the number of parameters,",
58               " where each element must be the log-likelihood value corresponding",
59               " to an individual (independent) observation:\n",
60               " currently, there are (is) ", length( theta ), " parameter(s)",
61               " but the log likelihood function return only ", nrow( g ),
62               " element(s)" )
63         }
64      }
65      return( NULL )
66}
67