R/graphs.R
In rte-antares-rpackage/fbClust: A Tool Of Ptdf Manipulation In Order To Cluster And Visualize Domains
Defines functions
.givePlotData
plotFlowbased
.makeGraph
.getChull
.getDataPlotClustering
clusterPlot
Documented in
clusterPlot
plotFlowbased
#' @title Plot a flow-based domain of a typical day
#'
#' @description For a given hour, plot the flow-based domain of one typical day along with the other
#' flow-based domains it represents (i.e. other domains of the same cluster).
#'
#' @param data \code{data.table} results from the clustering, output data from \link{clusterTypicalDaysForOneClass}
#' @param country1 \code{character}, name of the country whose net position is in the x axis (BE, FR, DE or NL)
#' @param country2 \code{character}, name of the country whose net position is in the y axis (BE, FR, DE or NL)
#' @param hour \code{numeric}, hour of the plotted domain
#' @param dayType \code{numeric}, typical flow-based day identifier
#' @param typicalDayOnly \code{logical} if TRUE, plot only the domain of the typical day
#' and not the other domains of the cluster
#' @param ggplot \code{logical} should ggplot package be used (static graph) instead of rAmCharts (dynamic graph)
#' @param xlim \code{numeric}, limits of x-axis (default = c(-10000, 10000))
#' @param ylim \code{numeric}, limits of x-axis (default = c(-10000, 10000))
#' @param width \code{character}, for rAmCharts only. Default to "420px" (set to "100/100" for dynamic resize)
#' @param height \code{character}, for rAmCharts only. Default to "410px" (set to "100/100" for dynamic resize)
#' @param export \code{logical} If you want to have the possibility to export your
#' graphic (if true in rmarkdown, can return a blank html)
#'
#' @import rAmCharts ggplot2 pipeR
#' @importFrom grDevices chull
#'
#' @examples
#'
#' \dontrun{
#'
#' # classification result
#' clusterTD <- readRDS(system.file("testdata/allTypeDaytest.rds",package = "fbClust"))
#'
#' clusterPlot(clusterTD, "FR", "DE", 3, 1, FALSE, FALSE)
#' clusterPlot(clusterTD, "ptdfFR", "DE", 3, 1, FALSE, TRUE)
#' clusterPlot(clusterTD, "FR", "ptdfDE", 3, 1, TRUE, TRUE)
#' clusterPlot(clusterTD, "ptdfFR", "ptdfDE", 3, 1, TRUE, FALSE)
#'
#' }
#'
#' @export
clusterPlot <- function(data,
country1,
country2,
hour,
dayType,
typicalDayOnly = FALSE,
ggplot = FALSE,
width = "420px",
height = "410px",
xlim = c(-10000, 10000),
ylim = c(-10000, 10000),
export = T){
.crtlAllTypeDay(data)
# remove NOTE data.table
idDayType <- NULL
dataPlot <- .getDataPlotClustering(data[idDayType==dayType], country1, country2, hour)
.makeGraph(dataPlot, data[idDayType==dayType]$TypicalDay, xlim = xlim, ylim = ylim,
typicalDayOnly = typicalDayOnly, ggplot = ggplot, width = width,
height = height, export = export)
}
### Compute list of data.frame with convex hull for two countries on defined hour and day
.getDataPlotClustering <- function(allTypeDay, country1, country2, hour)
{
# remove NOTE data.table
Period <- NULL
PLANRaw_details <- NULL
PLAN_details <- NULL
VERT_details <- NULL
if (grepl("ptdf", country1)) {
ctry1 <- gsub("ptdf", "", country1)
} else {
ctry1 <- as.character(country1)
}
if (grepl("ptdf", country2)) {
ctry2 <- gsub("ptdf", "", country2)
} else {
ctry2 <- as.character(country2)
}
if(ctry1 == ctry2) {
stop("The hubs should be distinct")
}
hubnames <- colnames(allTypeDay$dayIn[[1]][Period == hour, PLANRaw_details][[1]])
hubnames <- gsub("ptdf", "", hubnames[grepl("ptdf", hubnames)])
if (!(ctry1 %in% hubnames) |
!(ctry2 %in% hubnames)) {
stop(paste("country1 or country 2 has wrong format. Format should be",
"XX (where XX is the abreviation of the hub (ex : FR, DE, BE))"))
}
hubnames_vert <- colnames(allTypeDay$dayIn[[1]][Period == hour, PLAN_details][[1]])
hubnames_vert <- gsub("ptdf", "", hubnames_vert[grepl("ptdf", hubnames_vert)])
hubnameDiff <- hubnames[!(hubnames %in% hubnames_vert)]
data_stud <- allTypeDay$dayIn[[1]][Period == hour]
data_plot <- lapply(1:nrow(data_stud), function(X) {
# browser()
dataChull <- .getChull(data_stud[X, VERT_details][[1]], ctry1, ctry2, hubnameDiff)
dataChull <- data.frame(dataChull)
names(dataChull) <- c(
paste(unique(data_stud[X, VERT_details][[1]]$Date), ctry1, sep = "_"),
paste(unique(data_stud[X, VERT_details][[1]]$Date), ctry2, sep = "_"))
dataChull
})
maxRow <- max(unlist(lapply(data_plot, nrow)))
data_plot <- lapply(data_plot, function(X){
rbind(as.data.table(X), data.table(rep(NA, maxRow-nrow(X)), rep(NA, maxRow-nrow(X))), use.names=FALSE)
})
data_plot <- cbind.data.frame(data_plot)
data_plot
}
## Compute the convex hull from two countries in a data.frame
.getChull <- function(data, country1, country2, hubnameDiff){
# remove NOTE data.table
chull <- NULL
data <- data.frame(data)
if(country1 == hubnameDiff){
ptctry <- -rowSums(data[!grepl("Date|Period|^N$|nbsign|sign", colnames(data))])
}else{
ptctry <- data[[country1]]
}
if(country2 == hubnameDiff){
ptctry2 <- -rowSums(data[!grepl("Date|Period|^N$|nbsign|sign", colnames(data))])
}else{
ptctry2 <- data[[country2]]
}
res <- cbind(ptctry, ptctry2)
res <- res[chull(res),]
res <- rbind(res, res[1,])
res
}
##### Render plots, ggplot2 or rAmcharts
.makeGraph <- function(data, typicalDayDate, typicalDayOnly = FALSE,
ggplot = FALSE, width = "420px", height = "410px",
xlim, ylim, export = T){
# remove NOTE data.table
size <- NULL
ctry <- unique(substr(names(data), 12, 13))
if(typicalDayOnly){
dates <- typicalDayDate
} else {
dates <- unique(substr(names(data), 1, 10))
}
if(!ggplot){
graphs <- sapply(dates, function(X){
columns <- names(data)[grep(X, names(data))]
if(X == typicalDayDate){
graph <- amGraph(
title = X, balloonText =
paste0('<b>', X, '<br>', ctry[1], '</b> :[[x]] <br><b>', ctry[2], '</b> :[[y]]'),
bullet = 'circle', xField = columns[1], yField = columns[2],
lineAlpha = 1, bullet = "bubble", bulletSize = 4, lineColor = "#FF0000",
lineThickness = 3)
}else{
graph <- amGraph(
title = X, balloonText =
paste0('<b>', X, '<br>', ctry[1], '</b> :[[x]] <br><b>', ctry[2], '</b> :[[y]]'),
bullet = 'circle', xField = columns[1], yField = columns[2],
lineAlpha = 1, bullet = "bubble", bulletSize = 4, lineColor = "#D3D3D3",
lineThickness = 1)
}
graph
}, USE.NAMES = FALSE, simplify = FALSE)
pipeR::pipeline(
amXYChart(dataProvider = data),
addTitle(text = paste0("Flow-based clustering ", ctry[1], "/", ctry[2])),
setGraphs(graphs),
setChartCursor(),
addValueAxes(title = paste(ctry[1], "(MW)"), position = "bottom", minimum = xlim[1],
maximum = xlim[2], minHorizontalGap = 35, minVerticalGap = 35),
addValueAxes(title = paste(ctry[2], "(MW)"), minimum = ylim[1],
maximum = ylim[2], minHorizontalGap = 35, minVerticalGap = 35),
setExport(enabled = export),
plot(width = width, height = height)
# plot()
)
} else {
gg_data <- do.call("rbind.data.frame", lapply(dates, function(X){
# remove NOTE data.table
size <- NULL
col <- NULL
columns <- names(data)[grep(X, names(data))]
tmp_data <- data[, columns]
colnames(tmp_data) <- gsub(paste0(X, "_"), "", colnames(tmp_data))
tmp_data <- tmp_data[!is.na(tmp_data[, 1]), ]
tmp_data$date <- X
if(X == typicalDayDate){
tmp_data$col <- "0"
tmp_data$size <- 1
}else {
tmp_data$col <- "1"
tmp_data$size <- 0.5
}
tmp_data
}))
ggplot(data=gg_data, aes(
x = get(ctry[1]), y = get(ctry[2]),
group = date, colour = col, size = size, linetype = as.character(col))) +
geom_hline(yintercept = 0, colour = 'black', size = 0.5, linetype = 'dashed') +
geom_vline(xintercept = 0, colour = 'black', size = 0.5, linetype = 'dashed') +
geom_path() +
geom_point()+
scale_size(range=c(0.1, 2), guide=FALSE) +
theme(legend.position= "none") +
# xlim(xlim[1], xlim[2]) + ylim(ylim[1], ylim[2]) +
ggtitle(paste0("Typical day: ", typicalDayDate, "\n",
"Flow-based clustering ", ctry[1], "/", ctry[2])) +
theme(plot.title = element_text(hjust = 0.5)) +
ylab(paste(ctry[2], "(MW)")) +
xlab(paste(ctry[1], "(MW)")) +
theme(panel.background = element_rect(fill = 'white', colour = 'black'),
panel.grid.major = element_line(size = 0.5, linetype = 'dashed',
colour = "grey")) +
scale_y_continuous(breaks = seq(ylim[1], ylim[2], 2000),
limits = ylim, expand = c(0, 0)) +
scale_x_continuous(breaks = seq(xlim[1], xlim[2], 2000),
limits = xlim, expand = c(0, 0))
}
}
#' Plot flow-based domain(s)
#'
#' @param PLAN \code{data.table}, at least ram, Date, Period and two ptdf columns :
#' \itemize{
#' \item ptdfAT : autrichian vertices
#' \item ptdfBE : belgium vertices
#' \item ptdfDE : german vertices
#' \item ptdfFR : french vertices
#' \item ram : line limits
#' \item Date : date in format YYYY-MM-DD
#' \item Period : hour in the day, between 1 and 24
#' }
#' PLAN is generated in this format with the function \link{getPreprocPlan}
#' @param PLAN2 \code{data.table}, at least ram, Date, Period and two ptdf columns.
#' This argument is optional, default is NULL. You can use it if you want to make
#' comparison between domains from cwe and domains from cwe-at.
#' @param country1 \code{character}, name of the country whose net position is in the x axis (BE, FR, DE, AT or NL)
#' @param country2 \code{character}, name of the country whose net position is in the y axis (BE, FR, DE, AT or NL)
#' @param hours2 \code{character}, optional (default NULL) hours of interest for
#' the graphics of the domains from PLAN2.
#' @param dates2 \code{character}, optional (default NULL) dates of interest for the graphics.
#' of the domains from PLAN2.
#' @param hours \code{character}, hours of interest for the graphics.
#' @param dates \code{character}, dates of interest for the graphics.
#' @param domainsNames \code{character} names of the domain(s), used as legend of the graphics.
#' The length of domainsNames has to be the same of the number of combinations of hours and dates
#' @param main \code{character} title of the graph, if NULL, the title will be "Domains country1 - country2"
#' @param hubDrop \code{list}, list of hubs in the ptdf, with the ones which should
#' sustracted to the others as the names of the arrays which themself contain the ones which
#' be sustracted
#' @param hubDrop2 \code{list}, optional (default NULL) list of hubs in the ptdf from PLAN2,
#' with the ones which should
#' sustracted to the others as the names of the arrays which themself contain the ones which
#' be sustracted
#' @param xlim \code{numeric}, limits of x-axis (default = c(-10000, 10000))
#' @param ylim \code{numeric}, limits of x-axis (default = c(-10000, 10000))
#' @param width \code{character}, for rAmCharts only. Default to "420px" (set to "100/100" for dynamic resize)
#' @param height \code{character}, for rAmCharts only. Default to "410px" (set to "100/100" for dynamic resize)
#' @param color \code{character}, default NULL, if you want to customize the
#' colors of the graphics, color has to be the same length as the number of
#' graphics you want. The colors can be written either in the format "red", "blue"...
#' or "#CC0000", "#00CC00"...
#' @param export \code{logical} If you want to have the possibility to export your
#' graphic (if true in rmarkdown, can return a blank html)
#' @param VERT \code{data.table}, Vertices of PLAN. If set to NULL, vertices
#' will be calculated within the function.
#' @param VERT2 \code{data.table}, Vertices of PLAN2. If set to NULL, vertices
#' will be calculated within the function.
#'
#' @examples
#'
#' \dontrun{
#' library(data.table)
#' library(rAmCharts)
#' PLAN <- getPreprocPlan(
#' pathPtdfMatrixFactor = system.file(
#' "testdata/plan_new_version_factor_AT.rds", package = "fbClust"),
#' pathPtdfMatrixConstraint = system.file(
#' "testdata/plan_new_version_constraint_AT.rds", package = "fbClust"))
#'
#' hubDrop = list(NL = c("BE", "DE", "FR", "AT"))
#' #Plot unique polyhedron
#' plotFlowbased(PLAN, country1 = "BE", country2 = "DE", hubDrop = hubDrop,
#' hours = c(2), dates = c("2018-10-02"), domainsNames = "2018-10-02", main = "")
#'
#' #Plot four polyhedra
#' plotFlowbased(PLAN, country1 = "BE", country2 = "DE", hubDrop = hubDrop,
#' hours = c(3, 4), dates = c("2018-10-02", "2018-10-04"), domainsNames = NULL,
#' main = NULL)
#'
#'
#' #Plot two domains from cwe_at and one domain from cwe in the same graphic
#' PLAN2 <- copy(PLAN)
#' PLAN2 <- PLAN2[Date == "2018-10-04"]
#' PLAN2[, ptdfAT := NULL]
#' hubDrop2 <- list("NL" = list("BE", "DE", "FR"))
#' plotFlowbased(PLAN, PLAN2 = PLAN2, country1 = "BE", country2 = "DE",
#' hubDrop = hubDrop, hubDrop2 = hubDrop2,
#' hours = c(3, 4), dates = c("2018-10-02"),
#' hours2 = c(4), dates2 = c("2018-10-04"),
#' domainsNames = NULL, main = NULL)
#'
#'
#'
#' # Plot two domains from cwe and cwe-at at the same hours
#' PLAN3 <- copy(PLAN)
#' PLAN3[, ptdfAT := NULL]
#' hubDrop2 <- list("NL" = list("BE", "DE", "FR"))
#' plotFlowbased(PLAN, PLAN2 = PLAN3, country1 = "BE", country2 = "DE",
#' hubDrop = hubDrop, hubDrop2 = hubDrop2,
#' hours = c(3, 4), dates = c("2018-10-02"),
#' hours2 = c(3, 4), dates2 = c("2018-10-02"),
#' domainsNames = NULL, main = NULL)
#'
#'
#' # Examples with colors chosen
#' plotFlowbased(PLAN, country1 = "AT", country2 = "DE",
#' hubDrop = hubDrop,
#' hours = c(3), dates = c("2018-10-02", "2018-10-03"),
#' domainsNames = NULL, main = NULL,
#' color = c("#CC0000", "purple"))
#'
#'
#' plotFlowbased(PLAN, PLAN2 = PLAN3, country1 = "BE", country2 = "DE",
#' hubDrop = hubDrop, hubDrop2 = hubDrop2,
#' hours = c(3, 4), dates = c("2018-10-02"),
#' hours2 = c(3, 4), dates2 = c("2018-10-02"),
#' domainsNames = NULL, main = NULL,
#' color = c("blue", "grey", "green", "brown"))
#'
#' }
#'
#' @export
plotFlowbased <- function(PLAN,
PLAN2 = NULL,
VERT = NULL,
VERT2 = NULL,
country1,
country2,
hours,
dates,
hours2 = NULL,
dates2 = NULL,
domainsNames = NULL,
hubDrop = list(NL = c("BE", "DE", "FR", "AT")),
hubDrop2 = NULL,
xlim = c(-10000, 10000),
ylim = c(-10000, 10000),
main = NULL,
width = "420px", height = "410px",
color = NULL,
export = F){
# remove NOTE data.table
Period <- NULL
Date <- NULL
#Generate data for plot
if (grepl("ptdf", country1)) {
ctry1 <- gsub("ptdf", "", country1)
} else {
ctry1 <- country1
}
if (grepl("ptdf", country2)) {
ctry2 <- gsub("ptdf", "", country2)
} else {
ctry2 <- country2
}
if(ctry1 == ctry2) {
stop("The countries should be distinct")
}
hubnames <- gsub("ptdf", "", colnames(PLAN)[grep("ptdf", colnames(PLAN))])
PLAN <- copy(PLAN)
PLAN <- PLAN[Period %in% hours & Date %in% dates]
if(!is.null(hubDrop)){
.ctrlHubDrop(hubDrop = hubDrop, PLAN = PLAN)
PLAN <- setDiffNotWantedPtdf(PLAN = PLAN, hubDrop = hubDrop)
}
comb <- unique(PLAN[, list(Period, Date)])
comb[, PLAN := "PLAN"]
if (!is.null(PLAN2)) {
hubnames2 <- gsub("ptdf", "", colnames(PLAN2)[grep("ptdf", colnames(PLAN2))])
PLAN2 <- copy(PLAN2)
PLAN2 <- PLAN2[Period %in% hours2 & Date %in% dates2]
if(!is.null(hubDrop2)){
.ctrlHubDrop(hubDrop = hubDrop2, PLAN = PLAN2)
PLAN2 <- setDiffNotWantedPtdf(PLAN = PLAN2, hubDrop = hubDrop2)
}
comb2 <- unique(PLAN2[, list(Period, Date)])
comb2[, PLAN := "PLAN2"]
comb <- rbindlist(list(comb, comb2))
}
#Control arguments
multiPDTF <- (nrow(comb) > 1)
if(!is.null(domainsNames)){
if(!multiPDTF){
if(length(domainsNames) != 1){
stop("Only one PLAN specified for 2 or more domainsNames")
}
}else{
if(length(domainsNames) != nrow(comb)){
stop(paste0("You must have one domainsNames specified by combination of hours and time, currently you have ",
length(domainsNames), " domainsNames specify for ",
nrow(comb), " PLAN"))
}
}
}
if(is.null(domainsNames)){
domainsNames <- paste("Date :", comb[, Date], "Hour :", comb[, Period])
if (length(unique(comb$PLAN) > 1)) {
domainsNames <- paste(domainsNames, "PTDF :", comb[, PLAN])
}
}
if(is.null(VERT)){
VERT <- getVertices(PLAN)
}
hubnames_vert <- colnames(VERT)[!grepl("Date|Period", colnames(VERT))]
hubnameDiff <- hubnames[!(hubnames %in% hubnames_vert)]
if(!is.null(PLAN2)) {
if(is.null(VERT2)){
VERT2 <- getVertices(PLAN2)
}
hubnames_vert2 <- colnames(VERT2)[!grepl("Date|Period", colnames(VERT2))]
hubnameDiff2 <- hubnames2[!(hubnames2 %in% hubnames_vert2)]
} else {
VERT2 <- NULL
hubnameDiff2 <- NULL
}
dataToGraph <- .givePlotData(VERT, VERT2, ctry1, ctry2, comb,
domainsNames, hubnameDiff, hubnameDiff2)
if(!is.null(color)) {
if(length(color) != length(domainsNames)) {
stop(paste("If color is not null, it has to be the same length of the number",
"of graphics. There is currently", length(domainsNames), "graphics",
"and", length(color), "colors set"))
}
}
rowMax <- max(unlist(lapply(dataToGraph, nrow)))
dataToGraph <- lapply(dataToGraph, function(dta){
if(nrow(dta)<rowMax){
Na <- data.frame(rep(NA,rowMax - nrow(dta)),
rep(NA,rowMax - nrow(dta)))
names(Na) <- names(dta)
rbind(dta,Na)
}else{
dta
}
})
dataToGraph <- do.call(cbind, dataToGraph)
if (is.null(main)) {
main <- paste("Domains", gsub("ptdf", "", ctry1), "-", gsub("ptdf", " ", ctry2))
}
#Graph creation for more exmples see rAmCharts::runExamples()
graphs <- sapply(1:length(domainsNames), function(X){
graph <- amGraph(title = domainsNames[X], balloonText =
paste0('<b>',domainsNames[X],'<br>',
paste0(domainsNames[X], gsub("ptdf", " ", ctry1)),
'</b> :[[x]] <br><b>',
paste0(domainsNames[X], gsub("ptdf", " ", ctry2)), '</b> :[[y]]'),
bullet = 'circle', xField = paste0(domainsNames[X], " ", ctry1),
yField = paste0(domainsNames[X], " ", ctry2),
lineAlpha = 1, bullet = "bubble", bulletSize = 4, lineThickness = 3)
if (!is.null(color)) {
graph@otherProperties$lineColor <- color[X]
}
# graph@otherProperties$lineColor <- "#0D8ECF"
graph
}, USE.NAMES = FALSE)
pipeR::pipeline(
amXYChart(dataProvider = dataToGraph),
addTitle(text = main),
setGraphs(graphs),
setChartCursor(),
addValueAxes(title = paste(gsub("ptdf", "", ctry1), "(MW)"), position = "bottom", minimum = xlim[1],
maximum = xlim[2], minHorizontalGap = 35, minVerticalGap = 35),
addValueAxes(title = paste(gsub("ptdf", "", ctry2), "(MW)"), minimum = ylim[1],
maximum = ylim[2], minHorizontalGap = 35, minVerticalGap = 35),
setExport(enabled = export),
setLegend(enabled = TRUE),
plot(width = width, height = height)
)
}
.givePlotData <- function(VERT, VERT2, ctry1, ctry2, comb,
domainsNames, hubnameDiff, hubnameDiff2){
res <- lapply(1:nrow(comb), function(X) {
# remove NOTE data.table
Period <- NULL
Date <- NULL
period <- comb[X, Period]
date <- comb[X, Date]
pl <- comb[X, PLAN]
if (pl == "PLAN2") {
data <- data.table(.getChull(VERT2[Period == period & Date == date],
ctry1, ctry2, hubnameDiff2))
} else {
data <- data.table(.getChull(VERT[Period == period & Date == date],
ctry1, ctry2, hubnameDiff))
}
setnames(data, old = c("ptctry", "ptctry2"),
new = paste(domainsNames[X], c(gsub("ptdf", "", ctry1), gsub("ptdf", "", ctry2))))
# names(dataToGraph)[X:(X+1)]))
data
})
}
# plotFlowbased <- function(PLAN,
# country1,
# country2,
# hours,
# dates,
# domainsNames = NULL,
# hubDrop = list(NL = c("BE", "DE", "FR", "AT")),
# xlim = c(-10000, 10000),
# ylim = c(-10000, 10000),
# main = NULL,
# width = "420px", height = "410px"){
#
# # remove NOTE data.table
# Period <- NULL
# Date <- NULL
#
# #Generate data for plot
# if (grepl("ptdf", country1)) {
# ctry1 <- gsub("ptdf", "", country1)
# } else {
# ctry1 <- country1
# }
# if (grepl("ptdf", country2)) {
# ctry2 <- gsub("ptdf", "", country2)
# } else {
# ctry2 <- country2
# }
# if(ctry1 == ctry2) {
# stop("The countries should be distinct")
# }
# PLAN
# hubnames <- gsub("ptdf", "", colnames(PLAN)[grep("ptdf", colnames(PLAN))])
# PLAN <- copy(PLAN)
# PLAN <- PLAN[Period %in% hours & Date %in% dates]
# .ctrlHubDrop(hubDrop = hubDrop, PLAN = PLAN)
# PLAN <- setDiffNotWantedPtdf(PLAN = PLAN, hubDrop = hubDrop)
# comb <- unique(PLAN[, list(Period, Date)])
#
# #Control arguments
# multiPDTF <- (nrow(comb) > 1)
# if(!is.null(domainsNames)){
# if(!multiPDTF){
# if(length(domainsNames) != 1){
# stop("Only one PLAN specified for 2 or more domainsNames")
# }
# }else{
# if(length(domainsNames) != nrow(comb)){
# stop(paste0("You must have one domainsNames specified by combination of hours and time, currently you have ",
# length(domainsNames), " domainsNames specify for ",
# nrow(comb), " PLAN"))
# }
# }
# }
# if(is.null(domainsNames)){
# domainsNames <- paste("Date :", comb[, Date], "Hour :", comb[, Period])
# }
#
# VERT <- getVertices(PLAN)
# hubnames_vert <- colnames(VERT)[!grepl("Date|Period", colnames(VERT))]
# # hubnames_vert <- gsub("ptdf", "", colnames(VERT)[grep("ptdf", colnames(VERT))])
# hubnameDiff <- hubnames[!(hubnames %in% hubnames_vert)]
# # lim <- round(max(VERT[, list(get(ctry1), get(ctry2))])+500, -3)
# # xlim <- c(-lim, lim)
# # ylim <- c(-lim, lim)
#
# dataToGraph <- .givePlotData(VERT, ctry1, ctry2, comb, domainsNames, hubnameDiff)
# rowMax <- max(unlist(lapply(dataToGraph, nrow)))
# dataToGraph <- lapply(dataToGraph, function(dta){
# if(nrow(dta)<rowMax){
# Na <- data.frame(rep(NA,rowMax - nrow(dta)),
# rep(NA,rowMax - nrow(dta)))
# names(Na) <- names(dta)
# rbind(dta,Na)
# }else{
# dta
# }
# })
# dataToGraph <- do.call(cbind, dataToGraph)
# if (is.null(main)) {
# main <- paste("Domains", gsub("ptdf", "", ctry1), "-", gsub("ptdf", " ", ctry2))
# }
#
#
# #Graph creation for more exmples see rAmCharts::runExamples()
# graphs <- sapply(1:length(domainsNames), function(X){
# amGraph(title = domainsNames[X], balloonText =
# paste0('<b>',domainsNames[X],'<br>',
# paste0(domainsNames[X], gsub("ptdf", " ", ctry1)),
# '</b> :[[x]] <br><b>',
# paste0(domainsNames[X], gsub("ptdf", " ", ctry2)), '</b> :[[y]]'),
# bullet = 'circle', xField = paste0(domainsNames[X], " ", ctry1),
# yField = paste0(domainsNames[X], " ", ctry2),
# lineAlpha = 1, bullet = "bubble", bulletSize = 4, lineThickness = 3)
#
# }, USE.NAMES = FALSE)
# pipeR::pipeline(
# amXYChart(dataProvider = dataToGraph),
# addTitle(text = main),
# setGraphs(graphs),
# setChartCursor(),
# addValueAxes(title = paste(gsub("ptdf", "", ctry1), "(MW)"), position = "bottom", minimum = xlim[1],
# maximum = xlim[2], minHorizontalGap = 35, minVerticalGap = 35),
# addValueAxes(title = paste(gsub("ptdf", "", ctry2), "(MW)"), minimum = ylim[1],
# maximum = ylim[2], minHorizontalGap = 35, minVerticalGap = 35),
# setExport(enabled = TRUE),
# setLegend(enabled = TRUE),
# plot(width = width, height = height)
# )
# }
#
# .givePlotData <- function(VERT, ctry1, ctry2, comb, domainsNames, hubnameDiff){
#
#
# res <- lapply(1:nrow(comb), function(X) {
#
# # remove NOTE data.table
# Period <- NULL
# Date <- NULL
#
# period <- comb[X, Period]
# date <- comb[X, Date]
# data <- data.table(.getChull(VERT[Period == period & Date == date],
# ctry1, ctry2, hubnameDiff))
# setnames(data, old = c("ptctry", "ptctry2"),
# new = paste(domainsNames[X], c(gsub("ptdf", "", ctry1), gsub("ptdf", "", ctry2))))
# # names(dataToGraph)[X:(X+1)]))
# data
# })
# }
rte-antares-rpackage/fbClust documentation built on July 4, 2023, 12:06 a.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 .givePlotData plotFlowbased .makeGraph .getChull .getDataPlotClustering clusterPlot
Documented in clusterPlot plotFlowbased
#' @title Plot a flow-based domain of a typical day
#'
#' @description For a given hour, plot the flow-based domain of one typical day along with the other
#' flow-based domains it represents (i.e. other domains of the same cluster).
#'
#' @param data \code{data.table} results from the clustering, output data from \link{clusterTypicalDaysForOneClass}
#' @param country1 \code{character}, name of the country whose net position is in the x axis (BE, FR, DE or NL)
#' @param country2 \code{character}, name of the country whose net position is in the y axis (BE, FR, DE or NL)
#' @param hour \code{numeric}, hour of the plotted domain
#' @param dayType \code{numeric}, typical flow-based day identifier
#' @param typicalDayOnly \code{logical} if TRUE, plot only the domain of the typical day
#' and not the other domains of the cluster
#' @param ggplot \code{logical} should ggplot package be used (static graph) instead of rAmCharts (dynamic graph)
#' @param xlim \code{numeric}, limits of x-axis (default = c(-10000, 10000))
#' @param ylim \code{numeric}, limits of x-axis (default = c(-10000, 10000))
#' @param width \code{character}, for rAmCharts only. Default to "420px" (set to "100/100" for dynamic resize)
#' @param height \code{character}, for rAmCharts only. Default to "410px" (set to "100/100" for dynamic resize)
#' @param export \code{logical} If you want to have the possibility to export your
#' graphic (if true in rmarkdown, can return a blank html)
#'
#' @import rAmCharts ggplot2 pipeR
#' @importFrom grDevices chull
#'
#' @examples
#'
#' \dontrun{
#'
#' # classification result
#' clusterTD <- readRDS(system.file("testdata/allTypeDaytest.rds",package = "fbClust"))
#'
#' clusterPlot(clusterTD, "FR", "DE", 3, 1, FALSE, FALSE)
#' clusterPlot(clusterTD, "ptdfFR", "DE", 3, 1, FALSE, TRUE)
#' clusterPlot(clusterTD, "FR", "ptdfDE", 3, 1, TRUE, TRUE)
#' clusterPlot(clusterTD, "ptdfFR", "ptdfDE", 3, 1, TRUE, FALSE)
#'
#' }
#'
#' @export
clusterPlot <- function(data,
country1,
country2,
hour,
dayType,
typicalDayOnly = FALSE,
ggplot = FALSE,
width = "420px",
height = "410px",
xlim = c(-10000, 10000),
ylim = c(-10000, 10000),
export = T){
.crtlAllTypeDay(data)
# remove NOTE data.table
idDayType <- NULL
dataPlot <- .getDataPlotClustering(data[idDayType==dayType], country1, country2, hour)
.makeGraph(dataPlot, data[idDayType==dayType]$TypicalDay, xlim = xlim, ylim = ylim,
typicalDayOnly = typicalDayOnly, ggplot = ggplot, width = width,
height = height, export = export)
}
### Compute list of data.frame with convex hull for two countries on defined hour and day
.getDataPlotClustering <- function(allTypeDay, country1, country2, hour)
{
# remove NOTE data.table
Period <- NULL
PLANRaw_details <- NULL
PLAN_details <- NULL
VERT_details <- NULL
if (grepl("ptdf", country1)) {
ctry1 <- gsub("ptdf", "", country1)
} else {
ctry1 <- as.character(country1)
}
if (grepl("ptdf", country2)) {
ctry2 <- gsub("ptdf", "", country2)
} else {
ctry2 <- as.character(country2)
}
if(ctry1 == ctry2) {
stop("The hubs should be distinct")
}
hubnames <- colnames(allTypeDay$dayIn[[1]][Period == hour, PLANRaw_details][[1]])
hubnames <- gsub("ptdf", "", hubnames[grepl("ptdf", hubnames)])
if (!(ctry1 %in% hubnames) |
!(ctry2 %in% hubnames)) {
stop(paste("country1 or country 2 has wrong format. Format should be",
"XX (where XX is the abreviation of the hub (ex : FR, DE, BE))"))
}
hubnames_vert <- colnames(allTypeDay$dayIn[[1]][Period == hour, PLAN_details][[1]])
hubnames_vert <- gsub("ptdf", "", hubnames_vert[grepl("ptdf", hubnames_vert)])
hubnameDiff <- hubnames[!(hubnames %in% hubnames_vert)]
data_stud <- allTypeDay$dayIn[[1]][Period == hour]
data_plot <- lapply(1:nrow(data_stud), function(X) {
# browser()
dataChull <- .getChull(data_stud[X, VERT_details][[1]], ctry1, ctry2, hubnameDiff)
dataChull <- data.frame(dataChull)
names(dataChull) <- c(
paste(unique(data_stud[X, VERT_details][[1]]$Date), ctry1, sep = "_"),
paste(unique(data_stud[X, VERT_details][[1]]$Date), ctry2, sep = "_"))
dataChull
})
maxRow <- max(unlist(lapply(data_plot, nrow)))
data_plot <- lapply(data_plot, function(X){
rbind(as.data.table(X), data.table(rep(NA, maxRow-nrow(X)), rep(NA, maxRow-nrow(X))), use.names=FALSE)
})
data_plot <- cbind.data.frame(data_plot)
data_plot
}
## Compute the convex hull from two countries in a data.frame
.getChull <- function(data, country1, country2, hubnameDiff){
# remove NOTE data.table
chull <- NULL
data <- data.frame(data)
if(country1 == hubnameDiff){
ptctry <- -rowSums(data[!grepl("Date|Period|^N$|nbsign|sign", colnames(data))])
}else{
ptctry <- data[[country1]]
}
if(country2 == hubnameDiff){
ptctry2 <- -rowSums(data[!grepl("Date|Period|^N$|nbsign|sign", colnames(data))])
}else{
ptctry2 <- data[[country2]]
}
res <- cbind(ptctry, ptctry2)
res <- res[chull(res),]
res <- rbind(res, res[1,])
res
}
##### Render plots, ggplot2 or rAmcharts
.makeGraph <- function(data, typicalDayDate, typicalDayOnly = FALSE,
ggplot = FALSE, width = "420px", height = "410px",
xlim, ylim, export = T){
# remove NOTE data.table
size <- NULL
ctry <- unique(substr(names(data), 12, 13))
if(typicalDayOnly){
dates <- typicalDayDate
} else {
dates <- unique(substr(names(data), 1, 10))
}
if(!ggplot){
graphs <- sapply(dates, function(X){
columns <- names(data)[grep(X, names(data))]
if(X == typicalDayDate){
graph <- amGraph(
title = X, balloonText =
paste0('<b>', X, '<br>', ctry[1], '</b> :[[x]] <br><b>', ctry[2], '</b> :[[y]]'),
bullet = 'circle', xField = columns[1], yField = columns[2],
lineAlpha = 1, bullet = "bubble", bulletSize = 4, lineColor = "#FF0000",
lineThickness = 3)
}else{
graph <- amGraph(
title = X, balloonText =
paste0('<b>', X, '<br>', ctry[1], '</b> :[[x]] <br><b>', ctry[2], '</b> :[[y]]'),
bullet = 'circle', xField = columns[1], yField = columns[2],
lineAlpha = 1, bullet = "bubble", bulletSize = 4, lineColor = "#D3D3D3",
lineThickness = 1)
}
graph
}, USE.NAMES = FALSE, simplify = FALSE)
pipeR::pipeline(
amXYChart(dataProvider = data),
addTitle(text = paste0("Flow-based clustering ", ctry[1], "/", ctry[2])),
setGraphs(graphs),
setChartCursor(),
addValueAxes(title = paste(ctry[1], "(MW)"), position = "bottom", minimum = xlim[1],
maximum = xlim[2], minHorizontalGap = 35, minVerticalGap = 35),
addValueAxes(title = paste(ctry[2], "(MW)"), minimum = ylim[1],
maximum = ylim[2], minHorizontalGap = 35, minVerticalGap = 35),
setExport(enabled = export),
plot(width = width, height = height)
# plot()
)
} else {
gg_data <- do.call("rbind.data.frame", lapply(dates, function(X){
# remove NOTE data.table
size <- NULL
col <- NULL
columns <- names(data)[grep(X, names(data))]
tmp_data <- data[, columns]
colnames(tmp_data) <- gsub(paste0(X, "_"), "", colnames(tmp_data))
tmp_data <- tmp_data[!is.na(tmp_data[, 1]), ]
tmp_data$date <- X
if(X == typicalDayDate){
tmp_data$col <- "0"
tmp_data$size <- 1
}else {
tmp_data$col <- "1"
tmp_data$size <- 0.5
}
tmp_data
}))
ggplot(data=gg_data, aes(
x = get(ctry[1]), y = get(ctry[2]),
group = date, colour = col, size = size, linetype = as.character(col))) +
geom_hline(yintercept = 0, colour = 'black', size = 0.5, linetype = 'dashed') +
geom_vline(xintercept = 0, colour = 'black', size = 0.5, linetype = 'dashed') +
geom_path() +
geom_point()+
scale_size(range=c(0.1, 2), guide=FALSE) +
theme(legend.position= "none") +
# xlim(xlim[1], xlim[2]) + ylim(ylim[1], ylim[2]) +
ggtitle(paste0("Typical day: ", typicalDayDate, "\n",
"Flow-based clustering ", ctry[1], "/", ctry[2])) +
theme(plot.title = element_text(hjust = 0.5)) +
ylab(paste(ctry[2], "(MW)")) +
xlab(paste(ctry[1], "(MW)")) +
theme(panel.background = element_rect(fill = 'white', colour = 'black'),
panel.grid.major = element_line(size = 0.5, linetype = 'dashed',
colour = "grey")) +
scale_y_continuous(breaks = seq(ylim[1], ylim[2], 2000),
limits = ylim, expand = c(0, 0)) +
scale_x_continuous(breaks = seq(xlim[1], xlim[2], 2000),
limits = xlim, expand = c(0, 0))
}
}
#' Plot flow-based domain(s)
#'
#' @param PLAN \code{data.table}, at least ram, Date, Period and two ptdf columns :
#' \itemize{
#' \item ptdfAT : autrichian vertices
#' \item ptdfBE : belgium vertices
#' \item ptdfDE : german vertices
#' \item ptdfFR : french vertices
#' \item ram : line limits
#' \item Date : date in format YYYY-MM-DD
#' \item Period : hour in the day, between 1 and 24
#' }
#' PLAN is generated in this format with the function \link{getPreprocPlan}
#' @param PLAN2 \code{data.table}, at least ram, Date, Period and two ptdf columns.
#' This argument is optional, default is NULL. You can use it if you want to make
#' comparison between domains from cwe and domains from cwe-at.
#' @param country1 \code{character}, name of the country whose net position is in the x axis (BE, FR, DE, AT or NL)
#' @param country2 \code{character}, name of the country whose net position is in the y axis (BE, FR, DE, AT or NL)
#' @param hours2 \code{character}, optional (default NULL) hours of interest for
#' the graphics of the domains from PLAN2.
#' @param dates2 \code{character}, optional (default NULL) dates of interest for the graphics.
#' of the domains from PLAN2.
#' @param hours \code{character}, hours of interest for the graphics.
#' @param dates \code{character}, dates of interest for the graphics.
#' @param domainsNames \code{character} names of the domain(s), used as legend of the graphics.
#' The length of domainsNames has to be the same of the number of combinations of hours and dates
#' @param main \code{character} title of the graph, if NULL, the title will be "Domains country1 - country2"
#' @param hubDrop \code{list}, list of hubs in the ptdf, with the ones which should
#' sustracted to the others as the names of the arrays which themself contain the ones which
#' be sustracted
#' @param hubDrop2 \code{list}, optional (default NULL) list of hubs in the ptdf from PLAN2,
#' with the ones which should
#' sustracted to the others as the names of the arrays which themself contain the ones which
#' be sustracted
#' @param xlim \code{numeric}, limits of x-axis (default = c(-10000, 10000))
#' @param ylim \code{numeric}, limits of x-axis (default = c(-10000, 10000))
#' @param width \code{character}, for rAmCharts only. Default to "420px" (set to "100/100" for dynamic resize)
#' @param height \code{character}, for rAmCharts only. Default to "410px" (set to "100/100" for dynamic resize)
#' @param color \code{character}, default NULL, if you want to customize the
#' colors of the graphics, color has to be the same length as the number of
#' graphics you want. The colors can be written either in the format "red", "blue"...
#' or "#CC0000", "#00CC00"...
#' @param export \code{logical} If you want to have the possibility to export your
#' graphic (if true in rmarkdown, can return a blank html)
#' @param VERT \code{data.table}, Vertices of PLAN. If set to NULL, vertices
#' will be calculated within the function.
#' @param VERT2 \code{data.table}, Vertices of PLAN2. If set to NULL, vertices
#' will be calculated within the function.
#'
#' @examples
#'
#' \dontrun{
#' library(data.table)
#' library(rAmCharts)
#' PLAN <- getPreprocPlan(
#' pathPtdfMatrixFactor = system.file(
#' "testdata/plan_new_version_factor_AT.rds", package = "fbClust"),
#' pathPtdfMatrixConstraint = system.file(
#' "testdata/plan_new_version_constraint_AT.rds", package = "fbClust"))
#'
#' hubDrop = list(NL = c("BE", "DE", "FR", "AT"))
#' #Plot unique polyhedron
#' plotFlowbased(PLAN, country1 = "BE", country2 = "DE", hubDrop = hubDrop,
#' hours = c(2), dates = c("2018-10-02"), domainsNames = "2018-10-02", main = "")
#'
#' #Plot four polyhedra
#' plotFlowbased(PLAN, country1 = "BE", country2 = "DE", hubDrop = hubDrop,
#' hours = c(3, 4), dates = c("2018-10-02", "2018-10-04"), domainsNames = NULL,
#' main = NULL)
#'
#'
#' #Plot two domains from cwe_at and one domain from cwe in the same graphic
#' PLAN2 <- copy(PLAN)
#' PLAN2 <- PLAN2[Date == "2018-10-04"]
#' PLAN2[, ptdfAT := NULL]
#' hubDrop2 <- list("NL" = list("BE", "DE", "FR"))
#' plotFlowbased(PLAN, PLAN2 = PLAN2, country1 = "BE", country2 = "DE",
#' hubDrop = hubDrop, hubDrop2 = hubDrop2,
#' hours = c(3, 4), dates = c("2018-10-02"),
#' hours2 = c(4), dates2 = c("2018-10-04"),
#' domainsNames = NULL, main = NULL)
#'
#'
#'
#' # Plot two domains from cwe and cwe-at at the same hours
#' PLAN3 <- copy(PLAN)
#' PLAN3[, ptdfAT := NULL]
#' hubDrop2 <- list("NL" = list("BE", "DE", "FR"))
#' plotFlowbased(PLAN, PLAN2 = PLAN3, country1 = "BE", country2 = "DE",
#' hubDrop = hubDrop, hubDrop2 = hubDrop2,
#' hours = c(3, 4), dates = c("2018-10-02"),
#' hours2 = c(3, 4), dates2 = c("2018-10-02"),
#' domainsNames = NULL, main = NULL)
#'
#'
#' # Examples with colors chosen
#' plotFlowbased(PLAN, country1 = "AT", country2 = "DE",
#' hubDrop = hubDrop,
#' hours = c(3), dates = c("2018-10-02", "2018-10-03"),
#' domainsNames = NULL, main = NULL,
#' color = c("#CC0000", "purple"))
#'
#'
#' plotFlowbased(PLAN, PLAN2 = PLAN3, country1 = "BE", country2 = "DE",
#' hubDrop = hubDrop, hubDrop2 = hubDrop2,
#' hours = c(3, 4), dates = c("2018-10-02"),
#' hours2 = c(3, 4), dates2 = c("2018-10-02"),
#' domainsNames = NULL, main = NULL,
#' color = c("blue", "grey", "green", "brown"))
#'
#' }
#'
#' @export
plotFlowbased <- function(PLAN,
PLAN2 = NULL,
VERT = NULL,
VERT2 = NULL,
country1,
country2,
hours,
dates,
hours2 = NULL,
dates2 = NULL,
domainsNames = NULL,
hubDrop = list(NL = c("BE", "DE", "FR", "AT")),
hubDrop2 = NULL,
xlim = c(-10000, 10000),
ylim = c(-10000, 10000),
main = NULL,
width = "420px", height = "410px",
color = NULL,
export = F){
# remove NOTE data.table
Period <- NULL
Date <- NULL
#Generate data for plot
if (grepl("ptdf", country1)) {
ctry1 <- gsub("ptdf", "", country1)
} else {
ctry1 <- country1
}
if (grepl("ptdf", country2)) {
ctry2 <- gsub("ptdf", "", country2)
} else {
ctry2 <- country2
}
if(ctry1 == ctry2) {
stop("The countries should be distinct")
}
hubnames <- gsub("ptdf", "", colnames(PLAN)[grep("ptdf", colnames(PLAN))])
PLAN <- copy(PLAN)
PLAN <- PLAN[Period %in% hours & Date %in% dates]
if(!is.null(hubDrop)){
.ctrlHubDrop(hubDrop = hubDrop, PLAN = PLAN)
PLAN <- setDiffNotWantedPtdf(PLAN = PLAN, hubDrop = hubDrop)
}
comb <- unique(PLAN[, list(Period, Date)])
comb[, PLAN := "PLAN"]
if (!is.null(PLAN2)) {
hubnames2 <- gsub("ptdf", "", colnames(PLAN2)[grep("ptdf", colnames(PLAN2))])
PLAN2 <- copy(PLAN2)
PLAN2 <- PLAN2[Period %in% hours2 & Date %in% dates2]
if(!is.null(hubDrop2)){
.ctrlHubDrop(hubDrop = hubDrop2, PLAN = PLAN2)
PLAN2 <- setDiffNotWantedPtdf(PLAN = PLAN2, hubDrop = hubDrop2)
}
comb2 <- unique(PLAN2[, list(Period, Date)])
comb2[, PLAN := "PLAN2"]
comb <- rbindlist(list(comb, comb2))
}
#Control arguments
multiPDTF <- (nrow(comb) > 1)
if(!is.null(domainsNames)){
if(!multiPDTF){
if(length(domainsNames) != 1){
stop("Only one PLAN specified for 2 or more domainsNames")
}
}else{
if(length(domainsNames) != nrow(comb)){
stop(paste0("You must have one domainsNames specified by combination of hours and time, currently you have ",
length(domainsNames), " domainsNames specify for ",
nrow(comb), " PLAN"))
}
}
}
if(is.null(domainsNames)){
domainsNames <- paste("Date :", comb[, Date], "Hour :", comb[, Period])
if (length(unique(comb$PLAN) > 1)) {
domainsNames <- paste(domainsNames, "PTDF :", comb[, PLAN])
}
}
if(is.null(VERT)){
VERT <- getVertices(PLAN)
}
hubnames_vert <- colnames(VERT)[!grepl("Date|Period", colnames(VERT))]
hubnameDiff <- hubnames[!(hubnames %in% hubnames_vert)]
if(!is.null(PLAN2)) {
if(is.null(VERT2)){
VERT2 <- getVertices(PLAN2)
}
hubnames_vert2 <- colnames(VERT2)[!grepl("Date|Period", colnames(VERT2))]
hubnameDiff2 <- hubnames2[!(hubnames2 %in% hubnames_vert2)]
} else {
VERT2 <- NULL
hubnameDiff2 <- NULL
}
dataToGraph <- .givePlotData(VERT, VERT2, ctry1, ctry2, comb,
domainsNames, hubnameDiff, hubnameDiff2)
if(!is.null(color)) {
if(length(color) != length(domainsNames)) {
stop(paste("If color is not null, it has to be the same length of the number",
"of graphics. There is currently", length(domainsNames), "graphics",
"and", length(color), "colors set"))
}
}
rowMax <- max(unlist(lapply(dataToGraph, nrow)))
dataToGraph <- lapply(dataToGraph, function(dta){
if(nrow(dta)<rowMax){
Na <- data.frame(rep(NA,rowMax - nrow(dta)),
rep(NA,rowMax - nrow(dta)))
names(Na) <- names(dta)
rbind(dta,Na)
}else{
dta
}
})
dataToGraph <- do.call(cbind, dataToGraph)
if (is.null(main)) {
main <- paste("Domains", gsub("ptdf", "", ctry1), "-", gsub("ptdf", " ", ctry2))
}
#Graph creation for more exmples see rAmCharts::runExamples()
graphs <- sapply(1:length(domainsNames), function(X){
graph <- amGraph(title = domainsNames[X], balloonText =
paste0('<b>',domainsNames[X],'<br>',
paste0(domainsNames[X], gsub("ptdf", " ", ctry1)),
'</b> :[[x]] <br><b>',
paste0(domainsNames[X], gsub("ptdf", " ", ctry2)), '</b> :[[y]]'),
bullet = 'circle', xField = paste0(domainsNames[X], " ", ctry1),
yField = paste0(domainsNames[X], " ", ctry2),
lineAlpha = 1, bullet = "bubble", bulletSize = 4, lineThickness = 3)
if (!is.null(color)) {
graph@otherProperties$lineColor <- color[X]
}
# graph@otherProperties$lineColor <- "#0D8ECF"
graph
}, USE.NAMES = FALSE)
pipeR::pipeline(
amXYChart(dataProvider = dataToGraph),
addTitle(text = main),
setGraphs(graphs),
setChartCursor(),
addValueAxes(title = paste(gsub("ptdf", "", ctry1), "(MW)"), position = "bottom", minimum = xlim[1],
maximum = xlim[2], minHorizontalGap = 35, minVerticalGap = 35),
addValueAxes(title = paste(gsub("ptdf", "", ctry2), "(MW)"), minimum = ylim[1],
maximum = ylim[2], minHorizontalGap = 35, minVerticalGap = 35),
setExport(enabled = export),
setLegend(enabled = TRUE),
plot(width = width, height = height)
)
}
.givePlotData <- function(VERT, VERT2, ctry1, ctry2, comb,
domainsNames, hubnameDiff, hubnameDiff2){
res <- lapply(1:nrow(comb), function(X) {
# remove NOTE data.table
Period <- NULL
Date <- NULL
period <- comb[X, Period]
date <- comb[X, Date]
pl <- comb[X, PLAN]
if (pl == "PLAN2") {
data <- data.table(.getChull(VERT2[Period == period & Date == date],
ctry1, ctry2, hubnameDiff2))
} else {
data <- data.table(.getChull(VERT[Period == period & Date == date],
ctry1, ctry2, hubnameDiff))
}
setnames(data, old = c("ptctry", "ptctry2"),
new = paste(domainsNames[X], c(gsub("ptdf", "", ctry1), gsub("ptdf", "", ctry2))))
# names(dataToGraph)[X:(X+1)]))
data
})
}
# plotFlowbased <- function(PLAN,
# country1,
# country2,
# hours,
# dates,
# domainsNames = NULL,
# hubDrop = list(NL = c("BE", "DE", "FR", "AT")),
# xlim = c(-10000, 10000),
# ylim = c(-10000, 10000),
# main = NULL,
# width = "420px", height = "410px"){
#
# # remove NOTE data.table
# Period <- NULL
# Date <- NULL
#
# #Generate data for plot
# if (grepl("ptdf", country1)) {
# ctry1 <- gsub("ptdf", "", country1)
# } else {
# ctry1 <- country1
# }
# if (grepl("ptdf", country2)) {
# ctry2 <- gsub("ptdf", "", country2)
# } else {
# ctry2 <- country2
# }
# if(ctry1 == ctry2) {
# stop("The countries should be distinct")
# }
# PLAN
# hubnames <- gsub("ptdf", "", colnames(PLAN)[grep("ptdf", colnames(PLAN))])
# PLAN <- copy(PLAN)
# PLAN <- PLAN[Period %in% hours & Date %in% dates]
# .ctrlHubDrop(hubDrop = hubDrop, PLAN = PLAN)
# PLAN <- setDiffNotWantedPtdf(PLAN = PLAN, hubDrop = hubDrop)
# comb <- unique(PLAN[, list(Period, Date)])
#
# #Control arguments
# multiPDTF <- (nrow(comb) > 1)
# if(!is.null(domainsNames)){
# if(!multiPDTF){
# if(length(domainsNames) != 1){
# stop("Only one PLAN specified for 2 or more domainsNames")
# }
# }else{
# if(length(domainsNames) != nrow(comb)){
# stop(paste0("You must have one domainsNames specified by combination of hours and time, currently you have ",
# length(domainsNames), " domainsNames specify for ",
# nrow(comb), " PLAN"))
# }
# }
# }
# if(is.null(domainsNames)){
# domainsNames <- paste("Date :", comb[, Date], "Hour :", comb[, Period])
# }
#
# VERT <- getVertices(PLAN)
# hubnames_vert <- colnames(VERT)[!grepl("Date|Period", colnames(VERT))]
# # hubnames_vert <- gsub("ptdf", "", colnames(VERT)[grep("ptdf", colnames(VERT))])
# hubnameDiff <- hubnames[!(hubnames %in% hubnames_vert)]
# # lim <- round(max(VERT[, list(get(ctry1), get(ctry2))])+500, -3)
# # xlim <- c(-lim, lim)
# # ylim <- c(-lim, lim)
#
# dataToGraph <- .givePlotData(VERT, ctry1, ctry2, comb, domainsNames, hubnameDiff)
# rowMax <- max(unlist(lapply(dataToGraph, nrow)))
# dataToGraph <- lapply(dataToGraph, function(dta){
# if(nrow(dta)<rowMax){
# Na <- data.frame(rep(NA,rowMax - nrow(dta)),
# rep(NA,rowMax - nrow(dta)))
# names(Na) <- names(dta)
# rbind(dta,Na)
# }else{
# dta
# }
# })
# dataToGraph <- do.call(cbind, dataToGraph)
# if (is.null(main)) {
# main <- paste("Domains", gsub("ptdf", "", ctry1), "-", gsub("ptdf", " ", ctry2))
# }
#
#
# #Graph creation for more exmples see rAmCharts::runExamples()
# graphs <- sapply(1:length(domainsNames), function(X){
# amGraph(title = domainsNames[X], balloonText =
# paste0('<b>',domainsNames[X],'<br>',
# paste0(domainsNames[X], gsub("ptdf", " ", ctry1)),
# '</b> :[[x]] <br><b>',
# paste0(domainsNames[X], gsub("ptdf", " ", ctry2)), '</b> :[[y]]'),
# bullet = 'circle', xField = paste0(domainsNames[X], " ", ctry1),
# yField = paste0(domainsNames[X], " ", ctry2),
# lineAlpha = 1, bullet = "bubble", bulletSize = 4, lineThickness = 3)
#
# }, USE.NAMES = FALSE)
# pipeR::pipeline(
# amXYChart(dataProvider = dataToGraph),
# addTitle(text = main),
# setGraphs(graphs),
# setChartCursor(),
# addValueAxes(title = paste(gsub("ptdf", "", ctry1), "(MW)"), position = "bottom", minimum = xlim[1],
# maximum = xlim[2], minHorizontalGap = 35, minVerticalGap = 35),
# addValueAxes(title = paste(gsub("ptdf", "", ctry2), "(MW)"), minimum = ylim[1],
# maximum = ylim[2], minHorizontalGap = 35, minVerticalGap = 35),
# setExport(enabled = TRUE),
# setLegend(enabled = TRUE),
# plot(width = width, height = height)
# )
# }
#
# .givePlotData <- function(VERT, ctry1, ctry2, comb, domainsNames, hubnameDiff){
#
#
# res <- lapply(1:nrow(comb), function(X) {
#
# # remove NOTE data.table
# Period <- NULL
# Date <- NULL
#
# period <- comb[X, Period]
# date <- comb[X, Date]
# data <- data.table(.getChull(VERT[Period == period & Date == date],
# ctry1, ctry2, hubnameDiff))
# setnames(data, old = c("ptctry", "ptctry2"),
# new = paste(domainsNames[X], c(gsub("ptdf", "", ctry1), gsub("ptdf", "", ctry2))))
# # names(dataToGraph)[X:(X+1)]))
# data
# })
# }
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.