## metaclipR.Aggregation Construct a directed graph for Transformation metadata encoding
##
## Copyright (C) 2018 Predictia (http://www.predictia.es)
##
## This program 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 3 of the License, or
## (at your option) any later version.
##
## This program 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/>.
#' @title Directed metadata graph construction for Transformations of DatasetSubsets
#' @description Build a directed metadata graph describing a Transformation on a
#' climate4R grid that is a subset of Dataset.
#' @param package package
#' @param graph A previous metaclipR data structure from which the current step follows
#' @param version version
#' @param fun function name. Unused (set to \code{"aggregateGrid"})
#' @param arg.list Argument list. See details
#' @details This function takes as reference the semantics defined in the Data Source and Transformation ontology
#' defined in the Metaclip Framework (\url{http://metaclip.predictia.es/}).
#'
#' \strong{Argument list}
#'
#' The following list of arguments is required to define an aggregation:
#' \itemize{
#' \item \code{aggr.mem = list(FUN = NULL)}
#' \item \code{aggr.d = list(FUN = NULL)}
#' \item \code{aggr.m = list(FUN = NULL)}
#' \item \code{aggr.y = list(FUN = NULL)}
#' \item \code{aggr.lat = list(FUN = NULL)}
#' \item \code{weight.by.lat = TRUE}
#' \item \code{aggr.lon = list(FUN = NULL)}
#' }
#'
#' The different arguments are explained in the the help page of \code{\link[transformeR]{aggregateGrid}}
#'
#' @references
#' \href{http://www.meteo.unican.es/en/climate4r}{Climate4R page at University of Cantabria}
#' @family transformation
#' @return A named list with the updated graph in element \code{"graph"} and the parent node name (\code{"parentnodename"}),
#' needed for linking subsequent operations.
#' @export
#' @importFrom igraph make_empty_graph add_vertices add_edges
#' @author D. San MartÃn, J. Bedia
#' @examples \dontrun{
#' require(transformeR)
#' require(igraph)
#' pkg <- "transformeR"
#' v <- "1.1.1"
#' # Assume a given hindcast DatasetSubset (we first simplify a)
#' data("CFS_Iberia_hus850")
#' DS <- subsetGrid(CFS_Iberia_hus850, members = 1:3, years = 1989:1991)
#' graph <- metaclipR.DatasetSubset(package = pkg,
#' version = v,
#' arg.list = list(members = 1:3,
#' years = 1989:1991),
#' fun = "subsetGrid",
#' output = "DS")
#' # An aggregation is performed on the example data. In this case,
#' # The forecast is aggregated by members (ensemble mean), and in space
#' # (along longitude and latitude) to obtain a spatial mean. Original data is daily,
#' # and an annual aggregation is performed, considering the monthly means and the
#' # annual maxima:
#' fun <- "aggregateGrid"
#' arg.list <- list("aggr.mem" = list(FUN = "mean", na.rm = TRUE),
#' "aggr.d" = list(FUN = NULL),
#' "aggr.m" = list(FUN = "mean", na.rm = TRUE),
#' "aggr.y" = list(FUN = "max", na.rm = TRUE),
#' "aggr.lat" = list(FUN = "mean", na.rm = TRUE),
#' "aggr.lon" = list(FUN = "mean", na.rm = TRUE),
#' "weight.by.lat" = TRUE)
#' # The aggregation is undertaken with transformeR::subsetGrid:
#' arg.list[["grid"]] <- DS
#' out <- do.call(fun, arg.list)
#' # This is how metadata is encoded:
#' # 1.) We identify the origin node from which the first transformation hangs:
#' graph$parentnodename
#' # 2.) metaclipR.Aggregation is called:
#' graph <- metaclipR.Aggregation(package = pkg,
#' version = v,
#' graph = graph,
#' fun = fun,
#' arg.list = arg.list)
#' # And this is the metadata description stored in the igraph-class object:
#' plot(graph$graph)
#' }
metaclipR.Aggregation <- function(package = "transformeR",
version = "1.3.2",
graph,
fun = "aggregateGrid",
arg.list = NULL) {
orig.node <- graph$parentnodename
graph <- graph$graph
if (class(graph) != "igraph") stop("Invalid input graph (not an 'igraph-class' object)")
# Aggregation -----------------------------------------------
aggr.nodename <- paste("Aggregation", randomName(), sep = ".")
orig.nodes.command <- c()
orig.nodes.command <- c(orig.nodes.command, aggr.nodename)
graph <- add_vertices(graph,
nv = 1,
name = aggr.nodename,
label = "Aggregation",
className = "ds:Aggregation",
description = "Aggregation Class")
# attr = list("ds:hasCellMethod" = cellme))
graph <- add_edges(graph,
c(getNodeIndexbyName(graph, orig.node),
getNodeIndexbyName(graph, aggr.nodename)),
label = "ds:hadAggregation")
# Member aggregation -----------------------------------------------
if (!is.null(arg.list$aggr.mem$FUN)) {
cellme <- paste(deparse(arg.list$aggr.mem$FUN), collapse = "")
cellme <- gsub("\"","'", cellme)
aggr.mem.nodename <- paste("Member", randomName(), sep = ".")
graph <- add_vertices(graph,
nv = 1,
name = aggr.mem.nodename,
label = "Member",
className = "ds:Member",
description = "Member Class",
attr = list("ds:hasCellMethod" = cellme))
graph <- add_edges(graph,
c(getNodeIndexbyName(graph, aggr.nodename),
getNodeIndexbyName(graph, aggr.mem.nodename)),
label = "ds:alongDimension")
}
# Lon aggregation ---------------------------------------------------------
if (!is.null(arg.list$aggr.lon$FUN)) {
cellme <- paste(deparse(arg.list$aggr.lon$FUN), collapse = "")
cellme <- gsub("\"","'", cellme)
aggr.lon.nodename <- paste("Longitude", randomName(), sep = ".")
graph <- add_vertices(graph,
nv = 1,
name = aggr.lon.nodename,
label = "Longitude",
className = "ds:Longitude",
description = "Longitude Class",
attr = list("ds:hasCellMethod" = cellme))
graph <- add_edges(graph,
c(getNodeIndexbyName(graph, aggr.nodename),
getNodeIndexbyName(graph, aggr.lon.nodename)),
label = "ds:alongDimension")
}
# Lat aggregation ---------------------------------------------------------
if (!is.null(arg.list$aggr.lat$FUN)) {
cellme <- paste(deparse(arg.list$aggr.lat$FUN), collapse = "")
cellme <- gsub("\"","'", cellme)
aggr.lat.nodename <- paste("Latitude", randomName(), sep = ".")
graph <- add_vertices(graph,
nv = 1,
name = aggr.lat.nodename,
label = "Latitude",
className = "ds:Latitude",
description = "Latitude Class",
attr = list("ds:hasCellMethod" = cellme))
graph <- add_edges(graph,
c(getNodeIndexbyName(graph, aggr.nodename),
getNodeIndexbyName(graph, aggr.lat.nodename)),
label = "ds:alongDimension")
}
# Subdaily-to-daily aggregation -------------------------------------------
time.counter <- c()
if (!is.null(arg.list$aggr.d$FUN)) {
time.counter <- c(time.counter, 1)
cellme <- paste(deparse(arg.list$aggr.d$FUN), collapse = "")
cellme <- gsub("\"","'", cellme)
aggr.time.nodename <- paste("ValidationTime", randomName(), sep = ".")
graph <- add_vertices(graph,
nv = 1,
name = aggr.time.nodename,
label = "ValidTime",
className = "ds:ValidationTime",
description = "ValidationTime Class",
attr = list("ds:hasCellMethod" = cellme))
graph <- add_edges(graph,
c(getNodeIndexbyName(graph, aggr.nodename),
getNodeIndexbyName(graph, aggr.time.nodename)),
label = "ds:alongDimension")
# Update temporal Resolution
timeres.nodename <- paste("TemporalResolution", randomName(), sep = ".")
graph <- add_vertices(graph,
nv = 1,
name = timeres.nodename,
label = "TemporalResolution",
className = "ds:TemporalResolution",
attr = list("ds:hasTimeStep" = "P1D",
"ds:hasCellMethod" = cellme))
graph <- add_edges(graph,
c(getNodeIndexbyName(graph, aggr.nodename),
getNodeIndexbyName(graph, timeres.nodename)),
label = "ds:hasTemporalResolution")
}
# Daily to monthly aggregation -------------------------------------------
if (!is.null(arg.list$aggr.m$FUN)) {
cellme <- paste(deparse(arg.list$aggr.m$FUN), collapse = "")
cellme <- gsub("\"","'", cellme)
time.counter <- c(time.counter, 1)
if (sum(time.counter) > 1) {
aggr.m.nodename <- paste("Aggregation.monthly", randomName(), sep = ".")
graph <- add_vertices(graph,
nv = 1,
name = aggr.m.nodename,
label = "MonthlyAggregation",
className = "ds:Aggregation",
description = "Aggregation Class")
graph <- add_edges(graph,
c(getNodeIndexbyName(graph, aggr.nodename),
getNodeIndexbyName(graph, aggr.m.nodename)),
label = "ds:hadAggregation")
aggr.nodename <- aggr.m.nodename
orig.nodes.command <- c(orig.nodes.command, aggr.nodename)
}
aggr.time.nodename <- paste("ValidationTime", randomName(), sep = ".")
graph <- add_vertices(graph,
nv = 1,
name = aggr.time.nodename,
label = "ValidTime",
className = "ds:ValidationTime",
description = "ValidationTime Class",
attr = list("ds:hasCellMethod" = cellme))
graph <- add_edges(graph,
c(getNodeIndexbyName(graph, aggr.nodename),
getNodeIndexbyName(graph, aggr.time.nodename)),
label = "ds:alongDimension")
# Update temporal Resolution
timeres.nodename <- paste("TemporalResolution", randomName(), sep = ".")
graph <- add_vertices(graph,
nv = 1,
name = timeres.nodename,
label = "TemporalResolution",
className = "ds:TemporalResolution",
attr = list("ds:hasTimeStep" = "P1M",
"ds:hasCellMethod" = cellme))
graph <- add_edges(graph,
c(getNodeIndexbyName(graph, aggr.nodename),
getNodeIndexbyName(graph, timeres.nodename)),
label = "ds:hasTemporalResolution")
}
# Monthly to seasonal/annual aggregation -------------------------------------------
if (!is.null(arg.list$aggr.y$FUN)) {
cellme <- paste(deparse(arg.list$aggr.y$FUN), collapse = "")
cellme <- gsub("\"","'", cellme)
time.counter <- c(time.counter, 1)
if (sum(time.counter) > 1) {
aggr.y.nodename <- paste("Aggregation.yearly", randomName(), sep = ".")
graph <- add_vertices(graph,
nv = 1,
name = aggr.y.nodename,
label = "AnnualAggregation",
className = "ds:Aggregation",
description = "Aggregation Class")
graph <- add_edges(graph,
c(getNodeIndexbyName(graph, aggr.nodename),
getNodeIndexbyName(graph, aggr.y.nodename)),
label = "ds:hadAggregation")
aggr.nodename <- aggr.y.nodename
orig.nodes.command <- c(orig.nodes.command, aggr.nodename)
}
aggr.time.nodename <- paste("ValidationTime", randomName(), sep = ".")
graph <- add_vertices(graph,
nv = 1,
name = aggr.time.nodename,
label = "ValidTime",
className = "ds:ValidationTime",
description = "ValidationTime Class",
attr = list("ds:hasCellMethod" = cellme))
graph <- add_edges(graph,
c(getNodeIndexbyName(graph, aggr.nodename),
getNodeIndexbyName(graph, aggr.time.nodename)),
label = "ds:alongDimension")
# Update temporal Resolution
timeres.nodename <- paste("TemporalResolution", randomName(), sep = ".")
graph <- add_vertices(graph,
nv = 1,
name = timeres.nodename,
label = "TemporalResolution",
className = "ds:TemporalResolution",
attr = list("ds:hasTimeStep" = "P1Y",
"ds:hasCellMethod" = cellme))
graph <- add_edges(graph,
c(getNodeIndexbyName(graph, aggr.nodename),
getNodeIndexbyName(graph, timeres.nodename)),
label = "ds:hasTemporalResolution")
}
# Package/Command/Argument metadata ---------------------------------------
if ("grid" %in% names(arg.list)) arg.list <- arg.list[-grep("grid", names(arg.list))]
graph <- metaclip.graph.Command(graph, package, version, fun, arg.list,
origin.node.name = orig.nodes.command)
return(list("graph" = graph,
"parentnodename" = tail(orig.nodes.command, 1))
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.