Revert "Add option to checkpoint every evaluation"
[openmx:openmx.git] / src / ComputeNR.cpp
1 /*
2  *  Copyright 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 <valarray>
18
19 #include "omxState.h"
20 #include "omxFitFunction.h"
21 #include "omxExportBackendState.h"
22 #include "Compute.h"
23 #include "matrix.h"
24
25 #include "Eigen/Eigenvalues"
26
27 class ComputeNR : public omxCompute {
28         typedef omxCompute super;
29         omxMatrix *fitMatrix;
30
31         int maxIter;
32         double tolerance;
33         int verbose;
34         double priorSpeed;
35         int minorIter;
36         double refFit;
37
38         void lineSearch(FitContext *fc, int iter, double *maxAdj, double *maxAdjSigned,
39                         int *maxAdjParam, double *improvement);
40
41 public:
42         virtual void initFromFrontend(SEXP rObj);
43         virtual void computeImpl(FitContext *fc);
44         virtual void reportResults(FitContext *fc, MxRList *slots, MxRList *out);
45 };
46
47 class omxCompute *newComputeNewtonRaphson()
48 {
49         return new ComputeNR();
50 }
51
52 void ComputeNR::initFromFrontend(SEXP rObj)
53 {
54         super::initFromFrontend(rObj);
55
56         fitMatrix = omxNewMatrixFromSlot(rObj, globalState, "fitfunction");
57         setFreeVarGroup(fitMatrix->fitFunction, varGroup);
58         omxCompleteFitFunction(fitMatrix);
59
60         if (!fitMatrix->fitFunction->hessianAvailable ||
61             !fitMatrix->fitFunction->gradientAvailable) {
62                 Rf_error("Newton-Raphson requires derivatives");
63         }
64
65         SEXP slotValue;
66         Rf_protect(slotValue = R_do_slot(rObj, Rf_install("maxIter")));
67         maxIter = INTEGER(slotValue)[0];
68
69         Rf_protect(slotValue = R_do_slot(rObj, Rf_install("tolerance")));
70         tolerance = REAL(slotValue)[0];
71         if (tolerance <= 0) Rf_error("tolerance must be positive");
72
73         Rf_protect(slotValue = R_do_slot(rObj, Rf_install("verbose")));
74         verbose = Rf_asInteger(slotValue);
75 }
76
77 void omxApproxInvertPosDefTriangular(int dim, double *hess, double *ihess, double *stress)
78 {
79         int info;
80         int retries = 0;
81         const int maxRetries = 31; // assume >=32 bit integers
82         double adj = 0;
83         do {
84                 memcpy(ihess, hess, sizeof(double) * dim * dim);
85
86                 if (retries >= 1) {
87                         int th = maxRetries - retries;
88                         if (th > 0) {
89                                 adj = 1.0/(1 << th);
90                         } else {
91                                 adj = (1 << -th);
92                         }
93                         for (int px=0; px < dim; ++px) {
94                                 ihess[px * dim + px] += adj;
95                         }
96                 }
97
98                 Matrix ihessMat(ihess, dim, dim);
99                 info = InvertSymmetricPosDef(ihessMat, 'L');
100                 if (info == 0) break;
101         } while (++retries < maxRetries * 1.5);
102
103         if (info > 0) {
104                 // or just set stress to something high and return? TODO
105                 omxRaiseErrorf("Hessian is not even close to positive definite (order %d)", info);
106                 return;
107         }
108
109         if (stress) *stress = adj;
110 }
111
112 void omxApproxInvertPackedPosDefTriangular(int dim, int *mask, double *packedHess, double *stress)
113 {
114         int mdim = 0;
115         for (int dx=0; dx < dim; ++dx) if (mask[dx]) mdim += 1;
116         if (mdim == 0) {
117                 *stress = 0;
118                 return;
119         }
120
121         std::vector<double> hess(mdim * mdim, 0.0);
122         for (int d1=0, px=0, m1=-1; d1 < dim; ++d1) {
123                 if (mask[d1]) ++m1;
124                 for (int d2=0, m2=-1; d2 <= d1; ++d2) {
125                         if (mask[d2]) ++m2;
126                         if (mask[d1] && mask[d2]) {
127                                 hess[m2 * mdim + m1] = packedHess[px];
128                         }
129                         ++px;
130                 }
131         }
132
133         std::vector<double> ihess(mdim * mdim);
134         omxApproxInvertPosDefTriangular(mdim, hess.data(), ihess.data(), stress);
135
136         for (int d1=0, px=0, m1=-1; d1 < dim; ++d1) {
137                 if (mask[d1]) ++m1;
138                 for (int d2=0, m2=-1; d2 <= d1; ++d2) {
139                         if (mask[d2]) ++m2;
140                         if (mask[d1] && mask[d2]) {
141                                 packedHess[px] = *stress? 0 : ihess[m2 * mdim + m1];
142                         }
143                         ++px;
144                 }
145         }
146 }
147
148 void pda(const double *ar, int rows, int cols);
149
150 void ComputeNR::lineSearch(FitContext *fc, int iter, double *maxAdj, double *maxAdjSigned,
151                            int *maxAdjParam, double *improvement)
152 {
153         *maxAdjParam = -1;
154         const size_t numParam = varGroup->vars.size();
155         const double epsilon = .3;
156         bool steepestDescent = false;
157
158         Eigen::Map<Eigen::VectorXd> prevEst(fc->est, numParam);
159
160         int want = FF_COMPUTE_GRADIENT | FF_COMPUTE_IHESSIAN;
161         if (iter == 1) {
162                 want |= FF_COMPUTE_FIT;
163         }
164
165         Global->checkpointPrefit(fc, fc->est, false);
166         omxFitFunctionCompute(fitMatrix->fitFunction, want, fc);
167         if (iter == 1) refFit = fitMatrix->data[0];
168         fc->fit = refFit;
169         Global->checkpointPostfit(fc);
170
171         double speed = std::min(priorSpeed * 1.5, 1.0);
172         Eigen::VectorXd searchDir(fc->ihessGradProd());
173         double targetImprovement = searchDir.dot(fc->grad);
174         if (targetImprovement < tolerance) {
175                 if (verbose >= 4) mxLog("%s: target improvement %f too small, using steepest descent",
176                                         name, targetImprovement);
177                 steepestDescent = true;
178                 searchDir = fc->grad;
179                 targetImprovement = searchDir.norm();
180                 if (targetImprovement < tolerance) return;
181                 //speed = std::max(speed, .1);  // expect steepestDescent
182         }
183         
184         // This is based on the Goldstein test. However, we don't enforce
185         // a lower bound on the improvement.
186
187         int probeCount = 0;
188         Eigen::VectorXd trial;
189         trial.resize(numParam);
190         double bestSpeed = 0;
191         double bestImproved = 0;
192         double goodness = 0;
193         double bestFit = 0;
194
195         while (++probeCount < 16) {
196                 const double scaledTarget = speed * targetImprovement;
197                 if (scaledTarget < tolerance) return;
198                 trial = prevEst - speed * searchDir;
199                 ++minorIter;
200                 fc->copyParamToModel(globalState, trial.data());
201                 omxFitFunctionCompute(fitMatrix->fitFunction, FF_COMPUTE_FIT, fc);
202                 if (verbose >= 4) mxLog("%s: speed %f for target %.3g fit %f ref %f",
203                                         name, speed, scaledTarget, fitMatrix->data[0], refFit);
204                 if (!std::isfinite(fitMatrix->data[0])) {
205                         speed *= .1;
206                         continue;
207                 }
208                 const double improved = refFit - fitMatrix->data[0];
209                 if (improved <= 0) {
210                         speed *= .1;
211                         continue;
212                 }
213                 bestImproved = improved;
214                 bestSpeed = speed;
215                 bestFit = fitMatrix->data[0];
216                 goodness = improved / scaledTarget;
217                 if (verbose >= 3) mxLog("%s: viable speed %f for improvement %.3g goodness %f",
218                                         name, bestSpeed, bestImproved, goodness);
219                 break;
220         }
221         if (bestSpeed == 0) return;
222
223         if (0 && speed < 1 && goodness < epsilon) { // seems to be not worth it
224                 int retries = 4; // search up to 2.4*speed
225                 speed *= 1.25;
226                 while (--retries > 0 && goodness < epsilon) {
227                         ++probeCount;
228                         trial = prevEst - speed * searchDir;
229                         ++minorIter;
230                         fc->copyParamToModel(globalState, trial.data());
231                         omxFitFunctionCompute(fitMatrix->fitFunction, FF_COMPUTE_FIT, fc);
232                         if (!std::isfinite(fitMatrix->data[0])) break;
233                         const double improved = refFit - fitMatrix->data[0];
234                         if (bestImproved >= improved) break;
235                         bestFit = fitMatrix->data[0];
236                         bestImproved = improved;
237                         bestSpeed = speed;
238                         goodness = improved / (speed * targetImprovement);
239                 }
240         }
241
242         if (verbose >= 3) mxLog("%s: using steepestDescent %d probes %d speed %f improved %.3g",
243                                 name, steepestDescent, probeCount, bestSpeed, bestImproved);
244         if (!steepestDescent) priorSpeed = bestSpeed;
245
246         trial = prevEst - bestSpeed * searchDir;
247
248         *maxAdj = 0;
249         for (size_t px=0; px < numParam; ++px) {
250                 double oldEst = fc->est[px];
251                 double badj = fabs(oldEst - trial(px));
252                 if (*maxAdj < badj) {
253                         *maxAdj = badj;
254                         *maxAdjSigned = oldEst - trial(px);
255                         *maxAdjParam = px;
256                 }
257         }
258         memcpy(fc->est, trial.data(), sizeof(double) * numParam);
259
260         *improvement = bestImproved;
261         refFit = bestFit;
262 }
263
264 void ComputeNR::computeImpl(FitContext *fc)
265 {
266         // complain if there are non-linear constraints TODO
267
268         size_t numParam = varGroup->vars.size();
269         if (numParam <= 0) {
270                 Rf_error("Model has no free parameters");
271                 return;
272         }
273
274         fc->flavor.assign(numParam, NULL);
275
276         omxFitFunctionCompute(fitMatrix->fitFunction, FF_COMPUTE_PARAMFLAVOR, fc);
277
278         // flavor used for debug output only
279         for (size_t px=0; px < numParam; ++px) {
280                 if (!fc->flavor[px]) fc->flavor[px] = "?";
281         }
282
283         omxFitFunctionCompute(fitMatrix->fitFunction, FF_COMPUTE_PREOPTIMIZE, fc);
284
285         priorSpeed = 1;
286         minorIter = 0;
287         int startIter = fc->iterations;
288         bool converged = false;
289         double maxAdj = 0;
290         double maxAdjSigned = 0;
291         int maxAdjParam = -1;
292         const char *maxAdjFlavor = "?";
293
294         if (verbose >= 2) {
295                 mxLog("Welcome to Newton-Raphson (tolerance %.3g, max iter %d)",
296                       tolerance, maxIter);
297         }
298         while (1) {
299                 fc->iterations += 1;
300                 int iter = fc->iterations - startIter;
301                 if (verbose >= 2) {
302                         if (iter == 1) {
303                                 mxLog("%s: begin iter %d/%d", name, iter, maxIter);
304                         } else {
305                                 const char *pname = "none";
306                                 if (maxAdjParam >= 0) pname = fc->varGroup->vars[maxAdjParam]->name;
307                                 mxLog("%s: begin iter %d/%d (prev maxAdj %.3g for %s %s)",
308                                       name, iter, maxIter, maxAdjSigned, maxAdjFlavor, pname);
309                         }
310                 }
311
312                 fc->grad = Eigen::VectorXd::Zero(fc->numParam);
313                 fc->clearHessian();
314
315                 maxAdj = 0;
316                 double improvement = 0;
317                 lineSearch(fc, iter, &maxAdj, &maxAdjSigned, &maxAdjParam, &improvement);
318
319                 converged = improvement < tolerance;
320                 if (maxAdjParam >= 0) maxAdjFlavor = fc->flavor[maxAdjParam];
321
322                 fc->copyParamToModel(globalState);
323
324                 R_CheckUserInterrupt();
325
326                 if (converged || iter >= maxIter || isErrorRaised(globalState)) break;
327         }
328
329         if (converged) {
330                 fc->inform = INFORM_CONVERGED_OPTIMUM;
331                 fc->wanted |= FF_COMPUTE_BESTFIT;
332                 if (verbose >= 1) {
333                         int iter = fc->iterations - startIter;
334                         mxLog("%s: converged in %d cycles (%d minor iterations)", name, iter, minorIter);
335                 }
336         } else {
337                 fc->inform = INFORM_ITERATION_LIMIT;
338                 if (verbose >= 1) {
339                         int iter = fc->iterations - startIter;
340                         mxLog("%s: failed to converge after %d cycles (%d minor iterations)",
341                               name, iter, minorIter);
342                 }
343         }
344 }
345
346 void ComputeNR::reportResults(FitContext *fc, MxRList *slots, MxRList *output)
347 {
348         omxPopulateFitFunction(fitMatrix, output);
349 }