Remove fitMatrix from omxState
[openmx:openmx.git] / src / omxExportBackendState.cpp
1 /*
2  *  Copyright 2007-2013 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 <sys/stat.h>
18
19 #include <R.h>
20 #include <Rinternals.h>
21 #include <Rdefines.h>
22
23 #include "omxDefines.h"
24 #include "omxState.h"
25 #include "omxNPSOLSpecific.h"
26 #include "npsolWrap.h"
27 #include "omxExportBackendState.h"
28
29 void omxFinalAlgebraCalculation(omxState *currentState, SEXP matrices, SEXP algebras, SEXP expectations) {
30         SEXP nextMat, algebra;
31         for(size_t index = 0; index < currentState->matrixList.size(); index++) {
32                 if(OMX_DEBUG) { Rprintf("Final Calculation and Copy of Matrix %d.\n", index); }
33                 omxMatrix* nextMatrix = currentState->matrixList[index];
34                 omxRecompute(nextMatrix);
35                 nextMat = omxExportMatrix(nextMatrix);
36                 SET_VECTOR_ELT(matrices, index, nextMat);
37         }
38
39         for(int index = 0; index < currentState->numAlgs; index++) {
40                 if(OMX_DEBUG) { Rprintf("Final Calculation and Copy of Algebra %d.\n", index); }
41                 omxMatrix* nextAlgebra = currentState->algebraList[index];
42                 omxRecompute(nextAlgebra);
43                 algebra = omxExportMatrix(nextAlgebra);
44                 /* If an fit function, populate attributes.  Will skip if not fit function. */
45                 omxFitFunction* currentFit = nextAlgebra->fitFunction;
46                 if(currentFit != NULL) {
47                         if(OMX_DEBUG) { Rprintf("Algebra %d is a fit function.\n", index); }
48                         if(currentFit->populateAttrFun != NULL) {
49                                 if(OMX_DEBUG) { Rprintf("Algebra %d has attribute population.\n", index); }
50                                 currentFit->populateAttrFun(currentFit, algebra);
51                     }
52                 }
53
54                 if(OMX_DEBUG) { Rprintf("Final Calculation of Algebra %d Complete.\n", index); }
55                 SET_VECTOR_ELT(algebras, index, algebra);
56         }
57         if(OMX_DEBUG) { Rprintf("All Algebras complete.\n"); }
58         
59         for(int index = 0; index < currentState->numExpects; index++) {
60                 if(OMX_DEBUG) { Rprintf("Final Calculation of Expectation %d.\n", index); }
61                 omxExpectation* nextExpectation = currentState->expectationList[index];
62                 omxExpectationRecompute(nextExpectation);
63                 SEXP rExpect;
64                 PROTECT(rExpect = allocVector(LGLSXP, 1));
65                 if(nextExpectation->populateAttrFun != NULL) {
66                         if(OMX_DEBUG) { Rprintf("Expectation %d has attribute population.\n", index); }
67                         nextExpectation->populateAttrFun(nextExpectation, rExpect);
68             }
69                 SET_VECTOR_ELT(expectations, index, rExpect);
70         }
71 }
72
73 void omxPopulateFitFunction(omxMatrix *om, MxRList *result)
74 {
75         omxFitFunction* off = om->fitFunction;
76         if (off == NULL || off->setFinalReturns == NULL) return;
77
78         if(OMX_DEBUG) { Rprintf("Expecting fit function Info....");}
79         int numEls;
80         SEXP oElement;
81         omxRListElement* orle = off->setFinalReturns(off, &numEls);
82         if(numEls == 0) return;
83
84         if(OMX_DEBUG) { Rprintf("Adding %d sets of fit function Info....", numEls);}
85         for(int i = 0; i < numEls; i++) {
86                 if (orle[i].numValues == -1) {
87                         PROTECT(oElement = allocMatrix(REALSXP, orle[i].rows, orle[i].cols));
88                 } else {
89                         PROTECT(oElement = allocVector(REALSXP, orle[i].numValues));
90                 }
91                 memcpy(REAL(oElement), orle[i].values, sizeof(double)*LENGTH(oElement)); // TODO avoid another copy
92                 result->push_back(std::make_pair(mkChar(orle[i].label), oElement));
93         }
94 }
95
96 void omxPopulateConfidenceIntervals(omxState* currentState, SEXP intervals, SEXP intervalCodes) {
97         int numInts = currentState->numIntervals;
98         if(OMX_DEBUG) { Rprintf("Populating CIs for %d fit functions.\n", numInts); }
99         double* interval = REAL(intervals);
100         int* intervalCode = INTEGER(intervalCodes);
101         for(int j = 0; j < numInts; j++) {
102                 omxConfidenceInterval *oCI = &(currentState->intervalList[j]);
103                 interval[j] = oCI->min;
104                 interval[j + numInts] = oCI->max;
105                 intervalCode[j] = oCI->lCode;
106                 intervalCode[j + numInts] = oCI->uCode;
107         }
108 }