[Rd] calling optif0 in a C function
Emmanuel Paradis
paradis at isem.univ-montp2.fr
Fri Feb 18 15:07:40 CET 2005
Dear All,
I am trying to use the function optif0 (in main/uncmin.c) from the
latest R distribution. The reason is that I have a quite complicated
likelihood function which is coded in C, and I would like to optimize it
directly.
To see how this works, I have tried with a very simple example:
optimizing the likelihood of a sample using an exponential distribution.
I have tried several solutions but none worked. I paste below the
functions that come the closest to what should work. The compilation is
fine and the call from R too. It seems that the call to optif0 does not
do anything whereas everything else works.
It seems that I miss something simple... Any suggestion will be welcome.
I use R 2.0.1 and GCC 3.3.4.
Best regards,
Emmanuel Paradis
========================================================
#include <R.h>
#include <Rmath.h>
#include <R_ext/Applic.h>
#include "ape.h"
/* Here is the content of ape.h: */
typedef struct {
int *n;
double *x;
} TITI;
static void fcn_expo(int, double *, double *, TITI *);
/* end of ape.h */
void lik_expo(int *n, double *x, double *l, double *loglik)
{
/* computes the likelihood */
int i;
*loglik = 0;
for (i = 0; i < *n; i++)
*loglik += log(*l) - *l * x[i];
}
static void fcn_expo(int np, double *p, double *sol, TITI *D)
{
/* computes the deviance to be minimized */
double loglik;
lik_expo(D->n, D->x, p, &loglik);
*sol = -2 * loglik;
}
void nlm_expo(int *n, double *x, double *l, double *dev)
{
/* the function called from R */
int *itrmcd, *np, term_code, N;
double *xpls, *fpls, *gpls, est, sol, grad, *a, *wrk;
TITI *D, data;
extern void fcn_expo(int, double *, double *, TITI *);
N = 1;
np = &N;
D = &data;
D->n = n;
D->x = x;
itrmcd = &term_code;
xpls = &est;
fpls = /
gpls = &grad;
a = (double*)malloc(*np * *np * sizeof(double));
wrk = (double*)malloc(*np * 9 * sizeof(double));
optif0(*np, *np, l, (fcn_p) fcn_expo, D,
xpls, fpls, gpls, itrmcd, a, wrk);
*l = *xpls;
*dev = *fpls;
}
### Here is the R function that calls the C code:
nlmexpo <- function(x)
{
n <- length(x)
l <- 1
dev <- 0.1
c1 <- c2 <- -8
.C("nlm_expo", as.integer(n), as.double(x),
as.double(l), as.double(dev),
NAOK = TRUE, PACKAGE = "apex")
}
More information about the R-devel
mailing list