Commit | Line | Data |
---|---|---|
15d1825d BA |
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 | } |