scilab/modules/optimization/src/cpp/optimizationfunctions.cpp

   1 /*
   2  *  Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
   3  *  Copyright (C) 2011 - DIGITEO - Cedric DELAMARRE
   4  *
   5  *  This file must be used under the terms of the CeCILL.
   6  *  This source file is licensed as described in the file COPYING, which
   7  *  you should have received as part of this distribution.  The terms
   8  *  are also available at
   9  *  http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
  10  *
  11  */
  12 /*--------------------------------------------------------------------------*/
  13 #include "execvisitor.hxx"
  14 #include "string.hxx"
  15 #include "double.hxx"
  16 #include "optimizationfunctions.hxx"
  17
  18 extern "C"
  19 {
  20 #include "elem_common.h"
  21 #include "scioptimfunctions.h"
  22 #include "localization.h"
  23 }
  24
  25 /*
  26 ** optimization functions
  27 ** \{
  28 */
  29
  30 OptimizationFunctions* Optimization::m_OptimizationFunctions;
  31
  32 void Optimization::addOptimizationFunctions(OptimizationFunctions* _opFunction)
  33 {
  34     m_OptimizationFunctions = _opFunction;
  35 }
  36
  37 void Optimization::removeOptimizationFunctions()
  38 {
  39     m_OptimizationFunctions = NULL;
  40 }
  41
  42 OptimizationFunctions* Optimization::getOptimizationFunctions()
  43 {
  44     return m_OptimizationFunctions;
  45 }
  46
  47 /*
  48 ** \}
  49 */
  50
  51
  52 /*--------------------------------------------------------------------------*/
  53 OptimizationFunctions::OptimizationFunctions(std::wstring callerName)
  54 {
  55     m_iXRows = 0;
  56     m_iXCols = 0;
  57
  58     m_wstrCaller = callerName;
  59
  60     // optim
  61     m_pCallOptimCostfFunction           = NULL;
  62     m_pStringOptimCostfFunctionDyn      = NULL;
  63     m_pStringOptimCostfFunctionStatic   = NULL;
  64
  65     // fsolve
  66     m_pCallFsolveFctFunction            = NULL;
  67     m_pStringFsolveFctFunctionDyn       = NULL;
  68     m_pStringFsolveFctFunctionStatic    = NULL;
  69
  70     m_pCallFsolveJacFunction            = NULL;
  71     m_pStringFsolveJacFunctionDyn       = NULL;
  72     m_pStringFsolveJacFunctionStatic    = NULL;
  73
  74     // init static functions
  75     if (callerName == L"optim")
  76     {
  77         m_staticFunctionMap[L"genros"]  = (void*) C2F(genros);
  78         m_staticFunctionMap[L"topt2"]   = (void*) C2F(topt2);
  79         m_staticFunctionMap[L"icsemc"]  = (void*) C2F(icsemc);
  80         m_staticFunctionMap[L"mcsec"]   = (void*) C2F(mcsec);
  81     }
  82     else if (callerName == L"fsolve")
  83     {
  84         m_staticFunctionMap[L"fsol1"]   = (void*) C2F(fsol1);
  85         m_staticFunctionMap[L"fsolj1"]  = (void*) C2F(fsolj1);
  86     }
  87     else if (callerName == L"lsqrsolve")
  88     {
  89         m_staticFunctionMap[L"lsqrsol1"]   = (void*) C2F(lsqrsol1);
  90         m_staticFunctionMap[L"lsqrsolj1"]  = (void*) C2F(lsqrsolj1);
  91     }
  92 }
  93
  94 OptimizationFunctions::~OptimizationFunctions()
  95 {
  96     m_staticFunctionMap.clear();
  97 }
  98
  99 /*------------------------------- public -------------------------------------------*/
 100 // optim
 101 void OptimizationFunctions::execCostf(int *ind, int *n, double *x, double *f, double *g, int *ti, float *tr, double *td)
 102 {
 103     char errorMsg[256];
 104     if (m_pCallOptimCostfFunction)
 105     {
 106         callCostfMacro(ind, n, x, f, g, ti, tr, td);
 107     }
 108     else if (m_pStringOptimCostfFunctionDyn)
 109     {
 110         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringOptimCostfFunctionDyn->get(0));
 111         if (func == NULL)
 112         {
 113             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringOptimCostfFunctionDyn->get(0));
 114             throw ast::InternalError(errorMsg);
 115         }
 116         ((costf_t)(func->functionPtr))(ind, n, x, f, g, ti, tr, td);
 117     }
 118     else if (m_pStringOptimCostfFunctionStatic)
 119     {
 120         ((costf_t)m_staticFunctionMap[m_pStringOptimCostfFunctionStatic->get(0)])(ind, n, x, f, g, ti, tr, td);
 121     }
 122     else
 123     {
 124         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "costf");
 125         throw ast::InternalError(errorMsg);
 126     }
 127 }
 128
 129 // fsolve
 130 void OptimizationFunctions::execFsolveFct(int* n, double* x, double* v, int* iflag)
 131 {
 132     char errorMsg[256];
 133     if (m_pCallFsolveFctFunction)
 134     {
 135         callFsolveFctMacro(n, x, v, iflag);
 136     }
 137     else if (m_pStringFsolveFctFunctionDyn)
 138     {
 139         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringFsolveFctFunctionDyn->get(0));
 140         if (func == NULL)
 141         {
 142             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringFsolveFctFunctionDyn->get(0));
 143             throw ast::InternalError(errorMsg);
 144         }
 145         ((fct_t)(func->functionPtr))(n, x, v, iflag);
 146     }
 147     else if (m_pStringFsolveFctFunctionStatic)
 148     {
 149         ((fct_t)m_staticFunctionMap[m_pStringFsolveFctFunctionStatic->get(0)])(n, x, v, iflag);
 150     }
 151     else
 152     {
 153         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "costf");
 154         throw ast::InternalError(errorMsg);
 155     }
 156 }
 157 void OptimizationFunctions::execFsolveJac(int* n, double* x, double* v, double* jac, int* ldjac, int* iflag)
 158 {
 159     char errorMsg[256];
 160     if (m_pCallFsolveJacFunction)
 161     {
 162         callFsolveJacMacro(n, x, v, jac, ldjac, iflag);
 163     }
 164     else if (m_pStringFsolveJacFunctionDyn)
 165     {
 166         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringFsolveJacFunctionDyn->get(0));
 167         if (func == NULL)
 168         {
 169             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringFsolveJacFunctionDyn->get(0));
 170             throw ast::InternalError(errorMsg);
 171         }
 172         // c or fortran jac fuction are the same proto as fct
 173         ((fct_t)(func->functionPtr))(n, x, jac, iflag);
 174     }
 175     else if (m_pStringFsolveJacFunctionStatic)
 176     {
 177         // c or fortran jac fuction are the same proto as fct
 178         ((fct_t)m_staticFunctionMap[m_pStringFsolveJacFunctionStatic->get(0)])(n, x, jac, iflag);
 179     }
 180     else
 181     {
 182         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "costf");
 183         throw ast::InternalError(errorMsg);
 184     }
 185 }
 186
 187 // lsqrsolve
 188 void OptimizationFunctions::execLsqrsolveFct(int* m, int* n, double* x, double* v, int* iflag)
 189 {
 190     char errorMsg[256];
 191     if (m_pCallFsolveFctFunction)
 192     {
 193         callLsqrsolveFctMacro(m, n, x, v, iflag);
 194     }
 195     else if (m_pStringFsolveFctFunctionDyn)
 196     {
 197         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringFsolveFctFunctionDyn->get(0));
 198         if (func == NULL)
 199         {
 200             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringFsolveFctFunctionDyn->get(0));
 201             throw ast::InternalError(errorMsg);
 202         }
 203         ((lsqrfct_t)(func->functionPtr))(m, n, x, v, iflag);
 204     }
 205     else if (m_pStringFsolveFctFunctionStatic)
 206     {
 207         ((lsqrfct_t)m_staticFunctionMap[m_pStringFsolveFctFunctionStatic->get(0)])(m, n, x, v, iflag);
 208     }
 209     else
 210     {
 211         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "costf");
 212         throw ast::InternalError(errorMsg);
 213     }
 214 }
 215 void OptimizationFunctions::execLsqrsolveJac(int* m, int* n, double* x, double* v, double* jac, int* ldjac, int* iflag)
 216 {
 217     char errorMsg[256];
 218     if (m_pCallFsolveJacFunction)
 219     {
 220         callLsqrsolveJacMacro(m, n, x, v, jac, ldjac, iflag);
 221     }
 222     else if (m_pStringFsolveJacFunctionDyn)
 223     {
 224         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringFsolveJacFunctionDyn->get(0));
 225         if (func == NULL)
 226         {
 227             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringFsolveJacFunctionDyn->get(0));
 228             throw ast::InternalError(errorMsg);
 229         }
 230         // c or fortran jac fuction are the same proto as fct
 231         ((lsqrjac_ext_t)(func->functionPtr))(m, n, x, jac, ldjac, iflag);
 232     }
 233     else if (m_pStringFsolveJacFunctionStatic)
 234     {
 235         // c or fortran jac fuction are the same proto as fct
 236         ((lsqrjac_ext_t)m_staticFunctionMap[m_pStringFsolveJacFunctionStatic->get(0)])(m, n, x, jac, ldjac, iflag);
 237     }
 238     else
 239     {
 240         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "costf");
 241         throw ast::InternalError(errorMsg);
 242     }
 243 }
 244
 245 //*** setter ***
 246 void OptimizationFunctions::setXRows(int _iRows)
 247 {
 248     m_iXRows = _iRows;
 249 }
 250 void OptimizationFunctions::setXCols(int _iCols)
 251 {
 252     m_iXCols = _iCols;
 253 }
 254
 255 // optim
 256 void OptimizationFunctions::setCostfArgs(types::InternalType* _Args)
 257 {
 258     m_OptimArgs.push_back(_Args);
 259 }
 260
 261 void OptimizationFunctions::setOptimCostfFunction(types::Callable* _func)
 262 {
 263     m_pCallOptimCostfFunction = _func;
 264 }
 265
 266 bool OptimizationFunctions::setOptimCostfFunction(types::String* _func)
 267 {
 268     if (ConfigVariable::getEntryPoint(_func->get(0)))
 269     {
 270         m_pStringOptimCostfFunctionDyn = _func;
 271         return true;
 272     }
 273     else
 274     {
 275         if (m_staticFunctionMap.find(_func->get(0)) != m_staticFunctionMap.end())
 276         {
 277             m_pStringOptimCostfFunctionStatic = _func;
 278             return true;
 279         }
 280         return false;
 281     }
 282 }
 283
 284 // fsolve
 285 void OptimizationFunctions::setFsolveFctArgs(types::InternalType* _Args)
 286 {
 287     m_fsolveFctArgs.push_back(_Args);
 288 }
 289
 290 void OptimizationFunctions::setFsolveFctFunction(types::Callable* _func)
 291 {
 292     m_pCallFsolveFctFunction = _func;
 293 }
 294
 295 bool OptimizationFunctions::setFsolveFctFunction(types::String* _func)
 296 {
 297     if (ConfigVariable::getEntryPoint(_func->get(0)))
 298     {
 299         m_pStringFsolveFctFunctionDyn = _func;
 300         return true;
 301     }
 302     else
 303     {
 304         if (m_staticFunctionMap.find(_func->get(0)) != m_staticFunctionMap.end())
 305         {
 306             m_pStringFsolveFctFunctionStatic = _func;
 307             return true;
 308         }
 309         return false;
 310     }
 311 }
 312
 313 void OptimizationFunctions::setFsolveJacArgs(types::InternalType* _Args)
 314 {
 315     m_fsolveJacArgs.push_back(_Args);
 316 }
 317
 318 void OptimizationFunctions::setFsolveJacFunction(types::Callable* _func)
 319 {
 320     m_pCallFsolveJacFunction = _func;
 321 }
 322
 323 bool OptimizationFunctions::setFsolveJacFunction(types::String* _func)
 324 {
 325     if (ConfigVariable::getEntryPoint(_func->get(0)))
 326     {
 327         m_pStringFsolveJacFunctionDyn = _func;
 328         return true;
 329     }
 330     else
 331     {
 332         if (m_staticFunctionMap.find(_func->get(0)) != m_staticFunctionMap.end())
 333         {
 334             m_pStringFsolveJacFunctionStatic = _func;
 335             return true;
 336         }
 337         return false;
 338     }
 339 }
 340
 341 //*** getter ***
 342 int OptimizationFunctions::getXRows()
 343 {
 344     return m_iXRows;
 345 }
 346 int OptimizationFunctions::getXCols()
 347 {
 348     return m_iXCols;
 349 }
 350
 351 /*------------------------------- private -------------------------------------------*/
 352 // optim
 353 void OptimizationFunctions::callCostfMacro(int *ind, int *n, double *x, double *f, double *g, int *ti, float *tr, double *td)
 354 {
 355     char errorMsg[256];
 356     int iRetCount   = 3;
 357     int one         = 1;
 358
 359     typed_list in;
 360     typed_list out;
 361     types::optional_list opt;
 362     ast::ExecVisitor execFunc;
 363
 364     // create input args
 365     types::Double* pDblX = new types::Double(m_iXRows, m_iXCols);
 366     C2F(dcopy)(n, x, &one, pDblX->get(), &one);
 367     pDblX->IncreaseRef();
 368
 369     types::Double* pDblInd = new types::Double((double)(*ind));
 370     pDblInd->IncreaseRef();
 371
 372     // push_back
 373     in.push_back(pDblX);
 374     in.push_back(pDblInd);
 375
 376     for (int i = 0; i < (int)m_OptimArgs.size(); i++)
 377     {
 378         m_OptimArgs[i]->IncreaseRef();
 379         in.push_back(m_OptimArgs[i]);
 380     }
 381
 382     try
 383     {
 384         // new std::wstring(L"") is delete in destructor of ast::CommentExp
 385         m_pCallOptimCostfFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
 386     }
 387     catch (const ast::InternalError& ie)
 388     {
 389         for (int i = 0; i < (int)m_OptimArgs.size(); i++)
 390         {
 391             m_OptimArgs[i]->DecreaseRef();
 392         }
 393
 394         throw ie;
 395     }
 396
 397     for (int i = 0; i < (int)m_OptimArgs.size(); i++)
 398     {
 399         m_OptimArgs[i]->DecreaseRef();
 400     }
 401
 402     if (out.size() != iRetCount)
 403     {
 404         char* pstrName = wide_string_to_UTF8(m_pCallOptimCostfFunction->getName().c_str());
 405         sprintf(errorMsg, _("%s: Wrong number of input argument(s): %d expected.\n"), pstrName, iRetCount);
 406         FREE(pstrName);
 407         throw ast::InternalError(errorMsg);
 408     }
 409
 410     out[0]->IncreaseRef();
 411     out[1]->IncreaseRef();
 412     out[2]->IncreaseRef();
 413
 414     pDblX->DecreaseRef();
 415     if (pDblX->isDeletable())
 416     {
 417         delete pDblX;
 418     }
 419
 420     pDblInd->DecreaseRef();
 421     if (pDblInd->isDeletable())
 422     {
 423         delete pDblInd;
 424     }
 425
 426     types::Double* pDblOut = NULL;
 427
 428     // get f
 429     if (out[0]->isDouble() == false)
 430     {
 431         char* pstrName = wide_string_to_UTF8(m_pCallOptimCostfFunction->getName().c_str());
 432         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real scalar expected.\n"), pstrName, 1);
 433         FREE(pstrName);
 434         throw ast::InternalError(errorMsg);
 435     }
 436
 437     pDblOut = out[0]->getAs<types::Double>();
 438     if (pDblOut->isComplex() || pDblOut->isScalar() == false)
 439     {
 440         char* pstrName = wide_string_to_UTF8(m_pCallOptimCostfFunction->getName().c_str());
 441         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real scalar expected.\n"), pstrName, 1);
 442         FREE(pstrName);
 443         throw ast::InternalError(errorMsg);
 444     }
 445
 446     *f = pDblOut->get(0);
 447
 448     out[0]->DecreaseRef();
 449     if (out[0]->isDeletable())
 450     {
 451         delete out[0];
 452     }
 453
 454     // get g
 455     if (out[1]->isDouble() == false)
 456     {
 457         char* pstrName = wide_string_to_UTF8(m_pCallOptimCostfFunction->getName().c_str());
 458         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 2);
 459         FREE(pstrName);
 460         throw ast::InternalError(errorMsg);
 461     }
 462
 463     pDblOut = out[1]->getAs<types::Double>();
 464     if (pDblOut->isComplex())
 465     {
 466         char* pstrName = wide_string_to_UTF8(m_pCallOptimCostfFunction->getName().c_str());
 467         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 2);
 468         FREE(pstrName);
 469         throw ast::InternalError(errorMsg);
 470     }
 471
 472     C2F(dcopy)(n, pDblOut->get(), &one, g, &one);
 473
 474     out[1]->DecreaseRef();
 475     if (out[1]->isDeletable())
 476     {
 477         delete out[1];
 478     }
 479
 480     // get ind
 481     if (out[2]->isDouble() == false)
 482     {
 483         char* pstrName = wide_string_to_UTF8(m_pCallOptimCostfFunction->getName().c_str());
 484         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real scalar expected.\n"), pstrName, 3);
 485         FREE(pstrName);
 486         throw ast::InternalError(errorMsg);
 487     }
 488
 489     pDblOut = out[2]->getAs<types::Double>();
 490     if (pDblOut->isComplex() || pDblOut->isScalar() == false)
 491     {
 492         char* pstrName = wide_string_to_UTF8(m_pCallOptimCostfFunction->getName().c_str());
 493         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real scalar expected.\n"), pstrName, 3);
 494         FREE(pstrName);
 495         throw ast::InternalError(errorMsg);
 496     }
 497
 498     *ind = (int)pDblOut->get(0);
 499
 500     out[2]->DecreaseRef();
 501     if (out[2]->isDeletable())
 502     {
 503         delete out[2];
 504     }
 505 }
 506
 507 // fsolve
 508 void OptimizationFunctions::callFsolveFctMacro(int *n, double *x, double *v, int *iflag)
 509 {
 510     char errorMsg[256];
 511     int iRetCount   = 1;
 512     int one         = 1;
 513
 514     typed_list in;
 515     typed_list out;
 516     types::optional_list opt;
 517     ast::ExecVisitor execFunc;
 518
 519     // create input args
 520     types::Double* pDblX = new types::Double(m_iXRows, m_iXCols);
 521     C2F(dcopy)(n, x, &one, pDblX->get(), &one);
 522     pDblX->IncreaseRef();
 523
 524     // push_back
 525     in.push_back(pDblX);
 526
 527     for (int i = 0; i < (int)m_fsolveFctArgs.size(); i++)
 528     {
 529         m_fsolveFctArgs[i]->IncreaseRef();
 530         in.push_back(m_fsolveFctArgs[i]);
 531     }
 532
 533     try
 534     {
 535         // new std::wstring(L"") is delete in destructor of ast::CommentExp
 536         m_pCallFsolveFctFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
 537     }
 538     catch (const ast::InternalError& ie)
 539     {
 540         for (int i = 0; i < (int)m_fsolveFctArgs.size(); i++)
 541         {
 542             m_fsolveFctArgs[i]->DecreaseRef();
 543         }
 544
 545         throw ie;
 546     }
 547
 548     for (int i = 0; i < (int)m_fsolveFctArgs.size(); i++)
 549     {
 550         m_fsolveFctArgs[i]->DecreaseRef();
 551     }
 552
 553     if (out.size() != iRetCount)
 554     {
 555         char* pstrName = wide_string_to_UTF8(m_pCallFsolveFctFunction->getName().c_str());
 556         sprintf(errorMsg, _("%s: Wrong number of input argument(s): %d expected.\n"), pstrName, iRetCount);
 557         FREE(pstrName);
 558         throw ast::InternalError(errorMsg);
 559     }
 560
 561     out[0]->IncreaseRef();
 562
 563     pDblX->DecreaseRef();
 564     if (pDblX->isDeletable())
 565     {
 566         delete pDblX;
 567     }
 568
 569     types::Double* pDblOut = NULL;
 570
 571     // get v
 572     if (out[0]->isDouble() == false)
 573     {
 574         char* pstrName = wide_string_to_UTF8(m_pCallFsolveFctFunction->getName().c_str());
 575         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real scalar expected.\n"), pstrName, 1);
 576         FREE(pstrName);
 577         throw ast::InternalError(errorMsg);
 578     }
 579
 580     pDblOut = out[0]->getAs<types::Double>();
 581     if (pDblOut->getRows() != m_iXRows || pDblOut->getCols() != m_iXCols)
 582     {
 583         char* pstrName = wide_string_to_UTF8(m_pCallFsolveFctFunction->getName().c_str());
 584         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A matrix of size %d x %d expected.\n"), pstrName, 1, m_iXRows, m_iXCols);
 585         FREE(pstrName);
 586         throw ast::InternalError(errorMsg);
 587     }
 588
 589     C2F(dcopy)(n, pDblOut->get(), &one, v, &one);
 590
 591     out[0]->DecreaseRef();
 592     if (out[0]->isDeletable())
 593     {
 594         delete out[0];
 595     }
 596 }
 597
 598 void OptimizationFunctions::callFsolveJacMacro(int *n, double *x, double *v, double* jac, int* ldjac, int *iflag)
 599 {
 600     char errorMsg[256];
 601     int iRetCount   = 1;
 602     int one         = 1;
 603
 604     typed_list in;
 605     typed_list out;
 606     types::optional_list opt;
 607     ast::ExecVisitor execFunc;
 608
 609     // create input args
 610     types::Double* pDblX = new types::Double(m_iXRows, m_iXCols);
 611     C2F(dcopy)(n, x, &one, pDblX->get(), &one);
 612     pDblX->IncreaseRef();
 613
 614     // push_back
 615     in.push_back(pDblX);
 616
 617     for (int i = 0; i < (int)m_fsolveJacArgs.size(); i++)
 618     {
 619         m_fsolveJacArgs[i]->IncreaseRef();
 620         in.push_back(m_fsolveJacArgs[i]);
 621     }
 622
 623     try
 624     {
 625         // new std::wstring(L"") is delete in destructor of ast::CommentExp
 626         m_pCallFsolveJacFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
 627     }
 628     catch (const ast::InternalError& ie)
 629     {
 630         for (int i = 0; i < (int)m_fsolveJacArgs.size(); i++)
 631         {
 632             m_fsolveJacArgs[i]->DecreaseRef();
 633         }
 634
 635         throw ie;
 636     }
 637
 638     for (int i = 0; i < (int)m_fsolveJacArgs.size(); i++)
 639     {
 640         m_fsolveJacArgs[i]->DecreaseRef();
 641     }
 642
 643     if (out.size() != iRetCount)
 644     {
 645         char* pstrName = wide_string_to_UTF8(m_pCallFsolveJacFunction->getName().c_str());
 646         sprintf(errorMsg, _("%s: Wrong number of input argument(s): %d expected.\n"), pstrName, iRetCount);
 647         FREE(pstrName);
 648         throw ast::InternalError(errorMsg);
 649     }
 650
 651     out[0]->IncreaseRef();
 652
 653     pDblX->DecreaseRef();
 654     if (pDblX->isDeletable())
 655     {
 656         delete pDblX;
 657     }
 658
 659     types::Double* pDblOut = NULL;
 660
 661     // get jac
 662     if (out[0]->isDouble() == false)
 663     {
 664         char* pstrName = wide_string_to_UTF8(m_pCallFsolveJacFunction->getName().c_str());
 665         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real scalar expected.\n"), pstrName, 1);
 666         FREE(pstrName);
 667         throw ast::InternalError(errorMsg);
 668     }
 669
 670     pDblOut = out[0]->getAs<types::Double>();
 671     if (pDblOut->getRows() != *ldjac || pDblOut->getCols() != *n)
 672     {
 673         char* pstrName = wide_string_to_UTF8(m_pCallFsolveJacFunction->getName().c_str());
 674         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A matrix of size %d x %d expected.\n"), pstrName, 1, *ldjac, *n);
 675         FREE(pstrName);
 676         throw ast::InternalError(errorMsg);
 677     }
 678
 679     int iSize = (*ldjac) * (*n);
 680     C2F(dcopy)(&iSize, pDblOut->get(), &one, jac, &one);
 681
 682     out[0]->DecreaseRef();
 683     if (out[0]->isDeletable())
 684     {
 685         delete out[0];
 686     }
 687 }
 688
 689 // lsqrsolve
 690 void OptimizationFunctions::callLsqrsolveFctMacro(int *m, int *n, double *x, double *v, int *iflag)
 691 {
 692     char errorMsg[256];
 693     int iRetCount   = 1;
 694     int one         = 1;
 695
 696     typed_list in;
 697     typed_list out;
 698     types::optional_list opt;
 699     ast::ExecVisitor execFunc;
 700
 701     // create input args
 702     types::Double* pDblX = new types::Double(m_iXRows, m_iXCols);
 703     C2F(dcopy)(n, x, &one, pDblX->get(), &one);
 704     pDblX->IncreaseRef();
 705     types::Double* pDblM = new types::Double((double)*m);
 706     pDblM->IncreaseRef();
 707
 708     // push_back
 709     in.push_back(pDblX);
 710     in.push_back(pDblM);
 711
 712     for (int i = 0; i < (int)m_fsolveFctArgs.size(); i++)
 713     {
 714         m_fsolveFctArgs[i]->IncreaseRef();
 715         in.push_back(m_fsolveFctArgs[i]);
 716     }
 717
 718     try
 719     {
 720         // new std::wstring(L"") is delete in destructor of ast::CommentExp
 721         m_pCallFsolveFctFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
 722     }
 723     catch (const ast::InternalError& ie)
 724     {
 725         for (int i = 0; i < (int)m_fsolveFctArgs.size(); i++)
 726         {
 727             m_fsolveFctArgs[i]->DecreaseRef();
 728         }
 729
 730         throw ie;
 731     }
 732
 733     for (int i = 0; i < (int)m_fsolveFctArgs.size(); i++)
 734     {
 735         m_fsolveFctArgs[i]->DecreaseRef();
 736     }
 737
 738     if (out.size() != iRetCount)
 739     {
 740         char* pstrName = wide_string_to_UTF8(m_pCallFsolveFctFunction->getName().c_str());
 741         sprintf(errorMsg, _("%s: Wrong number of input argument(s): %d expected.\n"), pstrName, iRetCount);
 742         FREE(pstrName);
 743         throw ast::InternalError(errorMsg);
 744     }
 745
 746     out[0]->IncreaseRef();
 747
 748     pDblX->DecreaseRef();
 749     if (pDblX->isDeletable())
 750     {
 751         delete pDblX;
 752     }
 753
 754     pDblM->DecreaseRef();
 755     if (pDblM->isDeletable())
 756     {
 757         delete pDblM;
 758     }
 759
 760     types::Double* pDblOut = NULL;
 761
 762     // get v
 763     if (out[0]->isDouble() == false)
 764     {
 765         char* pstrName = wide_string_to_UTF8(m_pCallFsolveFctFunction->getName().c_str());
 766         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real scalar expected.\n"), pstrName, 1);
 767         FREE(pstrName);
 768         throw ast::InternalError(errorMsg);
 769     }
 770
 771     pDblOut = out[0]->getAs<types::Double>();
 772     if (pDblOut->getSize() != *m)
 773     {
 774         char* pstrName = wide_string_to_UTF8(m_pCallFsolveFctFunction->getName().c_str());
 775         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A vector of %d expected.\n"), pstrName, 1, *m);
 776         FREE(pstrName);
 777         throw ast::InternalError(errorMsg);
 778     }
 779
 780     C2F(dcopy)(m, pDblOut->get(), &one, v, &one);
 781
 782     out[0]->DecreaseRef();
 783     if (out[0]->isDeletable())
 784     {
 785         delete out[0];
 786     }
 787 }
 788 void OptimizationFunctions::callLsqrsolveJacMacro(int *m, int *n, double *x, double *v, double *jac, int *ldjac, int *iflag)
 789 {
 790     char errorMsg[256];
 791     int iRetCount   = 1;
 792     int one         = 1;
 793
 794     typed_list in;
 795     typed_list out;
 796     types::optional_list opt;
 797     ast::ExecVisitor execFunc;
 798
 799     // create input args
 800     types::Double* pDblX = new types::Double(m_iXRows, m_iXCols);
 801     C2F(dcopy)(n, x, &one, pDblX->get(), &one);
 802     pDblX->IncreaseRef();
 803     types::Double* pDblM = new types::Double((double)*m);
 804     pDblM->IncreaseRef();
 805
 806     // push_back
 807     in.push_back(pDblX);
 808     in.push_back(pDblM);
 809
 810     for (int i = 0; i < (int)m_fsolveJacArgs.size(); i++)
 811     {
 812         m_fsolveJacArgs[i]->IncreaseRef();
 813         in.push_back(m_fsolveJacArgs[i]);
 814     }
 815
 816     try
 817     {
 818         // new std::wstring(L"") is delete in destructor of ast::CommentExp
 819         m_pCallFsolveJacFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
 820     }
 821     catch (const ast::InternalError& ie)
 822     {
 823         for (int i = 0; i < (int)m_fsolveJacArgs.size(); i++)
 824         {
 825             m_fsolveJacArgs[i]->DecreaseRef();
 826         }
 827
 828         throw ie;
 829     }
 830
 831     for (int i = 0; i < (int)m_fsolveJacArgs.size(); i++)
 832     {
 833         m_fsolveJacArgs[i]->DecreaseRef();
 834     }
 835
 836     if (out.size() != iRetCount)
 837     {
 838         char* pstrName = wide_string_to_UTF8(m_pCallFsolveJacFunction->getName().c_str());
 839         sprintf(errorMsg, _("%s: Wrong number of input argument(s): %d expected.\n"), pstrName, iRetCount);
 840         FREE(pstrName);
 841         throw ast::InternalError(errorMsg);
 842     }
 843
 844     out[0]->IncreaseRef();
 845
 846     pDblX->DecreaseRef();
 847     if (pDblX->isDeletable())
 848     {
 849         delete pDblX;
 850     }
 851
 852     pDblM->DecreaseRef();
 853     if (pDblM->isDeletable())
 854     {
 855         delete pDblM;
 856     }
 857
 858     types::Double* pDblOut = NULL;
 859
 860     // get jac
 861     if (out[0]->isDouble() == false)
 862     {
 863         char* pstrName = wide_string_to_UTF8(m_pCallFsolveJacFunction->getName().c_str());
 864         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real scalar expected.\n"), pstrName, 1);
 865         FREE(pstrName);
 866         throw ast::InternalError(errorMsg);
 867     }
 868
 869     pDblOut = out[0]->getAs<types::Double>();
 870     if (pDblOut->getSize() != *m **n)
 871     {
 872         char* pstrName = wide_string_to_UTF8(m_pCallFsolveJacFunction->getName().c_str());
 873         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A vector of %d expected.\n"), pstrName, 1, *m);
 874         FREE(pstrName);
 875         throw ast::InternalError(errorMsg);
 876     }
 877
 878     int iSize = *m **n;
 879     C2F(dcopy)(&iSize, pDblOut->get(), &one, jac, &one);
 880
 881     out[0]->DecreaseRef();
 882     if (out[0]->isDeletable())
 883     {
 884         delete out[0];
 885     }
 886 }
 887