Merging the FitExpectation branch into the trunk.
[openmx:openmx.git] / src / omxAlgebraFitFunction.c
1 /*
2  *  Copyright 2007-2012 The OpenMx Project
3  *
4  *  Licensed under the Apache License, Version 2.0 (the "License");
5  *  you may not use this file except in compliance with the License.
6  *  You may obtain a copy of the License at
7  *
8  *       http://www.apache.org/licenses/LICENSE-2.0
9  *
10  *   Unless required by applicable law or agreed to in writing, software
11  *   distributed under the License is distributed on an "AS IS" BASIS,
12  *   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13  *  See the License for the specific language governing permissions and
14  *  limitations under the License.
15  */
16
17 #include "omxAlgebraFunctions.h"
18 #include "omxFitFunctionTable.h"
19
20 #ifndef _OMX_ALGEBRA_FITFUNCTION_
21 #define _OMX_ALGEBRA_FITFUNCTION_ TRUE
22
23 typedef struct {
24
25         omxMatrix *algebra;
26
27 } omxAlgebraFitFunction;
28
29 void omxDestroyAlgebraFitFunction(omxFitFunction *off) {
30
31 }
32
33 void omxCallAlgebraFitFunction(omxFitFunction *off) {   // TODO: Figure out how to give access to other per-iteration structures.
34         if(OMX_DEBUG_ALGEBRA) {Rprintf("Beginning Algebra Fit Function Computation.\n");}
35         omxMatrix* algebra = ((omxAlgebraFitFunction*)(off->argStruct))->algebra;
36
37         omxRecompute(algebra);
38         
39         // This should really be checked elsewhere.
40         if(algebra->rows != 1 || algebra->cols != 1) {
41                 error("MxAlgebraFitFunction's fit function algebra does not evaluate to a 1x1 matrix.");
42         }
43         
44         off->matrix->data[0] = algebra->data[0];
45         
46         if(OMX_DEBUG) {Rprintf("Algebra Fit Function value is %f.\n", off->matrix->data[0]);}
47 }
48
49 omxRListElement* omxSetFinalReturnsAlgebraFitFunction(omxFitFunction *off, int *numReturns) {
50         *numReturns = 1;
51         omxRListElement* retVal = (omxRListElement*) R_alloc(1, sizeof(omxRListElement));
52
53         retVal[0].numValues = 1;
54         retVal[0].values = (double*) R_alloc(1, sizeof(double));
55         strncpy(retVal[0].label, "Minus2LogLikelihood", 20);
56         retVal[0].values[0] = omxMatrixElement(off->matrix, 0, 0);
57
58         return retVal;
59 }
60
61 void omxInitAlgebraFitFunction(omxFitFunction* off, SEXP rObj) {
62         
63         if(OMX_DEBUG && off->matrix->currentState->parentState == NULL) {
64                 Rprintf("Initializing Algebra fitFunction function.\n");
65         }
66         
67         SEXP newptr;
68         
69         omxAlgebraFitFunction *newObj = (omxAlgebraFitFunction*) R_alloc(1, sizeof(omxAlgebraFitFunction));
70         PROTECT(newptr = GET_SLOT(rObj, install("algebra")));
71         newObj->algebra = omxNewMatrixFromMxIndex(newptr, off->matrix->currentState);
72         if(OMX_DEBUG && off->matrix->currentState->parentState == NULL) {
73                 Rprintf("Algebra Fit Function Bound to Algebra %d\n", newObj->algebra);
74         }
75         UNPROTECT(1);
76         
77         off->computeFun = omxCallAlgebraFitFunction;
78         off->setFinalReturns = omxSetFinalReturnsAlgebraFitFunction;
79         off->destructFun = omxDestroyAlgebraFitFunction;
80         off->repopulateFun = NULL;
81         
82         off->argStruct = (void*) newObj;
83 }
84
85
86 #endif /* _OMX_ALGEBRA_FITFUNCTION_ */