Auto-tune Newton-Raphson
[openmx:openmx.git] / src / Compute.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 "omxDefines.h"
18 #include "Compute.h"
19 #include "omxState.h"
20 #include "omxExportBackendState.h"
21 #include "omxRFitFunction.h"
22
23 void FitContext::init()
24 {
25         size_t numParam = varGroup->vars.size();
26         fit = parent? parent->fit : 0;
27         est = new double[numParam];
28         flavor = new int[numParam];
29         grad = new double[numParam];
30         hess = new double[numParam * numParam];
31         ihess = new double[numParam * numParam];
32 }
33
34 FitContext::FitContext(std::vector<double> &startingValues)
35 {
36         parent = NULL;
37         varGroup = Global->freeGroup[0];
38         init();
39
40         size_t numParam = varGroup->vars.size();
41         if (startingValues.size() != numParam) error("mismatch");
42         memcpy(est, startingValues.data(), sizeof(double) * numParam);
43
44         for (size_t v1=0; v1 < numParam; v1++) {
45                 grad[v1] = nan("unset");
46                 for (size_t v2=0; v2 < numParam; v2++) {
47                         hess[v1 * numParam + v2] = nan("unset");
48                 }
49         }
50 }
51
52 // arg to control what to copy? usually don't want everything TODO
53 FitContext::FitContext(FitContext *parent, FreeVarGroup *varGroup)
54 {
55         this->parent = parent;
56         this->varGroup = varGroup;
57         init();
58
59         FreeVarGroup *src = parent->varGroup;
60         FreeVarGroup *dest = varGroup;
61         size_t svars = parent->varGroup->vars.size();
62         size_t dvars = varGroup->vars.size();
63         if (dvars == 0) return;
64
65         size_t d1 = 0;
66         for (size_t s1=0; s1 < src->vars.size(); ++s1) {
67                 if (src->vars[s1] != dest->vars[d1]) continue;
68                 est[d1] = parent->est[s1];
69                 grad[d1] = parent->grad[s1];
70
71                 size_t d2 = 0;
72                 for (size_t s2=0; s2 < src->vars.size(); ++s2) {
73                         if (src->vars[s2] != dest->vars[d2]) continue;
74                         hess[d1 * dvars + d2] = parent->hess[s1 * svars + s2];
75                         if (++d2 == dvars) break;
76                 }
77
78                 // ihess TODO?
79
80                 if (++d1 == dvars) break;
81         }
82         if (d1 != dvars) error("Parent free parameter group is not a superset");
83
84         // pda(parent->est, 1, svars);
85         // pda(est, 1, dvars);
86         // pda(parent->grad, 1, svars);
87         // pda(grad, 1, dvars);
88         // pda(parent->hess, svars, svars);
89         // pda(hess, dvars, dvars);
90 }
91
92 void FitContext::copyParamToModel(omxMatrix *mat)
93 { copyParamToModel(mat->currentState); }
94
95 void FitContext::copyParamToModel(omxMatrix *mat, double *at)
96 { copyParamToModel(mat->currentState, at); }
97
98 void FitContext::updateParentAndFree()
99 {
100         FreeVarGroup *src = varGroup;
101         FreeVarGroup *dest = parent->varGroup;
102         size_t svars = varGroup->vars.size();
103         size_t dvars = parent->varGroup->vars.size();
104
105         parent->fit = fit;
106
107         if (svars > 0) {
108                 size_t s1 = 0;
109                 for (size_t d1=0; d1 < dest->vars.size(); ++d1) {
110                         if (dest->vars[d1] != src->vars[s1]) continue;
111                         parent->est[d1] = est[s1];
112                         parent->grad[d1] = grad[s1];
113
114                         size_t s2 = 0;
115                         for (size_t d2=0; d2 < dest->vars.size(); ++d2) {
116                                 if (dest->vars[d2] != src->vars[s2]) continue;
117                                 parent->hess[d1 * dvars + d2] = hess[s1 * svars + s2];
118                                 if (++s2 == svars) break;
119                         }
120
121                         // ihess TODO?
122
123                         if (++s1 == svars) break;
124                 }
125         }
126         
127         // pda(est, 1, svars);
128         // pda(parent->est, 1, dvars);
129         // pda(grad, 1, svars);
130         // pda(parent->grad, 1, dvars);
131         // pda(hess, svars, svars);
132         // pda(parent->hess, dvars, dvars);
133
134         delete this;
135 }
136
137 void FitContext::log(const char *where, int what)
138 {
139         size_t count = varGroup->vars.size();
140         std::string buf(where);
141         buf += " ---\n";
142         if (what & FF_COMPUTE_FIT) buf += string_snprintf("fit: %.5f\n", fit);
143         if (what & FF_COMPUTE_ESTIMATE) {
144                 buf += string_snprintf("est %lu: c(", count);
145                 for (size_t vx=0; vx < count; ++vx) {
146                         buf += string_snprintf("%.5f", est[vx]);
147                         if (vx < count - 1) buf += ", ";
148                 }
149                 buf += ")\n";
150         }
151         if (what & FF_COMPUTE_GRADIENT) {
152                 buf += string_snprintf("grad %lu: c(", count);
153                 for (size_t vx=0; vx < count; ++vx) {
154                         buf += string_snprintf("%.5f", grad[vx]);
155                         if (vx < count - 1) buf += ", ";
156                 }
157                 buf += ")\n";
158         }
159         if (what & FF_COMPUTE_HESSIAN) {
160                 buf += string_snprintf("hess %lux%lu: c(", count, count);
161                 for (size_t v1=0; v1 < count; ++v1) {
162                         for (size_t v2=0; v2 < count; ++v2) {
163                                 buf += string_snprintf("%.5f", hess[v1 * count + v2]);
164                                 if (v1 < count-1 || v2 < count-1) buf += ", ";
165                         }
166                         buf += "\n";
167                 }
168                 buf += ")\n";
169         }
170         if (what & FF_COMPUTE_IHESSIAN) {
171                 buf += string_snprintf("ihess %lux%lu: c(", count, count);
172                 for (size_t v1=0; v1 < count; ++v1) {
173                         for (size_t v2=0; v2 < count; ++v2) {
174                                 buf += string_snprintf("%.5f", ihess[v1 * count + v2]);
175                                 if (v1 < count-1 || v2 < count-1) buf += ", ";
176                         }
177                         buf += "\n";
178                 }
179                 buf += ")\n";
180         }
181         mxLogBig(buf);
182 }
183
184 void FitContext::fixHessianSymmetry(int want)
185 {
186         size_t numParam = varGroup->vars.size();
187
188         if (want & FF_COMPUTE_HESSIAN) {
189                 for (size_t h1=1; h1 < numParam; h1++) {
190                         for (size_t h2=0; h2 < h1; h2++) {
191                                 if (hess[h2 * numParam + h1] != 0) {
192                                         omxRaiseErrorf(globalState, "Hessian is not upper triangular");
193                                         break;
194                                 }
195                                 hess[h2 * numParam + h1] = hess[h1 * numParam + h2];
196                         }
197                 }
198         }
199
200         if (want & FF_COMPUTE_IHESSIAN) {
201                 for (size_t h1=1; h1 < numParam; h1++) {
202                         for (size_t h2=0; h2 < h1; h2++) {
203                                 if (ihess[h2 * numParam + h1] != 0) {
204                                         omxRaiseErrorf(globalState, "Inverse Hessian is not upper triangular");
205                                         break;
206                                 }
207                                 ihess[h2 * numParam + h1] = ihess[h1 * numParam + h2];
208                         }
209                 }
210         }
211 }
212
213 static void omxRepopulateRFitFunction(omxFitFunction* oo, double* x, int n)
214 {
215         omxRFitFunction* rFitFunction = (omxRFitFunction*)oo->argStruct;
216
217         SEXP theCall, estimate;
218
219         PROTECT(estimate = allocVector(REALSXP, n));
220         double *est = REAL(estimate);
221         for(int i = 0; i < n ; i++) {
222                 est[i] = x[i];
223         }
224
225         PROTECT(theCall = allocVector(LANGSXP, 4));
226
227         SETCAR(theCall, install("imxUpdateModelValues"));
228         SETCADR(theCall, rFitFunction->model);
229         SETCADDR(theCall, rFitFunction->flatModel);
230         SETCADDDR(theCall, estimate);
231
232         REPROTECT(rFitFunction->model = eval(theCall, R_GlobalEnv), rFitFunction->modelIndex);
233
234         UNPROTECT(2); // theCall, estimate
235 }
236
237 void FitContext::copyParamToModel(omxState* os)
238 {
239         copyParamToModel(os, est);
240 }
241
242 void FitContext::copyParamToModel(omxState* os, double *at)
243 {
244         size_t numParam = varGroup->vars.size();
245         if(OMX_DEBUG) {
246                 mxLog("Copying %lu free parameter estimates to model %p", numParam, os);
247         }
248
249         if(numParam == 0) return;
250
251         // Confidence Intervals & Hessian Calculation probe the parameter space
252         // near the best estimate. If stale, we need to restore the best estimate
253         // before returning results to the user.
254         os->stale = at != est;
255
256         os->computeCount++;
257
258         if(OMX_VERBOSE) {
259                 std::string buf;
260                 buf += string_snprintf("Call: %d.%d (%ld) ", os->majorIteration, os->minorIteration, os->computeCount);
261                 buf += ("Estimates: [");
262                 for(size_t k = 0; k < numParam; k++) {
263                         buf += string_snprintf(" %f", at[k]);
264                 }
265                 buf += ("]\n");
266                 mxLogBig(buf);
267         }
268
269         for(size_t k = 0; k < numParam; k++) {
270                 omxFreeVar* freeVar = varGroup->vars[k];
271                 for(size_t l = 0; l < freeVar->locations.size(); l++) {
272                         omxFreeVarLocation *loc = &freeVar->locations[l];
273                         omxMatrix *matrix = os->matrixList[loc->matrix];
274                         int row = loc->row;
275                         int col = loc->col;
276                         omxSetMatrixElement(matrix, row, col, at[k]);
277                         if(OMX_DEBUG) {
278                                 mxLog("Setting location (%d, %d) of matrix %d to value %f for var %lu",
279                                         row, col, loc->matrix, at[k], k);
280                         }
281                 }
282         }
283
284         if (RFitFunction) omxRepopulateRFitFunction(RFitFunction, at, numParam);
285
286         varGroup->markDirty(os);
287
288         if (!os->childList) return;
289
290         for(int i = 0; i < Global->numChildren; i++) {
291                 copyParamToModel(os->childList[i], at);
292         }
293 }
294
295 FitContext::~FitContext()
296 {
297         delete [] est;
298         delete [] flavor;
299         delete [] grad;
300         delete [] hess;
301         delete [] ihess;
302 }
303
304 omxFitFunction *FitContext::RFitFunction = NULL;
305
306 void FitContext::setRFitFunction(omxFitFunction *rff)
307 {
308         if (rff) {
309                 Global->numThreads = 1;
310                 if (RFitFunction) {
311                         error("You can only create 1 MxRFitFunction per independent model");
312                 }
313         }
314         RFitFunction = rff;
315 }
316
317 omxCompute::omxCompute()
318 {
319         varGroup = NULL;
320 }
321
322 omxCompute::~omxCompute()
323 {}
324
325 void omxCompute::initFromFrontend(SEXP rObj)
326 {
327         SEXP slotValue;
328         PROTECT(slotValue = GET_SLOT(rObj, install("id")));
329         if (length(slotValue) == 1) {
330                 int id = INTEGER(slotValue)[0];
331                 varGroup = Global->findVarGroup(id);
332         }
333
334         if (!varGroup) {
335                 if (!R_has_slot(rObj, install("free.set"))) {
336                         varGroup = Global->freeGroup[0];
337                 } else {
338                         PROTECT(slotValue = GET_SLOT(rObj, install("free.set")));
339                         if (length(slotValue) != 0) {
340                                 // it's a free.set with no free variables
341                                 varGroup = Global->findVarGroup(-1);
342                         } else {
343                                 varGroup = Global->freeGroup[0];
344                         }
345                 }
346         }
347 }
348
349 class omxComputeSequence : public omxCompute {
350         typedef omxCompute super;
351         std::vector< omxCompute* > clist;
352
353  public:
354         virtual void initFromFrontend(SEXP rObj);
355         virtual void compute(FitContext *fc);
356         virtual void reportResults(FitContext *fc, MxRList *out);
357         virtual double getOptimizerStatus();
358         virtual ~omxComputeSequence();
359 };
360
361 class omxComputeIterate : public omxCompute {
362         typedef omxCompute super;
363         std::vector< omxCompute* > clist;
364         int maxIter;
365         double tolerance;
366         int verbose;
367
368  public:
369         virtual void initFromFrontend(SEXP rObj);
370         virtual void compute(FitContext *fc);
371         virtual void reportResults(FitContext *fc, MxRList *out);
372         virtual double getOptimizerStatus();
373         virtual ~omxComputeIterate();
374 };
375
376 class omxComputeOnce : public omxCompute {
377         typedef omxCompute super;
378         std::vector< omxMatrix* > algebras;
379         std::vector< omxExpectation* > expectations;
380         bool adjustStart;
381         const char *context;
382         bool gradient;
383         bool hessian;
384         bool ihessian;
385
386  public:
387         virtual void initFromFrontend(SEXP rObj);
388         virtual void compute(FitContext *fc);
389         virtual void reportResults(FitContext *fc, MxRList *out);
390 };
391
392 static class omxCompute *newComputeSequence()
393 { return new omxComputeSequence(); }
394
395 static class omxCompute *newComputeIterate()
396 { return new omxComputeIterate(); }
397
398 static class omxCompute *newComputeOnce()
399 { return new omxComputeOnce(); }
400
401 struct omxComputeTableEntry {
402         char name[32];
403         omxCompute *(*ctor)();
404 };
405
406 static const struct omxComputeTableEntry omxComputeTable[] = {
407         {"MxComputeEstimatedHessian", &newComputeEstimatedHessian},
408         {"MxComputeGradientDescent", &newComputeGradientDescent},
409         {"MxComputeSequence", &newComputeSequence },
410         {"MxComputeIterate", &newComputeIterate },
411         {"MxComputeOnce", &newComputeOnce },
412         {"MxComputeNewtonRaphson", &newComputeNewtonRaphson},
413 };
414
415 omxCompute *omxNewCompute(omxState* os, const char *type)
416 {
417         omxCompute *got = NULL;
418
419         for (size_t fx=0; fx < OMX_STATIC_ARRAY_SIZE(omxComputeTable); fx++) {
420                 const struct omxComputeTableEntry *entry = omxComputeTable + fx;
421                 if(strcmp(type, entry->name) == 0) {
422                         got = entry->ctor();
423                         break;
424                 }
425         }
426
427         if (!got) error("Compute %s is not implemented", type);
428
429         return got;
430 }
431
432 void omxComputeSequence::initFromFrontend(SEXP rObj)
433 {
434         super::initFromFrontend(rObj);
435
436         SEXP slotValue;
437         PROTECT(slotValue = GET_SLOT(rObj, install("steps")));
438
439         for (int cx = 0; cx < length(slotValue); cx++) {
440                 SEXP step = VECTOR_ELT(slotValue, cx);
441                 SEXP s4class;
442                 PROTECT(s4class = STRING_ELT(getAttrib(step, install("class")), 0));
443                 omxCompute *compute = omxNewCompute(globalState, CHAR(s4class));
444                 compute->initFromFrontend(step);
445                 if (isErrorRaised(globalState)) break;
446                 clist.push_back(compute);
447         }
448 }
449
450 void omxComputeSequence::compute(FitContext *fc)
451 {
452         for (size_t cx=0; cx < clist.size(); ++cx) {
453                 FitContext *context = fc;
454                 if (fc->varGroup != clist[cx]->varGroup) {
455                         context = new FitContext(fc, clist[cx]->varGroup);
456                 }
457                 clist[cx]->compute(context);
458                 if (context != fc) context->updateParentAndFree();
459                 if (isErrorRaised(globalState)) break;
460         }
461 }
462
463 void omxComputeSequence::reportResults(FitContext *fc, MxRList *out)
464 {
465         // put this stuff in a new list?
466         // merge with Iterate TODO
467         for (size_t cx=0; cx < clist.size(); ++cx) {
468                 FitContext *context = fc;
469                 if (fc->varGroup != clist[cx]->varGroup) {
470                         context = new FitContext(fc, clist[cx]->varGroup);
471                 }
472                 clist[cx]->reportResults(context, out);
473                 if (context != fc) context->updateParentAndFree();
474                 if (isErrorRaised(globalState)) break;
475         }
476 }
477
478 double omxComputeSequence::getOptimizerStatus()
479 {
480         // for backward compatibility, not indended to work generally
481         for (size_t cx=0; cx < clist.size(); ++cx) {
482                 double got = clist[cx]->getOptimizerStatus();
483                 if (got != NA_REAL) return got;
484         }
485         return NA_REAL;
486 }
487
488 omxComputeSequence::~omxComputeSequence()
489 {
490         for (size_t cx=0; cx < clist.size(); ++cx) {
491                 delete clist[cx];
492         }
493 }
494
495 void omxComputeIterate::initFromFrontend(SEXP rObj)
496 {
497         SEXP slotValue;
498
499         super::initFromFrontend(rObj);
500
501         PROTECT(slotValue = GET_SLOT(rObj, install("maxIter")));
502         maxIter = INTEGER(slotValue)[0];
503
504         PROTECT(slotValue = GET_SLOT(rObj, install("tolerance")));
505         tolerance = REAL(slotValue)[0];
506         if (tolerance <= 0) error("tolerance must be positive");
507
508         PROTECT(slotValue = GET_SLOT(rObj, install("steps")));
509
510         for (int cx = 0; cx < length(slotValue); cx++) {
511                 SEXP step = VECTOR_ELT(slotValue, cx);
512                 SEXP s4class;
513                 PROTECT(s4class = STRING_ELT(getAttrib(step, install("class")), 0));
514                 omxCompute *compute = omxNewCompute(globalState, CHAR(s4class));
515                 compute->initFromFrontend(step);
516                 if (isErrorRaised(globalState)) break;
517                 clist.push_back(compute);
518         }
519
520         PROTECT(slotValue = GET_SLOT(rObj, install("verbose")));
521         verbose = asInteger(slotValue);
522 }
523
524 void omxComputeIterate::compute(FitContext *fc)
525 {
526         int iter = 0;
527         double prevFit = 0;
528         double change = tolerance * 10;
529         while (1) {
530                 for (size_t cx=0; cx < clist.size(); ++cx) {
531                         FitContext *context = fc;
532                         if (fc->varGroup != clist[cx]->varGroup) {
533                                 context = new FitContext(fc, clist[cx]->varGroup);
534                         }
535                         clist[cx]->compute(context);
536                         if (context != fc) context->updateParentAndFree();
537                         if (isErrorRaised(globalState)) break;
538                 }
539                 if (fc->fit == 0) {
540                         warning("Fit estimated at 0; something is wrong");
541                         break;
542                 }
543                 if (prevFit != 0) {
544                         change = prevFit - fc->fit;
545                         if (verbose) mxLog("fit %.9g change %.9g", fc->fit, change);
546                 }
547                 prevFit = fc->fit;
548                 if (isErrorRaised(globalState) || ++iter > maxIter || fabs(change) < tolerance) break;
549         }
550 }
551
552 void omxComputeIterate::reportResults(FitContext *fc, MxRList *out)
553 {
554         for (size_t cx=0; cx < clist.size(); ++cx) {
555                 FitContext *context = fc;
556                 if (fc->varGroup != clist[cx]->varGroup) {
557                         context = new FitContext(fc, clist[cx]->varGroup);
558                 }
559                 clist[cx]->reportResults(context, out);
560                 if (context != fc) context->updateParentAndFree();
561                 if (isErrorRaised(globalState)) break;
562         }
563 }
564
565 double omxComputeIterate::getOptimizerStatus()
566 {
567         // for backward compatibility, not indended to work generally
568         for (size_t cx=0; cx < clist.size(); ++cx) {
569                 double got = clist[cx]->getOptimizerStatus();
570                 if (got != NA_REAL) return got;
571         }
572         return NA_REAL;
573 }
574
575 omxComputeIterate::~omxComputeIterate()
576 {
577         for (size_t cx=0; cx < clist.size(); ++cx) {
578                 delete clist[cx];
579         }
580 }
581
582 void omxComputeOnce::initFromFrontend(SEXP rObj)
583 {
584         super::initFromFrontend(rObj);
585
586         SEXP slotValue;
587         PROTECT(slotValue = GET_SLOT(rObj, install("what")));
588         for (int wx=0; wx < length(slotValue); ++wx) {
589                 int objNum = INTEGER(slotValue)[wx];
590                 if (objNum >= 0) {
591                         omxMatrix *algebra = globalState->algebraList[objNum];
592                         if (algebra->fitFunction) {
593                                 setFreeVarGroup(algebra->fitFunction, varGroup);
594                                 omxCompleteFitFunction(algebra);
595                         }
596                         algebras.push_back(algebra);
597                 } else {
598                         omxExpectation *expectation = globalState->expectationList[~objNum];
599                         setFreeVarGroup(expectation, varGroup);
600                         omxCompleteExpectation(expectation);
601                         expectations.push_back(expectation);
602                 }
603         }
604
605         context = "";
606
607         PROTECT(slotValue = GET_SLOT(rObj, install("context")));
608         if (length(slotValue) == 0) {
609                 // OK
610         } else if (length(slotValue) == 1) {
611                 SEXP elem;
612                 PROTECT(elem = STRING_ELT(slotValue, 0));
613                 context = CHAR(elem);
614         }
615
616         PROTECT(slotValue = GET_SLOT(rObj, install("gradient")));
617         gradient = asLogical(slotValue);
618
619         PROTECT(slotValue = GET_SLOT(rObj, install("hessian")));
620         hessian = asLogical(slotValue);
621
622         PROTECT(slotValue = GET_SLOT(rObj, install("ihessian")));
623         ihessian = asLogical(slotValue);
624
625         if (algebras.size() == 1 && algebras[0]->fitFunction) {
626                 omxFitFunction *ff = algebras[0]->fitFunction;
627                 if (gradient && !ff->gradientAvailable) {
628                         error("Gradient requested but not available");
629                 }
630                 if ((hessian || ihessian) && !ff->hessianAvailable) {
631                         error("Hessian requested but not available");
632                 }
633         }
634
635         PROTECT(slotValue = GET_SLOT(rObj, install("adjustStart")));
636         adjustStart = asLogical(slotValue);
637 }
638
639 void omxComputeOnce::compute(FitContext *fc)
640 {
641         if (algebras.size()) {
642                 int want = FF_COMPUTE_FIT;
643                 size_t numParam = fc->varGroup->vars.size();
644                 if (gradient) {
645                         want |= FF_COMPUTE_GRADIENT;
646                         OMXZERO(fc->grad, numParam);
647                 }
648                 if (hessian) {
649                         want |= FF_COMPUTE_HESSIAN;
650                         OMXZERO(fc->hess, numParam * numParam);
651                 }
652                 if (ihessian) {
653                         want |= FF_COMPUTE_IHESSIAN;
654                         OMXZERO(fc->ihess, numParam * numParam);
655                 }
656
657                 for (size_t wx=0; wx < algebras.size(); ++wx) {
658                         omxMatrix *algebra = algebras[wx];
659                         if (algebra->fitFunction) {
660                                 if (adjustStart) {
661                                         omxFitFunctionCompute(algebra->fitFunction, FF_COMPUTE_PREOPTIMIZE, fc);
662                                         fc->copyParamToModel(globalState);
663                                 }
664
665                                 omxFitFunctionCompute(algebra->fitFunction, want, fc);
666                                 fc->fit = algebra->data[0];
667                                 fc->fixHessianSymmetry(want);
668                         } else {
669                                 omxForceCompute(algebra);
670                         }
671                 }
672         } else if (expectations.size()) {
673                 for (size_t wx=0; wx < expectations.size(); ++wx) {
674                         omxExpectation *expectation = expectations[wx];
675                         omxExpectationCompute(expectation, context);
676                 }
677         }
678 }
679
680 void omxComputeOnce::reportResults(FitContext *fc, MxRList *out)
681 {
682         if (algebras.size()==0 || algebras[0]->fitFunction == NULL) return;
683
684         omxMatrix *algebra = algebras[0];
685
686         omxPopulateFitFunction(algebra, out);
687
688         out->push_back(std::make_pair(mkChar("minimum"), ScalarReal(fc->fit)));
689         out->push_back(std::make_pair(mkChar("Minus2LogLikelihood"), ScalarReal(fc->fit)));
690
691         size_t numFree = fc->varGroup->vars.size();
692         if (numFree) {
693                 SEXP estimate;
694                 PROTECT(estimate = allocVector(REALSXP, numFree));
695                 memcpy(REAL(estimate), fc->est, sizeof(double)*numFree);
696                 out->push_back(std::make_pair(mkChar("estimate"), estimate));
697
698                 if (gradient) {
699                         SEXP Rgradient;
700                         PROTECT(Rgradient = allocVector(REALSXP, numFree));
701                         memcpy(REAL(Rgradient), fc->grad, sizeof(double) * numFree);
702                         out->push_back(std::make_pair(mkChar("gradient"), Rgradient));
703                 }
704
705                 if (hessian) {
706                         SEXP Rhessian;
707                         PROTECT(Rhessian = allocMatrix(REALSXP, numFree, numFree));
708                         memcpy(REAL(Rhessian), fc->hess, sizeof(double) * numFree * numFree);
709                         out->push_back(std::make_pair(mkChar("hessian"), Rhessian));
710                 }
711
712                 if (ihessian) {
713                         SEXP Rihessian;
714                         PROTECT(Rihessian = allocMatrix(REALSXP, numFree, numFree));
715                         memcpy(REAL(Rihessian), fc->ihess, sizeof(double) * numFree * numFree);
716                         out->push_back(std::make_pair(mkChar("ihessian"), Rihessian));
717                 }
718         }
719 }