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