|
| 1 | +#Copyright © 2016 RTE Réseau de transport d’électricité |
| 2 | + |
| 3 | +#' aggregate a data.table by district |
| 4 | +#' |
| 5 | +#' @param x |
| 6 | +#' data.table containing at least a column area. |
| 7 | +#' @param opts |
| 8 | +#' simulation options returned with simOptions() |
| 9 | +#' @param fun |
| 10 | +#' vector of functions with size equal to the number of columns to aggregate |
| 11 | +#' (number of columns - number of id columns). If it is of length 1, the |
| 12 | +#' function is used for all columns. |
| 13 | +#' |
| 14 | +#' @return |
| 15 | +#' A data.table with the same columns as the input except that the column area |
| 16 | +#' is replaced by column district. |
| 17 | +#' |
| 18 | +#' @note |
| 19 | +#' This is a private function that is used in functions like surplus that require |
| 20 | +#' detailed data by area, but user may want aggregated output. |
| 21 | +#' |
| 22 | +#' @noRd |
| 23 | +#' |
| 24 | +.groupByDistrict <- function(x, opts, fun = c(sum)) { |
| 25 | + x <- merge(x, opts$districtsDef, by = "area", allow.cartesian = TRUE) |
| 26 | + |
| 27 | + # Check that all nodes from a district are in the data |
| 28 | + areasInData <- unique(x$area) |
| 29 | + districts <- intersect(x$district, opts$districtsDef$district) |
| 30 | + districtsDef <- split(opts$districtsDef$area, opts$districtsDef$district) |
| 31 | + |
| 32 | + for (d in districts) { |
| 33 | + missingAreas <- setdiff(districtsDef[[d]], areasInData) |
| 34 | + |
| 35 | + if (length(missingAreas) > 0) warning("The following areas belongs to district ", d, " but are not in 'x': ", |
| 36 | + paste(missingAreas, collapse = ", ")) |
| 37 | + } |
| 38 | + |
| 39 | + # Aggregation by district |
| 40 | + x[, area := NULL] |
| 41 | + idVars <- .idCols(x) |
| 42 | + |
| 43 | + if (length(fun) == 1) fun <- rep(fun, ncol(x) - length(idVars)) |
| 44 | + |
| 45 | + x[, mapply(function(x, f) {f(x)}, x = .SD, f = fun, SIMPLIFY=FALSE), |
| 46 | + by = idVars] |
| 47 | + |
| 48 | +} |
0 commit comments