File: ancestors.c

package info (click to toggle)
r-cran-phylobase 0.8.6-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 1,308 kB
  • sloc: cpp: 306; ansic: 247; xml: 135; lisp: 38; sh: 9; makefile: 5
file content (53 lines) | stat: -rw-r--r-- 1,591 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
/*
  ancestors.c:
    Identify all ancestors of each node in the input vector. Function
  inputs are derived from a phylo4 edge matrix, which *must* be in
  postorder order. The isAncestor output is an indicator matrix of
  which nodes (rows, corresponding to the decendant vector) are
  ancestors of each input node (columns, corresponding to the nodes
  vector). It will contain 1 for each ancestor of the node, *including
  itself*, and 0 for all other nodes.

  Jim Regetz (NCEAS)
*/

#include <R.h>
#include <Rinternals.h>

SEXP ancestors_c(SEXP nod, SEXP anc, SEXP des) {

    int numEdges = length(anc);
    int numNodes = length(nod);

    int* nodes = INTEGER(nod);
    int* ancestor = INTEGER(anc);
    int* descendant = INTEGER(des);

    int parent = 0;
    SEXP isAncestor;

    PROTECT(isAncestor = allocMatrix(INTSXP, numEdges, numNodes));
    for (int n=0; n<numNodes; n++) {
        for (int i=0; i<numEdges; i++) {
            if (nodes[n]==descendant[i]) {
                INTEGER(isAncestor)[i + n*numEdges] = 1;
            } else {
                INTEGER(isAncestor)[i + n*numEdges] = 0;
            }
        }
    }
    for (int n=0; n<numNodes; n++) {
        for (int i=0; i<numEdges; i++) {
            if (INTEGER(isAncestor)[i + n*numEdges]==1) {
                parent = ancestor[i];
                for (int j=i+1; j<numEdges; j++) {
                    if (descendant[j]==parent) {
                        INTEGER(isAncestor)[j + n*numEdges]=1;
                    }
                }
            }
        }
    }
    UNPROTECT(1);
    return isAncestor;
}