add alternative approach from 2013-01
[synclust.git] / src / adapters / a.neighbors.c
... / ...
CommitLineData
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
10SEXP 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}