Nothing
# * Author: Bangyou Zheng (Bangyou.Zheng@csiro.au)
# * Created: 01:09 PM Thursday, 21 February 2019
# * Copyright: MIT
#' Find element(s) in apsimx file
#'
#' @param l The list of apsimx file
#' @param all Whether to find all elements
#' @param max_depth The maximum depth to search
#' @param ... Other names arguments for property to match
#'
#' @return A list matching all criteria if all equals to TRUE,
#' A list with node and path if all equals to FALSE (default)
#' @export
#'
#' @examples
#' wheat <- read_apsimx(system.file("Wheat.json", package = "rapsimng"))
#' # Return empty list if not found
#' search_node(wheat, Name = "Simulations1")
#' # Find root level
#' a <- search_node(wheat, Name = "Simulations")
#' a$path
#' # Find sub-level
#' a <- search_node(wheat, Name = "Wheat")
#' a$path
#' a <- search_node(wheat, `$type` = "Models.PMF.Cultivar, Models")
#' a$path
#'
#' # Find multiple attributes
#' a <- search_node(wheat,
#' Name = 'PotentialBranchingRate',
#' `$type` = "Models.Functions.PhaseLookup, Models")
#' a$path
#' a$node$Name
#' # Find all cultivar nodes
#' a <- search_node(wheat, `$type` = "Models.PMF.Cultivar, Models", all = TRUE)
#' length(a)
search_node <- function(l, all = FALSE, max_depth = 1000000, ...) {
conds <- list(...)
ele_names <- names(conds)
if (!(!is.null(ele_names) && all(nchar(ele_names) > 0))) {
stop('All elements should be named.')
}
r_search_node <- function(l, conds, ele_names, max_depth, cdepth, cpath = 1, all = FALSE, result = list()){
check <- TRUE
for (i in seq(along = conds)) {
check <- check && !is.null(l[[ele_names[i]]]) && l[[ele_names[i]]] == as.character(conds[i])
}
if (check) {
# assign('l', l, .GlobalEnv)
# stop()
r <- list()
r$node <- l
r$path <- cpath[-length(cpath)]
r$path <- cpath
class(r) <- 'apsimxNode'
result[[length(result) + 1]] <- r
if (!all) {
return (result)
}
}
if (cdepth > max_depth) {
return (result)
}
if (!is.null(l$Children) && length(l$Children) > 0) {
for (i in seq(along = l$Children)) {
result <- r_search_node(l$Children[[i]], conds, ele_names, max_depth, cdepth + 1,
cpath = c(cpath, i), result = result)
}
}
return (result)
}
res <- r_search_node(l, conds, ele_names, max_depth, 1, all = all)
if (length(res) == 0) {
return (res)
}
if (!all) {
if (length(all) != 1) {
stop("Require 1 element if all = TRUE")
}
res <- res[[1]]
}
return(res)
}
#' Find a model in the apsimx file using specified path
#'
#' @section Absolute Paths:
#' Absolute paths have a leading ‘.’ e.g.
#' \itemize{
#' \item .Simulations.Test.Clock - absolute path - refers to the clock model
#' in the 'Test' simulation.
#' }
#'
#' @section Scoped Paths:
#' Scoped paths have a leading model type in square brackets. A model
#' of the specified name, in scope, is located before applying the rest of the path.
#' \itemize{
#' \item [Soil].Water - scoped path - refers to the Water model that is a child of a model
#' that has the name 'Soil' that is in scope
#' }
#'
#' @param l the list of apsimx file
#' @param path The specified path (See details)
#' @return The list for the specified path.
#' @export
#'
#' @examples
#' wheat <- read_apsimx(system.file("Wheat.json", package = "rapsimng"))
#' # Return empty list if not found
#' search_path(wheat, "[Simulations1]")
#' # Search root path
#' a <- search_path(wheat, '.Simulations')
#' a$path
#' a$node$Name
#' # Level one
#' a <- search_path(wheat, '.Simulations.Wheat1')
#' a$path
#' a$node$Name
#' # Level two
#' a <- search_path(wheat, '.Simulations.Wheat')
#' a$path
#' a$node$Name
#' # Level three
#' a <- search_path(wheat, '.Simulations.Wheat.BranchingRate')
#' a$path
#' a$node$Name
#' a <- search_path(wheat, '.Simulations.Wheat.Structure')
#' a$path
#' a$node$Name
#' # Level four
#' a <- search_path(wheat, '.Simulations.Wheat.Structure.BranchingRate')
#' a$path
#' a$node$Name
#' a <- search_path(wheat, '.Simulations.Wheat.Structure.BranchingRate1')
#' a$path
#' a$node$Name
#' # scoped
#' # Root path
#' a <- search_path(wheat, '[Simulations1]')
#' a <- search_path(wheat, '[Simulations]')
#' a$path
#' a$node$Name
#' # Level two
#' a <- search_path(wheat, '[Simulations].Wheat1')
#' a <- search_path(wheat, '[Simulations1].Wheat')
#' a$path
#' a$node$Name
#' a <- search_path(wheat, '[Whea]')
#' a <- search_path(wheat, '[Wheat]')
#' a$path
#' a$node$Name
#' # Level three
#' a <- search_path(wheat, '[Wheat].BranchingRate')
#' a <- search_path(wheat, '[Wheat].Structure')
#' a$path
#' a$node$Name
#' a <- search_path(wheat, '[Structure]')
#' a$path
#' a$node$Name
#' # Level four
#' a <- search_path(wheat, '[Structure].BranchingRate')
#' a$path
#' a$node$Name
#' a <- search_path(wheat, '[Structure].BranchingRate1')
#' a <- search_path(wheat, '[Structure1].BranchingRate')
search_path <- function(l, path) {
if (length(path) != 1) {
stop('Only one path is supported.')
}
path_type <- ifelse(grepl('^\\.', path), 'absolute',
ifelse(grepl('^\\[.*\\]\\.*', path), 'scoped', 'NotSupported'))
if (path_type == 'NotSupported') {
stop('The path is not supported.')
}
if (path_type == 'scoped') {
name <- sub('^\\[(.*)\\].*', '\\1', path)
path <- sub('^\\[(.*)\\](.*)', '\\2', path)
l <- search_node(l, Name = name)
if (is.null(l$node)) {
return(list())
}
} else if (path_type == 'absolute') {
l <- list(node = l, path = c(1))
}
if (nchar(path) == 0) {
return(l)
}
search_path_str <- sub('^\\.', '', path)
search_path_str <- strsplit(search_path_str, '\\.')[[1]]
current_node <- l
for (i in seq_along(search_path_str)) {
old_path <- current_node$path
current_node <- search_node(current_node$node, Name = search_path_str[i], max_depth = 1)
if (is.null(current_node$node)) {
return (list())
}
current_node$path <- c(old_path, current_node$path[-1])
if (is.null(current_node$node)) {
return (list())
}
}
return(current_node)
}
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.