-
Notifications
You must be signed in to change notification settings - Fork 6
/
hvdcModification.R
110 lines (92 loc) · 3.28 KB
/
hvdcModification.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
#Copyright © 2016 RTE Réseau de transport d’électricité
#' hvdc straitement
#'
#' @description usage for hvdc
#'
#' @param data \code{antaresDataList} data to apply straitement
#' @param removeHvdcAreas \code{boolean} remove HVDC areas.
#' @param reafectLinks \code{boolean} .
#'
#' @examples
#' \dontrun{
#'
#' data <- readAntares(areas = 'all', links = 'all')
#' data <- setHvdcAreas(data, "psp in")
#' data <- hvdcModification(data)
#'
#' }
#'
#' @export
hvdcModification <- function(data, removeHvdcAreas = TRUE, reafectLinks = FALSE){
if(removeHvdcAreas == TRUE){
if("antaresDataList" %in% class(data)){
if(is.null(attributes(data$areas)$hvdcAreas)){
stop("You must indicate hvdcAreas with setHvdcAreas function")
}
data$areas <- .removeAreasInList(data$areas, attributes(data$areas)$hvdcAreas)
}
if("antaresDataTable" %in% class(data)){
if(is.null(attributes(data)$hvdcAreas)){
stop("You must indicate hvdcAreas with setHvdcAreas function")
}
data <- .removeAreasInList(data, attributes(data)$hvdcAreas)
}
}
if(reafectLinks == TRUE){
if(!"antaresDataList" %in% class(data) || !(all(c('areas', 'links') %in% names(data)))){
stop("You mush haveantaresDataList with areas and links data")
}
data <- .reafectLinks(data)
areasHvdc <- attributes(data$areas)$hvdcAreas
lkSupr <- getLinks(areasHvdc)
data$links <- data$links[!link %in% lkSupr]
}
data
}
.reafectLinks <- function(data){
areasHvdc <- attributes(data$areas)$hvdcAreas
areaHvdc <- areasHvdc[1]
for (areaHvdc in areasHvdc){
linksHvdcin <- getLinks(areaHvdc)
linksHvdc <- strsplit(linksHvdcin, " - ")
noHvdc <- unlist(linksHvdc)[unlist(linksHvdc) != areaHvdc]
possibleLinks <- c(paste(noHvdc, collapse = " - "), paste(rev(noHvdc), collapse = " - "))
avialableLink <- possibleLinks[possibleLinks %in% unique(data$links$link)]
if(length(avialableLink) == 0){
ll <- unlist(strsplit(linksHvdcin, ' - '))
avialableLink <- paste(sort(ll[ll!=areaHvdc]), collapse = " - ")
}
IDcols <- getIdCols(data$links)
selLk <- data$links[link %in% linksHvdcin, .SD, .SDcols = c(IDcols, "FLOW LIN.")]
lktp <- strsplit(avialableLink, " - ")[[1]]
inLink <- lktp[1]
outLink <- lktp[2]
toRev <- unlist(lapply(linksHvdc, function(X){
if(X[1] == inLink){
return(FALSE)
}else{
if(X[2] == outLink){
return(FALSE)
}else{
return(TRUE)
}
}
}))
selLk[link %in% linksHvdcin[toRev]]$`FLOW LIN.` <- - selLk[link %in% linksHvdcin[toRev]]$`FLOW LIN.`
if(nrow( data$links[link == avialableLink]) == 0){
lk <- data.table(data$links[, .SD, .SDcols = getIdCols(data$links)])
lk <- lk[link == link[1]]
lk$link <- avialableLink
lk$`FLOW LIN.` <- data$links[link == linksHvdcin[1]]$`FLOW LIN.`
data$links <- rbindlist(list(data$links, lk), fill=TRUE)
}else{
data$links[link == avialableLink]$`FLOW LIN.` <- data$links[link == avialableLink]$`FLOW LIN.` + data$links[link == linksHvdcin[1]]$`FLOW LIN.`
data$links <- data$links[!link %in% linksHvdcin]
}
NULL
}
data
}
.removeAreasInList <- function(data, removeArea){
data[!area%in%removeArea]
}