Nothing
R/edit_apsimx_replacement.R
In apsimx: Inspect, Read, Edit and Run 'APSIM' "Next Generation" and 'APSIM' Classic
Defines functions
edit_node
edit_apsimx_replacement
Documented in
edit_apsimx_replacement
#'
#' @title Edit a replacement component in an .apsimx (JSON) file
#' @name edit_apsimx_replacement
#' @description edit the replacement componenet of an JSON apsimx file. It does not replace the GUI, but it can save time by quickly editing parameters and values.
#' @param file file ending in .apsimx to edit (JSON)
#' @param src.dir directory containing the .apsimx file; defaults to the current working directory
#' @param wrt.dir should be used if the destination directory is different from the src.dir
#' @param node specific node to edit
#' @param node.child specific node child component to edit.
#' @param node.subchild specific node sub-child to edit.
#' @param node.subsubchild specific node sub-subchild to edit.
#' @param node.sub3child specific node sub-sub-subchild to edit.
#' @param node.sub4child specific node sub-sub-sub-subchild to edit.
#' @param node.sub5child specific node sub-sub-sub-sub-subchild to edit.
#' @param node.string passing of a string instead of the node hierarchy. It can either start with a dot or not.
#' However, the \sQuote{best} form is not to start with a dot as it should be a more convenient form of passing
#' the nodes and their childs and not a real \sQuote{jsonpath}.
#' @param root \sQuote{root} node to explore (default = \dQuote{Models.Core.Replacements})
#' @param parm specific parameter to edit
#' @param value new values for the parameter
#' @param overwrite logical; if \code{TRUE} the old file is overwritten, a new file is written otherwise
#' @param edit.tag if the file is edited a different tag from the default \sQuote{-edited} can be used.
#' @param verbose whether to print information about successful edit
#' @param grep.options Additional options for grep. To be passed as a list.
#' @details This is simply a script that prints the relevant parameters which are likely to need editing. It does not print all information from an .apsimx file.
#' @return (when verbose=TRUE) complete file path to edited .apsimx file is returned as a character string.
#' As a side effect this function creates a new (JSON) .apsimx file.
#' @note The components that can be edited are restricted becuase this is better in preventing
#' errors of editing unintended parts of the file.
#' @export
#' @examples
#' \donttest{
#' extd.dir <- system.file("extdata", package = "apsimx")
#' ## Writing to a temp directory, but change as needed
#' tmp.dir <- tempdir()
#'
#' ## Inspect original values
#' inspect_apsimx_replacement("MaizeSoybean.apsimx",
#' src.dir = extd.dir,
#' node = "Maize",
#' node.child = "Phenology",
#' node.subchild = "ThermalTime",
#' node.subsubchild = "BaseThermalTime",
#' node.sub3child = "Response")
#'
#' edit_apsimx_replacement("MaizeSoybean.apsimx",
#' src.dir = extd.dir, wrt.dir = tmp.dir,
#' node = "Maize",
#' node.child = "Phenology",
#' node.subchild = "ThermalTime",
#' node.subsubchild = "BaseThermalTime",
#' node.sub3child = "Response",
#' parm = "X",
#' value = c(10, 20, 30, 40, 50))
#' ## inspect it
#' inspect_apsimx_replacement("MaizeSoybean-edited.apsimx",
#' src.dir = tmp.dir,
#' node = "Maize",
#' node.child = "Phenology",
#' node.subchild = "ThermalTime",
#' node.subsubchild = "BaseThermalTime",
#' node.sub3child = "Response")
#'
#' ## Illustrating using 'node.string'
#' ## Equivalent to the code to edit above
#'
#' edit_apsimx_replacement("MaizeSoybean-edited.apsimx",
#' src.dir = tmp.dir, wrt.dir = tmp.dir,
#' node.string = "Maize.Phenology.ThermalTime.BaseThermalTime.Response",
#' parm = "X",
#' value = c(11, 21, 31, 41, 51),
#' edit.tag = "-ns")
#'
#' inspect_apsimx_replacement("MaizeSoybean-edited-ns.apsimx",
#' src.dir = tmp.dir,
#' node = "Maize",
#' node.child = "Phenology",
#' node.subchild = "ThermalTime",
#' node.subsubchild = "BaseThermalTime",
#' node.sub3child = "Response")
#' }
#'
edit_apsimx_replacement <- function(file = "", src.dir = ".", wrt.dir = ".",
node = NULL, node.child = NULL,
node.subchild = NULL, node.subsubchild = NULL,
node.sub3child = NULL, node.sub4child = NULL,
node.sub5child = NULL, node.string = NULL,
root = list("Models.Core.Replacements", NA),
parm = NULL, value = NULL, overwrite = FALSE,
edit.tag = "-edited", verbose = TRUE, grep.options){
file.names <- dir(path = src.dir, pattern=".apsimx$",ignore.case=TRUE)
if(length(file.names)==0){
stop("There are no .apsimx files in the specified directory to edit.")
}
## This matches the specified file from a list of files
## Notice that the .apsimx extension will be added here
file <- match.arg(file, file.names, several.ok=FALSE)
if(missing(parm) || missing(value)) stop("'parm' and/or 'value' are missing")
apsimx_json <- jsonlite::read_json(paste0(src.dir, "/", file))
## Select Replacements node
if(missing(grep.options)){
frn <- grep(root[[1]], apsimx_json$Children, fixed = TRUE)
}else{
gfixed <- ifelse(is.null(grep.options$fixed), FALSE, grep.options$fixed)
gignore.case <- ifelse(is.null(grep.options$ignore.case), FALSE, grep.options$ignore.case)
frn <- grep(root[[1]], apsimx_json$Children, fixed = gfixed, ignore.case = gignore.case)
}
if(length(frn) == 0){
### Here we try a different root
root <- list('Models.Core.Folder', NA)
frn <- grep(root[[1]], apsimx_json$Children, fixed = TRUE)
if(length(frn) == 0)
stop("Could not find 'root' for replacements", call. = FALSE)
}
if(length(frn) > 1){
if(is.na(root[[2]])){
cat("These positions matched ",root[[1]]," ",frn, "\n")
stop("Multiple root nodes found. Please provide a position")
}else{
replacements.node <- apsimx_json$Children[[frn[root[[2]]]]]
}
}else{
replacements.node <- apsimx_json$Children[[frn]]
}
if(!missing(grep.options)){
gfixed <- grep.options$fixed
gignore.case <- grep.options$ignore.case
}else{
gfixed <- FALSE
gignore.case <- FALSE
}
## Print names of replacements
replacements.node.names <- vapply(replacements.node$Children, function(x) x$Name,
FUN.VALUE = "character")
if(verbose) cat("Replacements: ", replacements.node.names, "\n")
if(!missing(node.string)){
## strip the dot automatically if it is included
if(strsplit(node.string, "")[[1]][1] == "."){
node.string <- substring(node.string, 2)
}
## If I want to provide the path returned by inspect_apsimx_replacement
## directly I need to strip the first part which is likely to be '.Simulations.Replacement.'
if(grepl(".Replacements.", node.string)){
node.string <- strsplit(node.string, ".Replacements.", fixed = TRUE)[[1]][2]
}
nodes <- strsplit(node.string, ".", fixed = TRUE)[[1]]
node <- nodes[1]
if(!is.na(nodes[2])) node.child <- nodes[2]
if(!is.na(nodes[3])) node.subchild <- nodes[3]
if(!is.na(nodes[4])) node.subsubchild <- nodes[4]
if(!is.na(nodes[5])) node.sub3child <- nodes[5]
if(!is.na(nodes[6])) node.sub4child <- nodes[6]
if(!is.na(nodes[7])) node.sub5child <- nodes[7]
}
if(missing(node)) return(cat("Please provide a node \n"))
## Let's call this level = 0, at the 'node' level (nothing to edit)
lvl <- -1
wrn <- grep(node, replacements.node.names)
rep.node <- replacements.node$Children[[wrn]]
if(!is.null(rep.node$CropType) && verbose) cat("CropType", rep.node$CropType,"\n")
if(parm %in% names(rep.node)){
lvl <- 0
rep.node <- edit_node(rep.node, parm = parm, value = value)
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
}
rep.node.children.names <- sapply(rep.node$Children, function(x) x$Name)
if(verbose) cat("Available node children: ", rep.node.children.names, "\n")
## Select a specific node.child
if(missing(node.child) && lvl == -1) return(cat("missing node.child\n"))
## Node.child would be level = 1, still nothing to edit
if(!missing(node.child)){
wrnc <- grep(node.child, rep.node.children.names)
rep.node.child <- rep.node$Children[[wrnc]]
if(any(parm %in% names(rep.node.child))){
lvl <- 1
rep.node.child <- edit_node(rep.node.child, parm = parm, value = value)
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
}
## Cultivar parameters can be in 'Command'
if(length(rep.node.child$Command) > 0){
if(any(grepl(parm, unlist(rep.node.child$Command)))){
lvl <- 2
wrnsc <- grep(parm, unlist(rep.node.child$Command), fixed = gfixed, ignore.case = gignore.case)
## Break it up and reassemble
cmdstrng <- strsplit(rep.node.child$Command[[wrnsc]], "=")[[1]][1]
rep.node.child$Command[[wrnsc]] <- paste0(cmdstrng, "=", value)
## Now write back to list
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
}
}
if(missing(node.subchild) && lvl == -1)
stop("Failed to find and edit parameter")
rep.node.subchildren.names <- sapply(rep.node.child$Children, function(x) x$Name)
}
## Select a specific node.subchild
if(missing(node.subchild) && verbose && missing(parm)) cat("missing node.subchild\n")
if(!missing(node.subchild)){
wrnsc <- grep(node.subchild, rep.node.subchildren.names)
rep.node.subchild <- rep.node.child$Children[[wrnsc]]
if(verbose) cat("Subchild Name: ", rep.node.subchild$Name,"\n")
if(parm %in% names(rep.node.subchild)){
rep.node.subchild <- edit_node(rep.node.subchild, parm = parm, value = value)
lvl <- 3
rep.node.child$Children[[wrnsc]] <- rep.node.subchild
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
## apsimx_json is ready to be written back to file
}
## Cultivar parameters can be in 'Command'
if(length(rep.node.subchild$Command) > 0){
if(any(grepl(parm, unlist(rep.node.subchild$Command)))){
lvl <- 3
wrnscc <- grep(parm, unlist(rep.node.subchild$Command), fixed = gfixed, ignore.case = gignore.case)
## Break it up and reassemble
cmdstrng <- strsplit(rep.node.subchild$Command[[wrnscc]], "=")[[1]][1]
rep.node.subchild$Command[[wrnscc]] <- paste0(cmdstrng, "=", value)
## Now write back to list
rep.node.child$Children[[wrnsc]] <- rep.node.subchild
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
}
}
if(missing(node.subsubchild) && lvl == -1)
stop("Failed to find and edit parameter")
}
if(missing(node.subsubchild) && verbose && missing(parm)) cat("missing node.subsubchild\n")
if(!missing(node.subsubchild)){
rep.node.subsubchildren.names <- vapply(rep.node.subchild$Children, function(x) x$Name,
FUN.VALUE = "character")
## Select a specific node.subsubchild
wrnssc <- grep(node.subsubchild, rep.node.subsubchildren.names)
if(length(wrnssc) == 0) stop("node.subsubchild not found")
if(length(wrnssc) > 1) stop("More than one subsubchild found. Make it unique (see regular expressions)")
rep.node.subsubchild <- rep.node.subchild$Children[[wrnssc]]
if(verbose) cat("Subsubchild Name: ", rep.node.subsubchild$Name,"\n")
if(parm %in% names(rep.node.subsubchild)){
rep.node.subsubchild <- edit_node(rep.node.subsubchild, parm = parm, value = value)
lvl <- 4
rep.node.subchild$Children[[wrnssc]] <- rep.node.subsubchild
rep.node.child$Children[[wrnsc]] <- rep.node.subchild
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
## apsimx_json is ready to be written back to file
}
## Cultivar parameters can be in 'Command'
if(length(rep.node.subsubchild$Command) > 0){
if(any(grepl(parm, unlist(rep.node.subsubchild$Command)))){
lvl <- 5
wrnsscc <- grep(parm, unlist(rep.node.subsubchild$Command), fixed = gfixed, ignore.case = gignore.case)
if(length(wrnsscc) == 0) stop("node.subsubchild Command not found")
if(length(wrnsscc) > 1) stop("More than one subsubchild Command found. Make it unique (see regular expressions)")
## Break it up and reassemble
cmdstrng <- strsplit(rep.node.subsubchild$Command[[wrnsscc]],"=")[[1]][1]
rep.node.subsubchild$Command[[wrnsscc]] <- paste0(cmdstrng,"=",value)
## cat("New string:", rep.node.subsubchild$Command[[wrnsscc]], "\n")
## Now write back to list
rep.node.subchild$Children[[wrnssc]] <- rep.node.subsubchild
rep.node.child$Children[[wrnsc]] <- rep.node.subchild
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
}
}
if(missing(node.sub3child) && lvl == -1)
stop("Failed to find and edit parameter")
}
## Inserting deeper level June 15th 2020
if(missing(node.sub3child) && verbose && missing(parm)) cat("missing node.sub3child\n")
if(!missing(node.sub3child)){
rep.node.sub3children.names <- vapply(rep.node.subsubchild$Children, function(x) x$Name,
FUN.VALUE = "character")
## Select a specific node.subchild
wrnsssc <- grep(node.sub3child, rep.node.sub3children.names)
if(length(wrnsssc) == 0) stop("node.sub4child not found")
if(length(wrnsssc) > 1) stop("More than one sub3child found. Make it unique (see regular expressions)")
rep.node.sub3child <- rep.node.subsubchild$Children[[wrnsssc]]
if(verbose) cat("Sub-sub-subchild Name: ", rep.node.sub3child$Name,"\n")
if(any(parm %in% names(rep.node.sub3child))){
rep.node.sub3child <- edit_node(rep.node.sub3child, parm = parm, value = value)
lvl <- 6
# node is edited, now put it back in place
rep.node.subsubchild$Children[[wrnsssc]] <- rep.node.sub3child
rep.node.subchild$Children[[wrnssc]] <- rep.node.subsubchild
rep.node.child$Children[[wrnsc]] <- rep.node.subchild
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
## apsimx_json is ready to be written back to file
}
## Cultivar parameters can be in 'Command'
if(length(rep.node.sub3child$Command) > 0){
if(any(grepl(parm, unlist(rep.node.sub3child$Command)))){
lvl <- 7
wrnssscc <- grep(parm, unlist(rep.node.sub3child$Command), fixed = gfixed, ignore.case = gignore.case)
if(length(wrnssscc) == 0) stop("node.sub3child Command not found")
if(length(wrnssscc) > 1) stop("More than one sub3child Command found. Make it unique (see regular expressions)")
## Break it up and reassemble
cmdstrng <- strsplit(rep.node.sub3child$Command[[wrnssscc]],"=")[[1]][1]
rep.node.sub3child$Command[[wrnssscc]] <- paste0(cmdstrng,"=",value)
## Now write back to list
rep.node.subsubchild$Children[[wrnsssc]] <- rep.node.sub3child
rep.node.subchild$Children[[wrnssc]] <- rep.node.subsubchild
rep.node.child$Children[[wrnsc]] <- rep.node.subchild
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
}
}
if(missing(node.sub4child) && lvl == -1)
stop("Failed to find and edit parameter")
}
if(missing(node.sub4child) && verbose && missing(parm)) cat("missing node.sub4child\n")
#### Inserting node.sub4child option March 5th 2021
if(!missing(node.sub4child)){
rep.node.sub4children.names <- vapply(rep.node.sub3child$Children, function(x) x$Name,
FUN.VALUE = "character")
## Select a specific node.subchild
wrnssssc <- grep(node.sub4child, rep.node.sub4children.names, fixed = gfixed, ignore.case = gignore.case)
if(length(wrnssssc) == 0) stop("node.sub4child not found")
if(length(wrnssssc) > 1) stop("More than one sub4child found. Make it unique (see regular expressions)")
rep.node.sub4child <- rep.node.sub3child$Children[[wrnssssc]]
if(verbose) cat("Sub-sub-sub-subchild Name: ", rep.node.sub4child$Name,"\n")
if(any(parm %in% names(rep.node.sub4child))){
rep.node.sub4child <- edit_node(rep.node.sub4child, parm = parm, value = value)
lvl <- 8
# node is edited, now put it back in place
rep.node.sub3child$Children[[wrnssssc]] <- rep.node.sub4child
rep.node.subsubchild$Children[[wrnsssc]] <- rep.node.sub3child
rep.node.subchild$Children[[wrnssc]] <- rep.node.subsubchild
rep.node.child$Children[[wrnsc]] <- rep.node.subchild
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
## apsimx_json is ready to be written back to file
}
## Cultivar parameters can be in 'Command'
if(length(rep.node.sub4child$Command) > 0){
if(any(grepl(parm, unlist(rep.node.sub4child$Command)))){
lvl <- 9
wrnsssscc <- grep(parm, unlist(rep.node.sub4child$Command), fixed = gfixed, ignore.case = gignore.case)
if(length(wrnsssscc) == 0) stop("node.sub4child Command not found")
if(length(wrnsssscc) > 1) stop("More than one sub4child Command found. Make it unique (see regular expressions)")
## Break it up and reassemble
cmdstrng <- strsplit(rep.node.sub4child$Command[[wrnsssscc]], "=")[[1]][1]
rep.node.sub4child$Command[[wrnsssscc]] <- paste0(cmdstrng, "=", value)
## Now write back to list
rep.node.sub3child$Children[[wrnssssc]] <- rep.node.sub4child
rep.node.subsubchild$Children[[wrnsssc]] <- rep.node.sub3child
rep.node.subchild$Children[[wrnssc]] <- rep.node.subsubchild
rep.node.child$Children[[wrnsc]] <- rep.node.subchild
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
}
}
if(missing(node.sub5child) && lvl == -1)
stop("Failed to find and edit parameter")
}
if(missing(node.sub5child) && verbose && missing(parm)) cat("missing node.sub5child\n")
#### Inserting node.sub5child option March 5th 2021
if(!missing(node.sub5child)){
rep.node.sub5children.names <- vapply(rep.node.sub4child$Children, function(x) x$Name,
FUN.VALUE = "character")
## Select a specific node.subchild
wrnsssssc <- grep(node.sub5child, rep.node.sub5children.names, fixed = gfixed, ignore.case = gignore.case)
if(length(wrnsssssc) == 0) stop("node.subs5child not found")
if(length(wrnsssssc) > 1) stop("More than one sub5child found. Make it unique (see regular expressions)")
rep.node.sub5child <- rep.node.sub4child$Children[[wrnsssssc]]
if(verbose) cat("Sub-sub-sub-sub-subchild Name: ", rep.node.sub5child$Name,"\n")
if(any(parm %in% names(rep.node.sub5child))){
rep.node.sub5child <- edit_node(rep.node.sub5child, parm = parm, value = value)
lvl <- 10
# node is edited, now put it back in place
rep.node.sub4child$Children[[wrnsssssc]] <- rep.node.sub5child
rep.node.sub3child$Children[[wrnssssc]] <- rep.node.sub4child
rep.node.subsubchild$Children[[wrnsssc]] <- rep.node.sub3child
rep.node.subchild$Children[[wrnssc]] <- rep.node.subsubchild
rep.node.child$Children[[wrnsc]] <- rep.node.subchild
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
## apsimx_json is ready to be written back to file
}
## Cultivar parameters can be in 'Command'
if(length(rep.node.sub5child$Command) > 0){
if(any(grepl(parm, unlist(rep.node.sub5child$Command)))){
lvl <- 11
wrnssssscc <- grep(parm, unlist(rep.node.sub5child$Command), fixed = gfixed, ignore.case = gignore.case)
if(length(wrnssssscc) == 0) stop("node.subs5child Command not found")
if(length(wrnssssscc) > 1) stop("More than one sub5child Command found. Make it unique (see regular expressions)")
## Break it up and reassemble
cmdstrng <- strsplit(rep.node.sub5child$Command[[wrnssssscc]], "=")[[1]][1]
rep.node.sub5child$Command[[wrnssssscc]] <- paste0(cmdstrng, "=", value)
## Now write back to list
rep.node.sub4child$Children[[wrnsssssc]] <- rep.node.sub5child
rep.node.sub3child$Children[[wrnssssc]] <- rep.node.sub4child
rep.node.subsubchild$Children[[wrnsssc]] <- rep.node.sub3child
rep.node.subchild$Children[[wrnssc]] <- rep.node.subsubchild
rep.node.child$Children[[wrnsc]] <- rep.node.subchild
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
}
}
if(lvl == -1)
stop("Failed to find and edit parameter")
}
## Write back to a file
if(overwrite == FALSE){
wr.path <- paste0(wrt.dir,"/",
strsplit(file,".",fixed = TRUE)[[1]][1],
edit.tag,".apsimx")
}else{
wr.path <- paste0(wrt.dir,"/",file)
}
jsonlite::write_json(apsimx_json, path = wr.path,
pretty = TRUE, digits = NA,
auto_unbox = TRUE, null = "null")
if(verbose){
if(!missing(node)) cat("Edited (node): ",node, "\n")
if(!missing(node.child)) cat("Edited (node.child): ", node.child,"\n")
if(!missing(node.subchild)) cat("Edited (node.subchild): ", node.subchild,"\n")
if(!missing(node.subsubchild)) cat("Edited (node.subsubchild): ", node.subsubchild,"\n")
if(!missing(node.sub3child)) cat("Edited (node.sub3child): ", node.sub3child,"\n")
cat("Edit (level): ", lvl,"\n")
cat("Edited parameter: ",parm, "\n")
if(inherits(value, "factor")){
cat("New values: ",as.character(value), "\n")
}else{
cat("New values: ",value, "\n")
}
cat("Created: ",wr.path,"\n")
}
}
edit_node <- function(x, parm = NULL, value = NULL){
## parm is presumably a component in names of x
if(length(names(x)) == 0) stop("no 'names' in node to edit")
if(is.null(parm) | is.null(value)) stop("parm or value are missing")
if(length(parm) == 1){
x.nms <- names(x)
## print(x.nms)
## wne <- which(x.nms == parm)
wne <- grep(parm, x.nms)
## if(length(x[[wne]]) != 1) stop("value should be of length = 1")
x[[wne]] <- value
}
if(length(parm) > 1){
x.nms <- names(x)
wne <- grepl(parm, x.nms)
j <- 1
for(i in wne){
x[[i]] <- value[j]
j <- j + 1
}
}
return(x)
}
Try the apsimx package in your browser
Any scripts or data that you put into this service are public.
apsimx documentation built on Sept. 11, 2024, 5:42 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions edit_node edit_apsimx_replacement
Documented in edit_apsimx_replacement
#'
#' @title Edit a replacement component in an .apsimx (JSON) file
#' @name edit_apsimx_replacement
#' @description edit the replacement componenet of an JSON apsimx file. It does not replace the GUI, but it can save time by quickly editing parameters and values.
#' @param file file ending in .apsimx to edit (JSON)
#' @param src.dir directory containing the .apsimx file; defaults to the current working directory
#' @param wrt.dir should be used if the destination directory is different from the src.dir
#' @param node specific node to edit
#' @param node.child specific node child component to edit.
#' @param node.subchild specific node sub-child to edit.
#' @param node.subsubchild specific node sub-subchild to edit.
#' @param node.sub3child specific node sub-sub-subchild to edit.
#' @param node.sub4child specific node sub-sub-sub-subchild to edit.
#' @param node.sub5child specific node sub-sub-sub-sub-subchild to edit.
#' @param node.string passing of a string instead of the node hierarchy. It can either start with a dot or not.
#' However, the \sQuote{best} form is not to start with a dot as it should be a more convenient form of passing
#' the nodes and their childs and not a real \sQuote{jsonpath}.
#' @param root \sQuote{root} node to explore (default = \dQuote{Models.Core.Replacements})
#' @param parm specific parameter to edit
#' @param value new values for the parameter
#' @param overwrite logical; if \code{TRUE} the old file is overwritten, a new file is written otherwise
#' @param edit.tag if the file is edited a different tag from the default \sQuote{-edited} can be used.
#' @param verbose whether to print information about successful edit
#' @param grep.options Additional options for grep. To be passed as a list.
#' @details This is simply a script that prints the relevant parameters which are likely to need editing. It does not print all information from an .apsimx file.
#' @return (when verbose=TRUE) complete file path to edited .apsimx file is returned as a character string.
#' As a side effect this function creates a new (JSON) .apsimx file.
#' @note The components that can be edited are restricted becuase this is better in preventing
#' errors of editing unintended parts of the file.
#' @export
#' @examples
#' \donttest{
#' extd.dir <- system.file("extdata", package = "apsimx")
#' ## Writing to a temp directory, but change as needed
#' tmp.dir <- tempdir()
#'
#' ## Inspect original values
#' inspect_apsimx_replacement("MaizeSoybean.apsimx",
#' src.dir = extd.dir,
#' node = "Maize",
#' node.child = "Phenology",
#' node.subchild = "ThermalTime",
#' node.subsubchild = "BaseThermalTime",
#' node.sub3child = "Response")
#'
#' edit_apsimx_replacement("MaizeSoybean.apsimx",
#' src.dir = extd.dir, wrt.dir = tmp.dir,
#' node = "Maize",
#' node.child = "Phenology",
#' node.subchild = "ThermalTime",
#' node.subsubchild = "BaseThermalTime",
#' node.sub3child = "Response",
#' parm = "X",
#' value = c(10, 20, 30, 40, 50))
#' ## inspect it
#' inspect_apsimx_replacement("MaizeSoybean-edited.apsimx",
#' src.dir = tmp.dir,
#' node = "Maize",
#' node.child = "Phenology",
#' node.subchild = "ThermalTime",
#' node.subsubchild = "BaseThermalTime",
#' node.sub3child = "Response")
#'
#' ## Illustrating using 'node.string'
#' ## Equivalent to the code to edit above
#'
#' edit_apsimx_replacement("MaizeSoybean-edited.apsimx",
#' src.dir = tmp.dir, wrt.dir = tmp.dir,
#' node.string = "Maize.Phenology.ThermalTime.BaseThermalTime.Response",
#' parm = "X",
#' value = c(11, 21, 31, 41, 51),
#' edit.tag = "-ns")
#'
#' inspect_apsimx_replacement("MaizeSoybean-edited-ns.apsimx",
#' src.dir = tmp.dir,
#' node = "Maize",
#' node.child = "Phenology",
#' node.subchild = "ThermalTime",
#' node.subsubchild = "BaseThermalTime",
#' node.sub3child = "Response")
#' }
#'
edit_apsimx_replacement <- function(file = "", src.dir = ".", wrt.dir = ".",
node = NULL, node.child = NULL,
node.subchild = NULL, node.subsubchild = NULL,
node.sub3child = NULL, node.sub4child = NULL,
node.sub5child = NULL, node.string = NULL,
root = list("Models.Core.Replacements", NA),
parm = NULL, value = NULL, overwrite = FALSE,
edit.tag = "-edited", verbose = TRUE, grep.options){
file.names <- dir(path = src.dir, pattern=".apsimx$",ignore.case=TRUE)
if(length(file.names)==0){
stop("There are no .apsimx files in the specified directory to edit.")
}
## This matches the specified file from a list of files
## Notice that the .apsimx extension will be added here
file <- match.arg(file, file.names, several.ok=FALSE)
if(missing(parm) || missing(value)) stop("'parm' and/or 'value' are missing")
apsimx_json <- jsonlite::read_json(paste0(src.dir, "/", file))
## Select Replacements node
if(missing(grep.options)){
frn <- grep(root[[1]], apsimx_json$Children, fixed = TRUE)
}else{
gfixed <- ifelse(is.null(grep.options$fixed), FALSE, grep.options$fixed)
gignore.case <- ifelse(is.null(grep.options$ignore.case), FALSE, grep.options$ignore.case)
frn <- grep(root[[1]], apsimx_json$Children, fixed = gfixed, ignore.case = gignore.case)
}
if(length(frn) == 0){
### Here we try a different root
root <- list('Models.Core.Folder', NA)
frn <- grep(root[[1]], apsimx_json$Children, fixed = TRUE)
if(length(frn) == 0)
stop("Could not find 'root' for replacements", call. = FALSE)
}
if(length(frn) > 1){
if(is.na(root[[2]])){
cat("These positions matched ",root[[1]]," ",frn, "\n")
stop("Multiple root nodes found. Please provide a position")
}else{
replacements.node <- apsimx_json$Children[[frn[root[[2]]]]]
}
}else{
replacements.node <- apsimx_json$Children[[frn]]
}
if(!missing(grep.options)){
gfixed <- grep.options$fixed
gignore.case <- grep.options$ignore.case
}else{
gfixed <- FALSE
gignore.case <- FALSE
}
## Print names of replacements
replacements.node.names <- vapply(replacements.node$Children, function(x) x$Name,
FUN.VALUE = "character")
if(verbose) cat("Replacements: ", replacements.node.names, "\n")
if(!missing(node.string)){
## strip the dot automatically if it is included
if(strsplit(node.string, "")[[1]][1] == "."){
node.string <- substring(node.string, 2)
}
## If I want to provide the path returned by inspect_apsimx_replacement
## directly I need to strip the first part which is likely to be '.Simulations.Replacement.'
if(grepl(".Replacements.", node.string)){
node.string <- strsplit(node.string, ".Replacements.", fixed = TRUE)[[1]][2]
}
nodes <- strsplit(node.string, ".", fixed = TRUE)[[1]]
node <- nodes[1]
if(!is.na(nodes[2])) node.child <- nodes[2]
if(!is.na(nodes[3])) node.subchild <- nodes[3]
if(!is.na(nodes[4])) node.subsubchild <- nodes[4]
if(!is.na(nodes[5])) node.sub3child <- nodes[5]
if(!is.na(nodes[6])) node.sub4child <- nodes[6]
if(!is.na(nodes[7])) node.sub5child <- nodes[7]
}
if(missing(node)) return(cat("Please provide a node \n"))
## Let's call this level = 0, at the 'node' level (nothing to edit)
lvl <- -1
wrn <- grep(node, replacements.node.names)
rep.node <- replacements.node$Children[[wrn]]
if(!is.null(rep.node$CropType) && verbose) cat("CropType", rep.node$CropType,"\n")
if(parm %in% names(rep.node)){
lvl <- 0
rep.node <- edit_node(rep.node, parm = parm, value = value)
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
}
rep.node.children.names <- sapply(rep.node$Children, function(x) x$Name)
if(verbose) cat("Available node children: ", rep.node.children.names, "\n")
## Select a specific node.child
if(missing(node.child) && lvl == -1) return(cat("missing node.child\n"))
## Node.child would be level = 1, still nothing to edit
if(!missing(node.child)){
wrnc <- grep(node.child, rep.node.children.names)
rep.node.child <- rep.node$Children[[wrnc]]
if(any(parm %in% names(rep.node.child))){
lvl <- 1
rep.node.child <- edit_node(rep.node.child, parm = parm, value = value)
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
}
## Cultivar parameters can be in 'Command'
if(length(rep.node.child$Command) > 0){
if(any(grepl(parm, unlist(rep.node.child$Command)))){
lvl <- 2
wrnsc <- grep(parm, unlist(rep.node.child$Command), fixed = gfixed, ignore.case = gignore.case)
## Break it up and reassemble
cmdstrng <- strsplit(rep.node.child$Command[[wrnsc]], "=")[[1]][1]
rep.node.child$Command[[wrnsc]] <- paste0(cmdstrng, "=", value)
## Now write back to list
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
}
}
if(missing(node.subchild) && lvl == -1)
stop("Failed to find and edit parameter")
rep.node.subchildren.names <- sapply(rep.node.child$Children, function(x) x$Name)
}
## Select a specific node.subchild
if(missing(node.subchild) && verbose && missing(parm)) cat("missing node.subchild\n")
if(!missing(node.subchild)){
wrnsc <- grep(node.subchild, rep.node.subchildren.names)
rep.node.subchild <- rep.node.child$Children[[wrnsc]]
if(verbose) cat("Subchild Name: ", rep.node.subchild$Name,"\n")
if(parm %in% names(rep.node.subchild)){
rep.node.subchild <- edit_node(rep.node.subchild, parm = parm, value = value)
lvl <- 3
rep.node.child$Children[[wrnsc]] <- rep.node.subchild
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
## apsimx_json is ready to be written back to file
}
## Cultivar parameters can be in 'Command'
if(length(rep.node.subchild$Command) > 0){
if(any(grepl(parm, unlist(rep.node.subchild$Command)))){
lvl <- 3
wrnscc <- grep(parm, unlist(rep.node.subchild$Command), fixed = gfixed, ignore.case = gignore.case)
## Break it up and reassemble
cmdstrng <- strsplit(rep.node.subchild$Command[[wrnscc]], "=")[[1]][1]
rep.node.subchild$Command[[wrnscc]] <- paste0(cmdstrng, "=", value)
## Now write back to list
rep.node.child$Children[[wrnsc]] <- rep.node.subchild
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
}
}
if(missing(node.subsubchild) && lvl == -1)
stop("Failed to find and edit parameter")
}
if(missing(node.subsubchild) && verbose && missing(parm)) cat("missing node.subsubchild\n")
if(!missing(node.subsubchild)){
rep.node.subsubchildren.names <- vapply(rep.node.subchild$Children, function(x) x$Name,
FUN.VALUE = "character")
## Select a specific node.subsubchild
wrnssc <- grep(node.subsubchild, rep.node.subsubchildren.names)
if(length(wrnssc) == 0) stop("node.subsubchild not found")
if(length(wrnssc) > 1) stop("More than one subsubchild found. Make it unique (see regular expressions)")
rep.node.subsubchild <- rep.node.subchild$Children[[wrnssc]]
if(verbose) cat("Subsubchild Name: ", rep.node.subsubchild$Name,"\n")
if(parm %in% names(rep.node.subsubchild)){
rep.node.subsubchild <- edit_node(rep.node.subsubchild, parm = parm, value = value)
lvl <- 4
rep.node.subchild$Children[[wrnssc]] <- rep.node.subsubchild
rep.node.child$Children[[wrnsc]] <- rep.node.subchild
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
## apsimx_json is ready to be written back to file
}
## Cultivar parameters can be in 'Command'
if(length(rep.node.subsubchild$Command) > 0){
if(any(grepl(parm, unlist(rep.node.subsubchild$Command)))){
lvl <- 5
wrnsscc <- grep(parm, unlist(rep.node.subsubchild$Command), fixed = gfixed, ignore.case = gignore.case)
if(length(wrnsscc) == 0) stop("node.subsubchild Command not found")
if(length(wrnsscc) > 1) stop("More than one subsubchild Command found. Make it unique (see regular expressions)")
## Break it up and reassemble
cmdstrng <- strsplit(rep.node.subsubchild$Command[[wrnsscc]],"=")[[1]][1]
rep.node.subsubchild$Command[[wrnsscc]] <- paste0(cmdstrng,"=",value)
## cat("New string:", rep.node.subsubchild$Command[[wrnsscc]], "\n")
## Now write back to list
rep.node.subchild$Children[[wrnssc]] <- rep.node.subsubchild
rep.node.child$Children[[wrnsc]] <- rep.node.subchild
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
}
}
if(missing(node.sub3child) && lvl == -1)
stop("Failed to find and edit parameter")
}
## Inserting deeper level June 15th 2020
if(missing(node.sub3child) && verbose && missing(parm)) cat("missing node.sub3child\n")
if(!missing(node.sub3child)){
rep.node.sub3children.names <- vapply(rep.node.subsubchild$Children, function(x) x$Name,
FUN.VALUE = "character")
## Select a specific node.subchild
wrnsssc <- grep(node.sub3child, rep.node.sub3children.names)
if(length(wrnsssc) == 0) stop("node.sub4child not found")
if(length(wrnsssc) > 1) stop("More than one sub3child found. Make it unique (see regular expressions)")
rep.node.sub3child <- rep.node.subsubchild$Children[[wrnsssc]]
if(verbose) cat("Sub-sub-subchild Name: ", rep.node.sub3child$Name,"\n")
if(any(parm %in% names(rep.node.sub3child))){
rep.node.sub3child <- edit_node(rep.node.sub3child, parm = parm, value = value)
lvl <- 6
# node is edited, now put it back in place
rep.node.subsubchild$Children[[wrnsssc]] <- rep.node.sub3child
rep.node.subchild$Children[[wrnssc]] <- rep.node.subsubchild
rep.node.child$Children[[wrnsc]] <- rep.node.subchild
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
## apsimx_json is ready to be written back to file
}
## Cultivar parameters can be in 'Command'
if(length(rep.node.sub3child$Command) > 0){
if(any(grepl(parm, unlist(rep.node.sub3child$Command)))){
lvl <- 7
wrnssscc <- grep(parm, unlist(rep.node.sub3child$Command), fixed = gfixed, ignore.case = gignore.case)
if(length(wrnssscc) == 0) stop("node.sub3child Command not found")
if(length(wrnssscc) > 1) stop("More than one sub3child Command found. Make it unique (see regular expressions)")
## Break it up and reassemble
cmdstrng <- strsplit(rep.node.sub3child$Command[[wrnssscc]],"=")[[1]][1]
rep.node.sub3child$Command[[wrnssscc]] <- paste0(cmdstrng,"=",value)
## Now write back to list
rep.node.subsubchild$Children[[wrnsssc]] <- rep.node.sub3child
rep.node.subchild$Children[[wrnssc]] <- rep.node.subsubchild
rep.node.child$Children[[wrnsc]] <- rep.node.subchild
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
}
}
if(missing(node.sub4child) && lvl == -1)
stop("Failed to find and edit parameter")
}
if(missing(node.sub4child) && verbose && missing(parm)) cat("missing node.sub4child\n")
#### Inserting node.sub4child option March 5th 2021
if(!missing(node.sub4child)){
rep.node.sub4children.names <- vapply(rep.node.sub3child$Children, function(x) x$Name,
FUN.VALUE = "character")
## Select a specific node.subchild
wrnssssc <- grep(node.sub4child, rep.node.sub4children.names, fixed = gfixed, ignore.case = gignore.case)
if(length(wrnssssc) == 0) stop("node.sub4child not found")
if(length(wrnssssc) > 1) stop("More than one sub4child found. Make it unique (see regular expressions)")
rep.node.sub4child <- rep.node.sub3child$Children[[wrnssssc]]
if(verbose) cat("Sub-sub-sub-subchild Name: ", rep.node.sub4child$Name,"\n")
if(any(parm %in% names(rep.node.sub4child))){
rep.node.sub4child <- edit_node(rep.node.sub4child, parm = parm, value = value)
lvl <- 8
# node is edited, now put it back in place
rep.node.sub3child$Children[[wrnssssc]] <- rep.node.sub4child
rep.node.subsubchild$Children[[wrnsssc]] <- rep.node.sub3child
rep.node.subchild$Children[[wrnssc]] <- rep.node.subsubchild
rep.node.child$Children[[wrnsc]] <- rep.node.subchild
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
## apsimx_json is ready to be written back to file
}
## Cultivar parameters can be in 'Command'
if(length(rep.node.sub4child$Command) > 0){
if(any(grepl(parm, unlist(rep.node.sub4child$Command)))){
lvl <- 9
wrnsssscc <- grep(parm, unlist(rep.node.sub4child$Command), fixed = gfixed, ignore.case = gignore.case)
if(length(wrnsssscc) == 0) stop("node.sub4child Command not found")
if(length(wrnsssscc) > 1) stop("More than one sub4child Command found. Make it unique (see regular expressions)")
## Break it up and reassemble
cmdstrng <- strsplit(rep.node.sub4child$Command[[wrnsssscc]], "=")[[1]][1]
rep.node.sub4child$Command[[wrnsssscc]] <- paste0(cmdstrng, "=", value)
## Now write back to list
rep.node.sub3child$Children[[wrnssssc]] <- rep.node.sub4child
rep.node.subsubchild$Children[[wrnsssc]] <- rep.node.sub3child
rep.node.subchild$Children[[wrnssc]] <- rep.node.subsubchild
rep.node.child$Children[[wrnsc]] <- rep.node.subchild
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
}
}
if(missing(node.sub5child) && lvl == -1)
stop("Failed to find and edit parameter")
}
if(missing(node.sub5child) && verbose && missing(parm)) cat("missing node.sub5child\n")
#### Inserting node.sub5child option March 5th 2021
if(!missing(node.sub5child)){
rep.node.sub5children.names <- vapply(rep.node.sub4child$Children, function(x) x$Name,
FUN.VALUE = "character")
## Select a specific node.subchild
wrnsssssc <- grep(node.sub5child, rep.node.sub5children.names, fixed = gfixed, ignore.case = gignore.case)
if(length(wrnsssssc) == 0) stop("node.subs5child not found")
if(length(wrnsssssc) > 1) stop("More than one sub5child found. Make it unique (see regular expressions)")
rep.node.sub5child <- rep.node.sub4child$Children[[wrnsssssc]]
if(verbose) cat("Sub-sub-sub-sub-subchild Name: ", rep.node.sub5child$Name,"\n")
if(any(parm %in% names(rep.node.sub5child))){
rep.node.sub5child <- edit_node(rep.node.sub5child, parm = parm, value = value)
lvl <- 10
# node is edited, now put it back in place
rep.node.sub4child$Children[[wrnsssssc]] <- rep.node.sub5child
rep.node.sub3child$Children[[wrnssssc]] <- rep.node.sub4child
rep.node.subsubchild$Children[[wrnsssc]] <- rep.node.sub3child
rep.node.subchild$Children[[wrnssc]] <- rep.node.subsubchild
rep.node.child$Children[[wrnsc]] <- rep.node.subchild
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
## apsimx_json is ready to be written back to file
}
## Cultivar parameters can be in 'Command'
if(length(rep.node.sub5child$Command) > 0){
if(any(grepl(parm, unlist(rep.node.sub5child$Command)))){
lvl <- 11
wrnssssscc <- grep(parm, unlist(rep.node.sub5child$Command), fixed = gfixed, ignore.case = gignore.case)
if(length(wrnssssscc) == 0) stop("node.subs5child Command not found")
if(length(wrnssssscc) > 1) stop("More than one sub5child Command found. Make it unique (see regular expressions)")
## Break it up and reassemble
cmdstrng <- strsplit(rep.node.sub5child$Command[[wrnssssscc]], "=")[[1]][1]
rep.node.sub5child$Command[[wrnssssscc]] <- paste0(cmdstrng, "=", value)
## Now write back to list
rep.node.sub4child$Children[[wrnsssssc]] <- rep.node.sub5child
rep.node.sub3child$Children[[wrnssssc]] <- rep.node.sub4child
rep.node.subsubchild$Children[[wrnsssc]] <- rep.node.sub3child
rep.node.subchild$Children[[wrnssc]] <- rep.node.subsubchild
rep.node.child$Children[[wrnsc]] <- rep.node.subchild
rep.node$Children[[wrnc]] <- rep.node.child
replacements.node$Children[[wrn]] <- rep.node
if(length(frn) == 1){
apsimx_json$Children[[frn]] <- replacements.node
}else{
apsimx_json$Children[[frn[root[[2]]]]] <- replacements.node
}
}
}
if(lvl == -1)
stop("Failed to find and edit parameter")
}
## Write back to a file
if(overwrite == FALSE){
wr.path <- paste0(wrt.dir,"/",
strsplit(file,".",fixed = TRUE)[[1]][1],
edit.tag,".apsimx")
}else{
wr.path <- paste0(wrt.dir,"/",file)
}
jsonlite::write_json(apsimx_json, path = wr.path,
pretty = TRUE, digits = NA,
auto_unbox = TRUE, null = "null")
if(verbose){
if(!missing(node)) cat("Edited (node): ",node, "\n")
if(!missing(node.child)) cat("Edited (node.child): ", node.child,"\n")
if(!missing(node.subchild)) cat("Edited (node.subchild): ", node.subchild,"\n")
if(!missing(node.subsubchild)) cat("Edited (node.subsubchild): ", node.subsubchild,"\n")
if(!missing(node.sub3child)) cat("Edited (node.sub3child): ", node.sub3child,"\n")
cat("Edit (level): ", lvl,"\n")
cat("Edited parameter: ",parm, "\n")
if(inherits(value, "factor")){
cat("New values: ",as.character(value), "\n")
}else{
cat("New values: ",value, "\n")
}
cat("Created: ",wr.path,"\n")
}
}
edit_node <- function(x, parm = NULL, value = NULL){
## parm is presumably a component in names of x
if(length(names(x)) == 0) stop("no 'names' in node to edit")
if(is.null(parm) | is.null(value)) stop("parm or value are missing")
if(length(parm) == 1){
x.nms <- names(x)
## print(x.nms)
## wne <- which(x.nms == parm)
wne <- grep(parm, x.nms)
## if(length(x[[wne]]) != 1) stop("value should be of length = 1")
x[[wne]] <- value
}
if(length(parm) > 1){
x.nms <- names(x)
wne <- grepl(parm, x.nms)
j <- 1
for(i in wne){
x[[i]] <- value[j]
j <- j + 1
}
}
return(x)
}
Try the apsimx package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.