Revert "Store algebraList in std::vector"
[openmx:openmx.git] / src / omxOptimizer.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 "R.h"
18 #include <Rinternals.h>
19 #include <Rdefines.h>
20 #include <R_ext/Rdynload.h>
21 #include <R_ext/BLAS.h>
22 #include <R_ext/Lapack.h>
23 #include <sys/types.h>
24
25 #include "omxDefines.h"
26 #include "omxState.h"
27
28 void cacheFreeVarDependencies(omxState* os)
29 {
30         size_t numMats = os->matrixList.size();
31
32         os->markMatrices.clear();
33         os->markMatrices.resize(numMats + os->numAlgs, 0);
34
35         for(int freeVarIndex = 0; freeVarIndex < os->numFreeParams; freeVarIndex++) {
36                 omxFreeVar* freeVar = os->freeVarList + freeVarIndex;
37                 int *deps   = freeVar->deps;
38                 int numDeps = freeVar->numDeps;
39                 for (int index = 0; index < numDeps; index++) {
40                         os->markMatrices[deps[index] + numMats] = 1;
41                 }
42         }
43
44 }
45
46 void markFreeVarDependenciesHelper(omxState* os, int varNumber) {
47
48         int numDeps = os->freeVarList[varNumber].numDeps;
49         int *deps = os->freeVarList[varNumber].deps;
50
51         omxMatrix** algebraList = os->algebraList;
52
53         for (int i = 0; i < numDeps; i++) {
54                 int value = deps[i];
55
56                 if(value < 0) {
57                         omxMarkDirty(os->matrixList[~value]);
58                 } else {
59                         omxMarkDirty(algebraList[value]);
60                 }
61         }
62
63 }
64
65 void markFreeVarDependencies(omxState* os, int varNumber) {
66
67         int numChildren = os->numChildren;
68
69         markFreeVarDependenciesHelper(os, varNumber);
70
71         for(int i = 0; i < numChildren; i++) {
72                 markFreeVarDependencies(os->childList[i], varNumber);
73         }
74 }
75
76 static void handleFreeVarListHelper(omxState* os, double* x, int numVars, omxState *topState) {
77
78         int numChildren = os->numChildren;
79
80         if(OMX_DEBUG && os->parentState == NULL) {
81                 Rprintf("Processing Free Parameter Estimates.\n");
82                 Rprintf("Number of free parameters is %d.\n", numVars);
83         }
84
85         if(numVars == 0) return;
86
87         omxFreeVar* freeVarList = os->freeVarList;
88         omxMatrix** algebraList = os->algebraList;
89         size_t numMats = os->matrixList.size();
90         int numAlgs = os->numAlgs;
91
92         os->computeCount++;
93
94         if(OMX_VERBOSE && os->parentState == NULL) {
95                 Rprintf("--------------------------\n");
96                 Rprintf("Call: %d.%d (%d)\n", os->majorIteration, os->minorIteration, os->computeCount);
97                 Rprintf("Estimates: [");
98                 for(int k = 0; k < numVars; k++) {
99                         Rprintf(" %f", x[k]);
100                 }
101                 Rprintf("] \n");
102                 Rprintf("--------------------------\n");
103         }
104
105         /* Fill in Free Var Estimates */
106         for(int k = 0; k < numVars; k++) {
107                 omxFreeVar* freeVar = freeVarList + k;
108                 // if(OMX_DEBUG) { Rprintf("%d: %f - %d\n", k,  x[k], freeVarList[k].numLocations); }
109                 for(size_t l = 0; l < freeVar->locations.size(); l++) {
110                         omxFreeVarLocation *loc = &freeVar->locations[l];
111                         omxMatrix *matrix = os->matrixList[loc->matrix];
112                         int row = loc->row;
113                         int col = loc->col;
114                         omxSetMatrixElement(matrix, row, col, x[k]);
115                         if(OMX_DEBUG && os->parentState == NULL) {
116                                 Rprintf("Setting location (%d, %d) of matrix %d to value %f for var %d\n",
117                                         row, col, loc->matrix, x[k], k);
118                         }
119                 }
120         }
121
122         for(size_t i = 0; i < numMats; i++) {
123                 if (topState->markMatrices[i]) {
124                         int offset = ~(i - numMats);
125                         omxMarkDirty(os->matrixList[offset]);
126                 }
127         }
128
129         for(int i = 0; i < numAlgs; i++) {
130                 if (topState->markMatrices[i + numMats]) {
131                         omxMarkDirty(algebraList[i]);
132                 }
133         }
134
135         for(int i = 0; i < numChildren; i++) {
136                 handleFreeVarListHelper(os->childList[i], x, numVars, topState);
137         }
138 }
139
140 /* Sub Free Vars Into Appropriate Slots */
141 void handleFreeVarList(omxState* os, double* x, int numVars) {
142         handleFreeVarListHelper(os, x, numVars, os);
143 }
144
145 /* get the list element named str, or return NULL */
146 SEXP getListElement(SEXP list, const char *str) {
147 /* Attribution: modified from the code given in Writing R Extensions */
148         SEXP elmt = R_NilValue, names = getAttrib(list, R_NamesSymbol);
149         int i;
150         for (i = 0; i < length(list); i++)
151                 if(strcmp(CHAR(STRING_ELT(names, i)), str) == 0) {
152                         elmt = VECTOR_ELT(list, i);
153                         break;
154                 }
155         return elmt;
156 }
157
158 SEXP getVar(SEXP str, SEXP env) {
159 /* Attribution: modified from the code given in Writing R Extensions */
160    SEXP ans;
161    if(!isString(str) || length(str) != 1)
162         error("getVar: variable name is not a single string");
163    if(!isEnvironment(env))
164         error("getVar: env should be an environment");
165    ans = findVar(install(CHAR(STRING_ELT(str, 0))), env);
166    return(ans);
167 }
168