Nothing
# root.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/. #
#_____________________________________________________________________#
#' @name root
#' @title Root IDs
#'
#' @description
#' Root IDs constitute the id of a stand alone expression.
#' That is one that is not contained inside of another call or expression.
#' The one exception to this is code blocks denoted by curly braces
#' that are not themselves part of another call or expression;
#' these we call code groups.
#' In definition, A root node is defined to be a node that either
#' has no parent or whose parent is a grouping node.
#'
#' @details
#' If `ignore.groups=TRUE` then groupings are ignored and root nodes within the
#' group are interpreted as roots, otherwise nodes within a group are not
#' interpreted as root. Groupings are always interpreted as root if the
#' parent is 0 or if the parent is a group and also a root.
#'
#' @inheritParams pd_get_children_ids
#'
#' @aliases root root-nodes root-ids
#' @seealso see \code{\link{pd_is_grouping}} for details on what a grouping is.
#' @example inst/examples/example-pd.R
#' @example inst/examples/example-roots.R
list()
pd_is_root <-
function( id, pd
, ignore.groups = TRUE #< Ignore groups? see details.
, .check=TRUE
){
#' @describeIn root Test if a node is a root node
#' @param ignore.groups Should \link[=pd_is_grouping]{groupings} be ignored?
if (.check){
pd <- ._check_parse_data(pd)
id <- ._check_id(id, pd)
}
if (length(id) > 1) return(sapply(id, pd_is_root, pd=pd, ignore.groups=ignore.groups))
if (!(id %in% pd$id)) stop("id not present in pd")
if (pd[pd$id == id,'token'] != 'expr') return(FALSE)
parent <- pd[pd$id == id,'parent']
if (parent == 0 ) return(TRUE)
if (ignore.groups && pd_is_grouping(parent, pd)) return(TRUE)
return(FALSE)
}
is_root <- internal(pd_is_root)
if(FALSE){#@testing
pd <- get_parse_data(parse(text='rnorm(10, mean=0, sd=1)', keep.source=TRUE))
root <- pd$id[pd$parent==0]
leaf <- pd$id[pd$parent!=0][1]
expect_true (pd_is_root(root, pd))
expect_false(pd_is_root(leaf, pd))
expect_equal(sum(pd_is_root(pd$id, pd=pd)), 1)
pd <- get_parse_data(parse(text={'{
x <- rnorm(10, mean=0, sd=1)
y <- runif(10)
plot(x,y)
}'}, keep.source=TRUE))
group.root <- pd$id[pd$parent==0]
roots <- children(group.root)[-1]
leaf <- .find_text('0')
expect_true(pd_is_root(group.root, pd), info="Grouping root")
expect_true(pd_is_root(roots[[1]], pd), info="Root within grouping.")
expect_equal(sum(pd_is_root(pd$id, pd=pd)), 4)
expect_equal(sum(pd_is_root(c(group.root, roots), pd)), 4)
expect_false(pd_is_root(leaf, pd))
expect_equal(sum(pd_is_root(pd$id, pd, ignore.groups=FALSE)), 1)
expect_error(pd_is_root(0L, pd))
pd[pd$parent %in% c(0,group.root) & pd$token == 'expr', ]
expect_false(pd_is_root(roots[[1]], pd, ignore.groups = FALSE))
expect_equal(pd_is_root(c(group.root, roots[[1]]), pd, ignore.groups = FALSE), c(TRUE, FALSE))
pd <- get_parse_data(parse(text={"
# a comment outside the grouping
{# A grouping
#' An Roxygen Comment
hw <- function(){
{# Another Grouping
# but not a root since it is burried within a function
1+2 #< an expression that is not a root.
}
3+4 #< also not a root
}
4+5 #< this is a root expression
}
6+7 #< a regular root expression
"}, keep.source=TRUE))
id <- max(pd[pd$token =="'{'", 'parent'])
expect_true(pd_is_root(id, pd, ignore.groups = TRUE))
id <- min(pd[pd$token =="'{'", 'parent'])
expect_equal(get_family_pd(id, pd)[3,'text'], "# Another Grouping")
ids <- pd[pd$token =="'{'", 'parent']
expect_equal(pd_is_root(ids, pd, ignore.groups = TRUE ), c(TRUE, FALSE, FALSE))
expect_equal(pd_is_root(ids, pd, ignore.groups = FALSE), c(TRUE, FALSE, FALSE))
pd <- get_parse_data(parse(text="
# a comment
an_expression()
", keep.source=TRUE))
expect_false(pd_is_root(pd[1,'id'], pd))
}
.excluded.root.tokens <- c("'{'", "'}'", comment.classes$class, "NORMAL_COMMENT")
pd_all_root_ids <-
function( pd #< parse data from `<get_parse_data>`
, include.groups = TRUE #< Include groups as root nodes (T)
#^ or descend into [groups][pd_is_grouping] for roots?
){
#' @describeIn root give all root ids in `pd`
#' @param include.groups Include groups as root nodes (T)
#' or descend into [groups][pd_is_grouping] for roots?
roots <- pd[ !(abs(pd$parent) %in% pd$id )
& !( pd$token %in% .excluded.root.tokens)
, 'id']
while (!include.groups && any(. <- pd_is_grouping(roots, pd))) {
groups <- roots[.]
sub.ids <-
pd[ pd$parent %in% groups
& !(pd$token %in% .excluded.root.tokens)
, 'id']
roots <- sort(c(roots[!.], sub.ids))
}
return(roots)
}
roots <- internal(pd_all_root_ids)
if(FALSE){#@testing
pd <- get_parse_data(parse(text={"a <- 1
{# section 1
b <- 2
{# section 2
c <- 3
}# end of section 1
d <- 4
}# end of section 2
e <- 5
"}, keep.source=TRUE))
bases <- pd[pd$parent==0, 'id']
groups <- parent(.find_text('{'))
expect_equal(pd_all_root_ids(pd, TRUE), bases)
roots <- pd_all_root_ids(pd, FALSE)
expected <- parent(.find_text('<-'))
expect_equal(roots, expected)
expect_equal(getParseText(pd, roots), c('a <- 1','b <- 2', 'c <- 3', 'd <- 4', 'e <- 5'))
pd <- get_parse_data(parse(text="
# a comment
an_expression()
", keep.source=TRUE))
expect_equal( pd_all_root_ids(pd), -pd[1,'parent'])
pd <- utils::getParseData(parse(text={"
{# grouped code
# normal comment
#' Documenation before
hw <- function(){
#! documentation comment inside.
print('hello world')
}
}
{#Second Group
1+2
}
# Comment 3
4+5
"}, keep.source=TRUE))
expect_equal(pd_all_root_ids(pd), pd[pd$parent==0, 'id'])
}
all_root_nodes <-
function( pd #< parse data from `<get_parse_data>`
, include.groups = TRUE #< descend into grouped code \code{\{\}}?
){
#' @title Find all root node from parse data
#' @inheritParams pd_get_children_ids
#' @param include.groups descend into grouped code \code{\{\}}?
#'
#' @description
#' A root node in a file is a standalone expression, such as in
#' source file a function definition.
#' when discussing a subset it is any expression that does not have
#' a parent in the subset.
pd[pd$id %in% pd_all_root_ids(pd, include.groups=include.groups), ]
#' @return \code{\link{parse-data}} with for the root nodes.
}
if(FALSE){#!@testing
pd <- get_parse_data(parse(text={"a <- 1
{# section 1
b <- 2
{# section 2
c <- 3
}# end of section 1
d <- 4
}# end of section 2
e <- 5
"}, keep.source=TRUE))
expect_equal(all_root_nodes(pd, TRUE)$id , c(7, 52, 63))
expect_equal(all_root_nodes(pd, TRUE)$line1, c(1, 2, 9))
expect_equal(all_root_nodes(pd, FALSE)$id , c(7, 19, 31, 47, 63))
expect_equal(all_root_nodes(pd, FALSE)$line1, c(1, 3, 5, 7, 9))
}
#@internal
ascend_to_root <-
function( id = pd$id
, pd = get('pd', parent.frame())
, ignore.groups=TRUE #< Ignore groups? see <pd_is_root>.
, .check=TRUE
) {
#' @describeIn root ascend from id to root
if (.check){
pd <- ._check_parse_data(pd)
id <- ._check_id(id, pd)
}
if (length(id) > 1L) return(sapply(id, ascend_to_root, pd=pd, ignore.groups=ignore.groups))
while (TRUE) {
if (is.na(id) || id == 0) return(0L)
if (id < 0) id <- -id
if (pd_is_root(id, pd, ignore.groups=ignore.groups)) return(id)
id <- parent(id)
}
}
if(FALSE){#@testing
pd <- get_parse_data(parse(text='rnorm(10, mean=0, sd=1)', keep.source=TRUE))
root <- roots(pd)
expect_equal(ascend_to_root(id=root, pd), root)
expect_equal(ascend_to_root(id=1 , pd), root)
expect_identical(ascend_to_root(id=0, pd), 0L)
pd <- get_parse_data(parse(text={"
#' hello world
hw <- function(){
#! title
print('hello world!')
}
#' comment after
"}, keep.source=TRUE))
root <- roots(pd)
expect_equal(ascend_to_root(.find_text("#' hello world"), pd), root)
expect_equal(ascend_to_root(pd$id, pd=pd), c(rep(root, nrow(pd)-1), 0L))
pd <- get_parse_data(parse(text={"
{ #' hello world
hw <- function(){
#! title
print('hello world!')
}
#' comment after
}"}, keep.source=TRUE))
expect_false( ascend_to_root(.find_text('hw'), pd) %in% roots(pd))
expect_true( ascend_to_root(.find_text('hw'), pd) %in% roots(pd, FALSE))
expect_true(is_root(next_sibling(.find_text("#' hello world"))))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.