#' Create clusters for Weekly Margins simulation
#'
#' @param data a \code{data.table} obtained from \code{\link{read_planning}}.
#' @param start If specified, data will be filtered from given date to 7 days after.
#' @param rm_prev_clus Remove previous clusters before creating new ones.
#' @param sort_other_clus Reorder rows of other clusters data.
#' @param opts
#' List of simulation parameters returned by the function
#' \code{antaresRead::setSimulationPath}
#'
#' @export
#'
#' @importFrom data.table first
#' @importFrom antaresRead simOptions readClusterDesc
#' @importFrom antaresEditObject createCluster removeCluster
#'
#' @examples
#' \dontrun{
#'
#' # set path to your simulation
#' opts <- setSimulationPath(path = "path/", simulation = "input")
#'
#' # Read data from suppliers
#' plannings <- read_planning()
#'
#' # create clusters
#' clusters_crea <- create_wm_cluster(plannings, opts)
#'
#' }
create_wm_cluster <- function(data, start = NULL, rm_prev_clus = TRUE, sort_other_clus = TRUE, opts = antaresRead::simOptions()) {
if (!all(c("comb_", "pmin", "pmax", "code_groupe") %in% names(data))) {
stop("Invalid argument data, use output from read_planning.")
}
if (!is.null(start)) {
start <- as.Date(start)
data <- copy(data)
# data <- data[as.Date(datetime, tz = "Europe/Paris") >= start]
# data <- data[as.Date(datetime) < start + 7]
data <- data[format(datetime, format = "%Y-%m-%d") >= format(start)]
data <- data[format(datetime, format = "%Y-%m-%d") < format(start + 7)]
}
n_168 <- data[, .N, by = code_groupe]
if (!all(n_168$N == 168)) {
stop("Not all groups have 168 observations !", call. = FALSE)
}
if (rm_prev_clus) {
oldclus <- antaresRead::readClusterDesc(opts = opts)
oldclus <- oldclus[area == "fr", cluster]
oldclus <- as.character(oldclus)
l_max_o <- max(nchar(oldclus))
cat("\nRemoval of former clusters\n")
if (length(oldclus) > 0) {
for (oldcluster in oldclus) {
cat(sprintf("\rRemoving: %s (%s%%)",
format(oldcluster, width = l_max_o + 3),
round(which(oldclus == oldcluster)/length(oldclus)*100)))
antaresEditObject::removeCluster(
area = "fr",
cluster_name = oldcluster,
add_prefix = FALSE
)
}
}
}
co_comb <- list(
"N" = "nuclear",
"G" = "gas",
"TAC F" = "oil",
"F" = "oil",
"C" = "Hard coal",
"D" = "oil",
"TAC G" = "gas",
"V" = "gas",
"H" = "Hard coal",
"RN" = "gas"
)
data[, `:=`(pmax = ceiling(pmax), pmin = floor(pmin))]
clusdata <- data[, list(
area = "fr",
cluster_name = first(code_groupe),
group = co_comb[[first(comb_)]],
unitcount = 1L,
enabled = TRUE,
nominalcapacity = max(pmax, na.rm = TRUE),
`min-stable-power` = ifelse(
test = min(pmin, na.rm = TRUE) < 0.1 * max(pmax, na.rm = TRUE),
yes = 0, no = min(pmin, na.rm = TRUE)
),
`must-run` = FALSE,
# `must-run` = must_run(
# pmin_ = pmin,
# pmax_ = pmax,
# code_essai = code_essai,
# type = co_comb[[first(comb_)]]
# ),
prepro_modulation = list(
matrix_modulation(pmin_ = pmin, pmax_ = pmax, type = co_comb[[first(comb_)]])
)
), by = list(code_groupe)]
# browser()
clusdata <- lapply(
X = seq_len(nrow(clusdata)),
FUN = function(i) {
res <- as.list(clusdata[i, .SD, .SDcols = names(clusdata)[-1]])
res$prepro_modulation <- res$prepro_modulation[[1]]
res$prepro_modulation[is.na(res$prepro_modulation)] <- 0
res$opts <- opts
clus_d <- corr_groupe_descr(res$cluster_name)
res$prepro_data <- matrix(
data = c(
rep(7, times = 365),
rep(1, times = 365),
rep(fo_rate(clus_d), times = 365),
rep(0, times = 365 * 3)
),
ncol = 6
)
res <- c(res, descr_clusters(clus_d))
res$cluster_name <- clean_names(res$cluster_name)
res
}
)
tryCreateCluster <- function(args) {
# Sys.sleep(0.1)
# try(stop("erreur"), silent = TRUE)
args <- args[!duplicated(names(args))]
try(do.call(createCluster, args), silent = TRUE)
}
ok <- 0; ko <- 0
cat(sprintf("\nCreating %s clusters\n", length(clusdata)))
for (i in seq_along(clusdata)) {
resclus <- tryCreateCluster(clusdata[[i]])
if ("try-error" %in% class(resclus)) {
ko <- ko + 1
clusdata[[i]] <- resclus
# message(attr(resclus, "condition"))
} else {
ok <- ok + 1
}
cat(sprintf("\rOK: %s | FAILED: %s", formatC(x = ok, width = 3), formatC(x = ko, width = 3)))
}
cat("\ncluster creation completed")
if (sort_other_clus) {
cat("\nReordering rows of other clusters\n")
othclus <- antaresRead::readClusterDesc(opts = opts)
othclus <- othclus[area != "fr"]
n_othclus <- nrow(othclus)
l_max <- othclus[, max(nchar(as.character(cluster)))]
for (i in seq_len(n_othclus)) {
clusname <- othclus[i, as.character(cluster)]
cat(sprintf("\rReordering: %s (%s%%)", format(clusname, width = l_max + 3), round(i/n_othclus*100)))
sort_cluster(
area = othclus[i, area],
cluster_name = clusname,
start_wm = start,
start_sim = opts$start,
inputPath = opts$inputPath
)
}
cat("\n")
}
# Maj simulation
suppressWarnings({
res <- antaresRead::setSimulationPath(path = opts$studyPath, simulation = "input")
})
invisible(res)
}
must_run <- function(pmin_, pmax_, code_essai, type) {
# maxpmax <- max(pmax, na.rm = TRUE)
# minpmin <- min(pmin, na.rm = TRUE)
maxpmax <- quantile(pmax_, probs = 0.95, na.rm = TRUE)
minpmin <- quantile(pmin_, probs = 0.05, na.rm = TRUE)
if (num_equal(maxpmax, 0) & num_equal(minpmin, 0)) {
return(FALSE)
}
if (num_equal(max(pmax_, na.rm = TRUE), min(pmin_, na.rm = TRUE))) {
return(TRUE)
}
if (!type %in% c("N", "nuclear")) {
return(FALSE)
}
minpmin >= maxpmax*0.9
}
matrix_modulation <- function(pmin_, pmax_, type) {
if (type %in% c("N", "nuclear")) {
maxpmax <- quantile(pmax_, probs = 0.95, na.rm = TRUE)
minpmin <- quantile(pmin_, probs = 0.05, na.rm = TRUE)
# if (!num_equal(maxpmax, 0) & minpmin >= maxpmax*0.9) {
# values <- rep(0, 168)
# } else {
values <- pmin_/max(pmax_, na.rm = TRUE)
# }
# if (num_equal(max(pmax_, na.rm = TRUE), min(pmin_, na.rm = TRUE))) {
# values <- rep(0, 168)
# }
matrix(
data = c(
rep(1, times = 365 * 24 * 2), # two first columns
ceiling((pmax_/max(pmax_, na.rm = TRUE))*1000)/1000, rep(0, 365 * 24 - 168), # [rep(1, 168)]
# rep(0, times = 365 * 24 * 1) # fourth column
values, rep(0, 365 * 24 - 168)
), ncol = 4
)
} else {
matrix(
data = c(
rep(1, times = 365 * 24 * 2), # two first columns
ceiling((pmax_/max(pmax_, na.rm = TRUE))*1000)/1000, rep(0, 365 * 24 - 168), # [rep(1, 168)]
rep(0, times = 365 * 24 * 1) # fourth column
), ncol = 4
)
}
}
# Change rows order in cluster data
#' @importFrom data.table fread fwrite
#' @importFrom utils tail
sort_cluster <- function(area, cluster_name, start_wm, start_sim, n_days = 7, fill_zero = TRUE, inputPath) {
start_wm <- as.Date(start_wm)
start_sim <- as.Date(as.character(start_sim))
# Indice data daily
ind_day_wm <- difftime(time1 = start_wm, time2 = start_sim, units = "days")
ind_day_wm <- as.numeric(ind_day_wm)
ind_day_wm <- seq(from = ind_day_wm, length.out = n_days, by = 1)
# Indice data hourly
ind_hour_wm <- difftime(time1 = start_wm, time2 = start_sim, units = "hours")
ind_hour_wm <- as.numeric(ind_hour_wm)
ind_hour_wm <- seq(from = ind_hour_wm, length.out = n_days*24, by = 1) + 1
# Prepro data
prepro_data_path <- file.path(inputPath, "thermal", "prepro", area, cluster_name, "data.txt")
if (file.size(prepro_data_path) > 0) {
prepro_data <- data.table::fread(file = prepro_data_path)
# if (fill_zero) {
# prepro_data[setdiff(seq_len(nrow(prepro_data)), ind_day_wm)] <- 0
# }
ind_data <- c(ind_day_wm, rep(tail(ind_day_wm, 1), times = nrow(prepro_data) - length(ind_day_wm)))
prepro_data <- prepro_data[ind_data]
data.table::fwrite(x = prepro_data, file = prepro_data_path, sep = "\t", row.names = FALSE, col.names = FALSE)
}
# Modulation data
prepro_modu_path <- file.path(inputPath, "thermal", "prepro", area, cluster_name, "modulation.txt")
if (file.size(prepro_modu_path) > 0) {
prepro_modu <- data.table::fread(file = prepro_modu_path)
# if (fill_zero) {
# prepro_modu[setdiff(seq_len(nrow(prepro_modu)), ind_hour_wm)] <- 0
# }
ind_modu <- c(ind_hour_wm, rep(tail(ind_hour_wm, 1), times = nrow(prepro_modu) - length(ind_hour_wm)))
prepro_modu <- prepro_modu[ind_modu]
data.table::fwrite(x = prepro_modu, file = prepro_modu_path, sep = "\t", row.names = FALSE, col.names = FALSE)
}
# Series data
series_path <- file.path(inputPath, "thermal", "series", area, cluster_name, "series.txt")
if (file.size(series_path) > 0) {
series <- data.table::fread(file = series_path)
# if (fill_zero) {
# series[setdiff(seq_len(nrow(series)), ind_hour_wm)] <- 0
# }
ind_series <- c(ind_hour_wm, rep(tail(ind_hour_wm, 1), times = nrow(series) - length(ind_hour_wm)))
series <- series[ind_series]
data.table::fwrite(x = series, file = series_path, sep = "\t", row.names = FALSE, col.names = FALSE)
}
return(invisible())
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.