1 /* tree_build.c 2009-11-21 */
3 /* Copyright 2008-2009 Emmanuel Paradis */
5 /* This file is part of the R-package `ape'. */
6 /* See the file ../COPYING for licensing issues. */
9 #include <Rinternals.h>
11 static int str2int(char *x, int n)
13 int i, k = 1, ans = 0;
15 for (i = n - 2; i >= 0; i--, k *= 10)
16 ans += ((int)x[i] - 48) * k;
21 void decode_edge(const char *x, int a, int b, int *node, double *w)
24 char *endstr, str[100];
26 while (x[co] != ':') co++;
27 if (a == co) *node = 0;
29 for (i = a, k = 0; i < co; i++, k++) str[k] = x[i];
31 *node = str2int(str, k + 1);
33 for (i = co + 1, k = 0; i <= b; i++, k++) str[k] = x[i];
35 *w = R_strtod(str, &endstr);
38 #define ADD_INTERNAL_EDGE\
40 e[j + nedge] = curnode = ++node;\
43 #define ADD_TERMINAL_EDGE\
45 decode_edge(x, pr + 1, ps - 1, &tmpi, &tmpd);\
52 while (e[l + nedge] != curnode) l--;\
53 decode_edge(x, ps + 1, pt - 1, &tmpi, &tmpd);\
57 SEXP treeBuildWithTokens(SEXP nwk)
60 int n, i, ntip = 1, nnode = 0, nedge, *e, curnode, node, j, *skeleton, nsk = 0, ps, pr, pt, tmpi, l;
62 SEXP edge, edge_length, Nnode, phy;
64 PROTECT(nwk = coerceVector(nwk, STRSXP));
65 x = CHAR(STRING_ELT(nwk, 0));
67 skeleton = (int *)R_alloc(n, sizeof(int *));
68 for (i = 0; i < n; i++) {
69 if (x[i] == '(' || x[i] == ',' || x[i] == ')') {
74 case ',': ntip++; break;
75 case ')': nnode++; break;
79 nedge = ntip + nnode - 1;
81 PROTECT(Nnode = allocVector(INTSXP, 1));
82 PROTECT(edge = allocVector(INTSXP, nedge*2));
83 PROTECT(edge_length = allocVector(REALSXP, nedge));
84 INTEGER(Nnode)[0] = nnode;
87 el = REAL(edge_length);
89 curnode = node = ntip + 1;
92 for (i = 1; i < nsk - 1; i++) {
94 Rprintf(""); /* <- again !!!! */
102 /* !!! accolades indispensables !!! */
108 pt = skeleton[i + 1];
120 pr = skeleton[nsk - 2];
121 ps = skeleton[nsk - 1];
122 /* is the last edge terminal? */
123 if (x[pr] == ',' && x[ps] == ')') {
127 /* is there a root edge? */
129 PROTECT(phy = allocVector(VECSXP, 4));
131 decode_edge(x, ps + 1, n - 2, &tmpi, &tmpd);
132 PROTECT(root_edge = allocVector(REALSXP, 1));
133 REAL(root_edge)[0] = tmpd;
134 SET_VECTOR_ELT(phy, 3, root_edge);
136 } else PROTECT(phy = allocVector(VECSXP, 3));
138 SET_VECTOR_ELT(phy, 0, edge);
139 SET_VECTOR_ELT(phy, 1, edge_length);
140 SET_VECTOR_ELT(phy, 2, Nnode);
146 #undef ADD_INTERNAL_EDGE
147 #undef ADD_TERMINAL_EDGE