/usr/share/libctl/utils/nlopt.c is in libctl5 3.2.2-4build1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 | /* wrapper around NLopt nonlinear optimization library (if installed) */
#ifdef HAVE_NLOPT
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <ctl.h>
#include <nlopt.h>
static double f_scm_wrap(integer n, const double *x, double *grad, void *f_scm_p)
{
SCM *f_scm = (SCM *) f_scm_p;
SCM ret = gh_call1(*f_scm, make_number_list(n, x));
if (scm_real_p(ret))
return scm_to_double(ret);
else { /* otherwise must be a list of value, gradient components,
i.e. (cons value gradient). */
SCM gscm = ret;
int i;
for (i = 0; i < n; ++i) {
gscm = SCM_CDR(gscm);
grad[i] = scm_to_double(SCM_CAR(gscm));
}
return scm_to_double(SCM_CAR(ret));
}
}
/* Scheme-callable wrapper for nlopt_minimize() function.
Note that Guile-callable C subroutines cannot take more than
10 arguments (grrr), so we past the last few arguments with a "rest"
list parameter */
SCM nlopt_minimize_scm(SCM algorithm_scm,
SCM f_scm,
SCM lb_scm, SCM ub_scm, SCM x_scm,
SCM minf_max_scm, SCM ftol_rel_scm, SCM ftol_abs_scm,
SCM rest
/*
SCM xtol_rel_scm, SCM xtol_abs_scm,
SCM maxeval_scm, SCM maxtime_scm
*/)
{
nlopt_algorithm algorithm = (nlopt_algorithm) scm_to_int(algorithm_scm);
int i, n = list_length(x_scm);
double *x, *lb, *ub, *xtol_abs = 0;
double minf_max = scm_to_double(minf_max_scm);
double ftol_rel = scm_to_double(ftol_rel_scm);
double ftol_abs = scm_to_double(ftol_abs_scm);
double xtol_rel = 0;
double maxeval = 0;
double maxtime = 0;
int nrest = list_length(rest);
/*
double xtol_rel = scm_to_double(xtol_rel_scm);
int maxeval = scm_to_int(maxeval_scm);
double maxtime = scm_to_double(maxtime_scm);
*/
double minf;
nlopt_result result;
SCM v, ret;
x = (double *) malloc(sizeof(double) * n * 4);
lb = x + n; ub = lb + n;
if (!x) {
fprintf(stderr, "nlopt_minimize_scm: out of memory!\n");
exit(EXIT_FAILURE);
}
if (list_length(lb_scm) != n || list_length(ub_scm) != n) {
fprintf(stderr, "nlopt_minimize_scm: invalid arguments\n");
exit(EXIT_FAILURE);
}
for (v=x_scm, i=0; i < n; ++i) {
x[i] = scm_to_double(SCM_CAR(v));
v = SCM_CDR(v);
}
for (v=lb_scm, i=0; i < n; ++i) {
lb[i] = scm_to_double(SCM_CAR(v));
v = SCM_CDR(v);
}
for (v=ub_scm, i=0; i < n; ++i) {
ub[i] = scm_to_double(SCM_CAR(v));
v = SCM_CDR(v);
}
if (nrest >= 1) xtol_rel = scm_to_double(SCM_CAR(rest));
if (nrest >= 2) {
SCM xtol_abs_scm = scm_cadr(rest);
if (list_length(xtol_abs_scm)) {
xtol_abs = ub + n;
for (v=xtol_abs_scm, i=0; i < n; ++i) {
xtol_abs[i] = scm_to_double(SCM_CAR(v));
v = SCM_CDR(v);
}
}
}
if (nrest >= 3) maxeval = scm_to_int(scm_caddr(rest));
if (nrest >= 4) maxtime = scm_to_double(scm_cadddr(rest));
result = nlopt_minimize(algorithm, n, f_scm_wrap, &f_scm,
lb, ub, x, &minf,
minf_max, ftol_rel, ftol_abs, xtol_rel, xtol_abs,
maxeval, maxtime);
ret = scm_cons(scm_from_int((int) result),
scm_cons(scm_from_double(minf), make_number_list(n, x)));
free(x);
return ret;
}
#endif /* HAVE_NLOPT */
|