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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
|
{#######################################################################
# chilren.R
# This file is part of the R package `parsetools`.
#
# Author: Andrew Redd
# Copyright: 2017 The R Consortium
#
# LICENSE
# ========
# The R package `parsetools` is free software:
# you can redistribute it and/or modify it under the terms of the
# GNU General Public License as published by the Free Software
# Foundation, either version 2 of the License, or (at your option)
# any later version.
#
# This software is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see http://www.gnu.org/licenses/.
#
}#######################################################################
#' @include internal.R
#' @name family-nodes
#' @title Family-wise Node Identification and Navigation.
#'
#' @description
#' Parse data is organized into a hierarchy of nodes. These functions provide
#' simple ways to identify the nodes of interest, often from a specified node
#' of interest.
#'
#' @details
#' The language parsetools uses is that of family.
#' Similar to a family each node could have: a \dfn{parent}, the node that contains the
#' node in question; \dfn{children}, the nodes contained by the given node;
#' \dfn{ancestors}, the collection of nodes that contain the given node, it's parent,
#' it's parent's parent, and so on; and \dfn{descendents}, the collection of nodes that are
#' contained by the given node or contained by those nodes, and so on.
#' Terminology is analogous, a \dfn{generation} is all the the nodes at the same depth in
#' the hierarchy. A node may have \dfn{siblings}, the set of nodes with the same parent.
#' If a node does not have a parent it is called a \dfn{root} node.
#'
#' Similarly, age is also used as an analogy for ease of navigation. Generally, nodes
#' are numbered by the order that they are encountered, when parsing the source.
#' Therefore the node with the smallest `id` among a set of siblings is referred to the
#' \dfn{firstborn}. This is give the special designation as it is the most often of children
#' used, as it likely determines the type of call or expression that is represented by the node.
#' The firstborn has no 'older' siblings, the 'next' sibling would be the next oldest, i.e. the
#' node among siblings with the smallest id, but is not smaller that the reference node id.
#'
#' In all cases when describing function the `id`, is assumed to be in the context of the
#' parse data object `pd` and for convenience refers to the node associated with said `id`.
#'
#' @param pd The \code{\link{parse-data}} information
#' @param id id of the expression of interest
#' @param ngenerations Number of generations to go forwards or backwards.
#' @param include.self Should the root node (\code{id}) be included?
#' @param aggregate Should aggregate(TRUE) or only the
#' the final (FALSE) generation be returned?
#' @param .check Perform checks for input validation?
#' @example inst/examples/example-pd.R
#' @example inst/examples/example-roots.R
#' @example inst/examples/example-children.R
NULL
#' @describeIn family-nodes Get all nodes that are children of `id`.
#' Get all ids in `pd` that are children of \code{id}.
#' i.e. lower in the hierarchy or with id as a parent.
#' If \code{ngenerations} is greater than 1 and \code{aggregate}
#' is \code{TRUE}, all descendents are aggregated and returned.
pd_get_children_ids <-
function( id, pd
, ngenerations = 1
, include.self = FALSE
, aggregate = TRUE
, .check=TRUE
) {
if (.check){
pd <- ._check_parse_data(pd)
id <- ._check_id(id, pd)
}
parents <- id
ids <- if(include.self) parents else integer(0)
while(ngenerations != 0) {
ngenerations <- ngenerations - 1
old.ids <- ids
new.ids <- pd[pd$parent %in% parents, 'id']
parents <-
ids <- unique(c(if(aggregate)ids , new.ids))
if (identical(ids, old.ids)) break
}
ids
}
children <- internal(pd_get_children_ids)
if(FALSE){#! @test
pd <- get_parse_data(parse(text='rnorm(10, mean=0, sd=1)', keep.source=TRUE))
id <- pd[pd$parent==0, 'id']
kids <- pd[pd$parent==id, 'id']
expect_equal( pd_get_children_ids(id, pd, 1, include.self = FALSE)
, kids
, info="for default values"
)
expect_equal( pd_get_children_ids(id, pd, 1, include.self=TRUE)
, c(id,kids)
, info='include.self=TRUE'
)
grandkids <- pd[pd$parent %in% kids, 'id']
expect_equal( pd_get_children_ids( id, pd, 2, include.self=FALSE
, aggregate = FALSE
)
, grandkids
, info='ngenerations=2, include.self=FALSE, aggregate=FALSE'
)
expect_equal( sort(pd_get_children_ids( id, pd
, ngenerations=2
, include.self=FALSE
, aggregate = TRUE
))
, sort(c(kids, grandkids))
, info='ngenerations=2, include.self=FALSE, aggregate=TRUE'
)
expect_equal( sort(pd_get_children_ids( id, pd
, ngenerations=2
, include.self=TRUE
, aggregate = TRUE
))
, sort(c(id, kids, grandkids))
, info='ngenerations=2, include.self=TRUE, aggregate=TRUE'
)
expect_error( pd_get_children_ids(.Machine$integer.max, pd)
, "id\\([0-9]+\\) is not present in given parse-data."
)
expect_true( all(pd$id %in% pd_get_children_ids(0, pd, Inf)))
}
get_children_pd <-
function( id, pd
, ... #< passed to <pd_get_children_ids>.
, .check = TRUE
) {
if (.check){
pd <- ._check_parse_data(pd)
id <- ._check_id(id, pd)
stopifnot( length(id) == 1L
, inherits(pd, 'parse-data')
)
}
pd[pd$id %in% children( id, pd,...), ]
}
if(FALSE){#!@test
'rnorm(10, mean=0, sd=1)' -> text
pd <- get_parse_data(parse(text=text, keep.source=TRUE))
id <- pd[match('rnorm', pd$text), 'parent']
expect_identical( get_children_pd(id, pd), utils::head(pd, 1), info='defaults')
expect_identical( get_children_pd(id, pd, include.self=TRUE), utils::head(pd, 2), info='include.self=TRUE')
expect_identical( get_children_pd(id=parent(id), pd=pd, ngenerations=1, include.self=FALSE)
, pd[pd$parent==parent(id),]
, info='defaults')
expect_identical( get_children_pd(id=parent(id), pd=pd, ngenerations=1, include.self=TRUE)
, pd[pd$parent==parent(id) | pd$id==parent(id),]
, info='defaults')
expect_identical( get_children_pd(id=parent(id), pd=pd, ngenerations=2, include.self=TRUE)
, pd
, info='defaults')
expect_identical( get_children_pd(id=parent(id), pd=pd, ngenerations=2, include.self=FALSE, aggregate=FALSE)
, pd[pd$parent != parent(id) & pd$parent != 0, ]
, info='defaults')
expect_error(get_children_pd(id=pd$id, pd=pd))
}
#' Count the number of children
n_children <- function(id=pd$id, pd=get('pd', parent.frame())){
#' @inheritParams pd_get_children_ids
if (length(id)>1L) return(sapply(id, n_children, pd=pd))
length(children(id))
}
if(FALSE){#@testing
ex.file <- system.file("examples", "example.R", package="parsetools")
exprs <- parse(ex.file, keep.source = TRUE)
pd <- get_parse_data(exprs)
expect_equal(n_children(roots(pd)), c(3, 3, 8))
}
|
