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