src/adapters/a.neighbors.c

   1 #include <R.h>
   2 #include <Rdefines.h>
   3 #include "sources/neighbors.h"
   4 #include "sources/utils/algebra.h"
   5 #include <cgds/List.h>
   6
   7 // Function to obtain neighborhoods.
   8 // NOTE: alpha = weight parameter to compute distances; -1 means "adaptive"
   9 // WARNING : M is given in columns
  10 SEXP getNeighbors(
  11     SEXP M_,
  12     SEXP k_,
  13     SEXP alpha_,
  14     SEXP gmode_,
  15     SEXP simpleDists_
  16 ) {
  17     // get scalar arguments
  18     int k = INTEGER_VALUE(k_);
  19     double alpha = NUMERIC_VALUE(alpha_);
  20     int gmode = INTEGER_VALUE(gmode_);
  21     int simpleDists = LOGICAL_VALUE(simpleDists_);
  22
  23     // extract infos from M and get associate pointer
  24     SEXP dim = getAttrib(M_, R_DimSymbol);
  25     int nrow = INTEGER(dim)[0];
  26     int ncol = INTEGER(dim)[1];
  27     // M is always given by columns: easier to process in rows
  28     double* pM = transpose(REAL(M_), nrow, ncol);
  29
  30     // Main call to core algorithm which fills neighborhoods lists
  31     List** neighborhoods = getNeighbors_core(pM, alpha, k, gmode, simpleDists, nrow, ncol);
  32
  33     // transfer neighborhoods lists into R vectors
  34     SEXP NIix, NIds;
  35     PROTECT(NIix = allocVector(VECSXP, nrow)); //indices
  36     PROTECT(NIds = allocVector(VECSXP, nrow)); //distances
  37     for (int i=0; i<nrow; i++)
  38     {
  39         SEXP neighbsIX, neighbsDS;
  40         PROTECT(neighbsIX = NEW_INTEGER(list_size(neighborhoods[i])));
  41         PROTECT(neighbsDS = NEW_NUMERIC(list_size(neighborhoods[i])));
  42         int* pNeighbsIX = INTEGER_POINTER(neighbsIX);
  43         double* pNeighbsDS = NUMERIC_POINTER(neighbsDS);
  44         ListIterator* neighbsI = list_get_iterator(neighborhoods[i]);
  45         int j = 0;
  46         while (listI_has_data(neighbsI))
  47         {
  48             IndDist indDist; listI_get(neighbsI, indDist);
  49             // WARNING: R arrays start at index 1
  50             pNeighbsIX[j] = indDist.index + 1;
  51             pNeighbsDS[j] = indDist.distance;
  52             j++;
  53             listI_move_next(neighbsI);
  54         }
  55         SET_VECTOR_ELT(NIix, i, neighbsIX);
  56         SET_VECTOR_ELT(NIds, i, neighbsDS);
  57         UNPROTECT(2);
  58         listI_destroy(neighbsI);
  59         list_destroy(neighborhoods[i]);
  60     }
  61     free(neighborhoods);
  62
  63     // create R list labels to access with NI$ix and NI$ds
  64     SEXP listNames;
  65     char* lnames[2] = {"ix", "ds"}; //lists labels
  66     PROTECT(listNames = allocVector(STRSXP,2));
  67     for (int i=0; i<2; i++)
  68         SET_STRING_ELT(listNames,i,mkChar(lnames[i]));
  69
  70     // allocate and fill neighborhoods list to return
  71     SEXP NI;
  72     PROTECT(NI = allocVector(VECSXP, 2));
  73     SET_VECTOR_ELT(NI, 0, NIix);
  74     SET_VECTOR_ELT(NI, 1, NIds);
  75     setAttrib(NI, R_NamesSymbol, listNames);
  76
  77     UNPROTECT(4);
  78     return NI;
  79 }