RiDMC/src/r_basin_slow.c

   1 /*
   2 ridmc: iDMC->R interface
   3
   4 Copyright (C) 2007 Marji Lines and Alfredo Medio.
   5
   6 Written by Antonio, Fabio Di Narzo <antonio.fabio@gmail.com>.
   7
   8 This program is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 2 of the License, or any
  11 later version.
  12
  13 This program is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 Last modified: $Date: 2007-05-24 16:41:18 +0200 (gio, 24 mag 2007) $
  19 */
  20 #include "ridmc.h"
  21 #include <idmclib/model.h>
  22 #include <idmclib/basin_slow.h>
  23
  24 void ridmc_basin_slow_free(SEXP p);
  25
  26 SEXP ridmc_basin_slow_alloc(SEXP model, SEXP parms,
  27         SEXP xmin, SEXP xmax, SEXP xres,
  28         SEXP ymin, SEXP ymax, SEXP yres,
  29         SEXP attractorLimit, SEXP attractorIterations, SEXP ntries) {
  30         SEXP ans;
  31         int ians;
  32         idmc_basin_slow *basin;
  33
  34         ians = idmc_basin_slow_alloc(R_ExternalPtrAddr(model), REAL(parms),
  35                 REAL(xmin)[0], REAL(xmax)[0], INTEGER(xres)[0],
  36                 REAL(ymin)[0], REAL(ymax)[0], INTEGER(yres)[0],
  37                 INTEGER(attractorLimit)[0], INTEGER(attractorIterations)[0],
  38                 INTEGER(ntries)[0], &basin);
  39         if(ians != IDMC_OK)
  40                 RIDMC_GENERIC_ERROR(ians);
  41         PDEBUG("allocated basin %p\n", basin);
  42         PROTECT(ans = R_MakeExternalPtr(basin, R_NilValue, R_NilValue));
  43         R_RegisterCFinalizer(ans, ridmc_basin_slow_free);
  44         UNPROTECT(1);
  45         return ans;
  46 }
  47
  48 void ridmc_basin_slow_free(SEXP p) {
  49         PDEBUG("deallocating basin %p\n", R_ExternalPtrAddr(p));
  50         idmc_basin_slow_free( R_ExternalPtrAddr(p) );
  51 }
  52
  53 SEXP ridmc_basin_slow_step(SEXP p) {
  54         int ians = idmc_basin_slow_step(R_ExternalPtrAddr(p));
  55         if(ians!=IDMC_OK)
  56                 RIDMC_GENERIC_ERROR(ians);
  57         return R_NilValue;
  58 }
  59
  60 SEXP ridmc_basin_slow_finished(SEXP p) {
  61         SEXP ans = allocVector(INTSXP, 1);
  62         INTEGER(ans)[0] = idmc_basin_slow_finished(R_ExternalPtrAddr(p));
  63         return ans;
  64 }
  65
  66 SEXP ridmc_basin_slow_setGslRngSeed(SEXP b, SEXP seed) {
  67         idmc_model_setGslRngSeed(((idmc_basin_slow*)R_ExternalPtrAddr(b))->model,
  68                 INTEGER(seed)[0]);
  69         return R_NilValue;
  70 }
  71
  72 SEXP ridmc_basin_slow_getData(SEXP p) {
  73         SEXP ans;
  74         idmc_basin_slow *bp = (idmc_basin_slow*) R_ExternalPtrAddr(p);
  75         ans = allocMatrix(INTSXP, bp->raster->xres,  bp->raster->yres );
  76         memcpy(INTEGER(ans), bp->raster->data, bp->dataLength * sizeof(int));
  77         return ans;
  78 }