Ajout initFlowbased et petites modifs

rte-antares-rpackage · Aug 1, 2019 · adab3f2 · adab3f2
1 parent 1fd427a
commit adab3f2
Show file tree

Hide file tree

Showing 14 changed files with 3,238 additions and 2,602 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -26,7 +26,9 @@ Imports:
   rAmCharts,
   rmarkdown,
   antaresRead,
-  pipeR
+  pipeR,
+  plyr,
+  antaresEditObject
 RoxygenNote: 6.1.1
 Suggests: 
     testthat,

diff --git a/NAMESPACE b/NAMESPACE
@@ -9,16 +9,19 @@ export(getAvailableModel)
 export(getBestPolyhedron)
 export(getVertices)
 export(identifyFirstDay)
+export(initFlowBased)
 export(setDiffNotWantedPtdf)
 export(setFlowbasedPath)
 export(setNamesProbabilityMatrix)
+import(antaresEditObject)
 import(antaresRead)
 import(data.table)
 import(flexdashboard)
 import(linprog)
 import(lpSolve)
 import(manipulateWidget)
 import(pipeR)
+import(plyr)
 import(quadprog)
 import(rAmCharts)
 import(rmarkdown)

diff --git a/R/classifPtdf.R b/R/classifPtdf.R
@@ -21,7 +21,7 @@ giveBClassif <- function(PTDF, nbClust = 36)
     res <- cutree(hclust(dist(PTDFKm, method = "euclidean"), method = "ward.D"), nbClust)
   } else {
 
-    resKm <- kmeans(PTDFKm, centers = 5000, nstart = 10)
+    resKm <- kmeans(PTDFKm, centers = 5000, nstart = 20)
 
     res <- cutree(hclust(dist(resKm$centers, method = "euclidean"), method = "ward.D"), nbClust)
 
@@ -47,9 +47,9 @@ giveBClassif <- function(PTDF, nbClust = 36)
     centers[conCernRow,  paste0(
       "ptdf", c("BE", "DE", "FR", "AT")) := as.list(valueVect)]
   }
-  # affectRow(centers, c(-1,0,0,0))
-  # affectRow(centers, c(0,-1,0,0))
-  # affectRow(centers, c(0,0,-1,0))
-  # affectRow(centers, c(0,1,0,0))
+  affectRow(centers, c(-1,0,0,0))
+  affectRow(centers, c(0,-1,0,0))
+  affectRow(centers, c(0,0,-1,0))
+  affectRow(centers, c(0,1,0,0))
   centers[,paste0("ptdf", c("BE", "DE", "FR", "AT"))]
 }
diff --git a/R/computeFB.R b/R/computeFB.R
@@ -34,6 +34,11 @@
 #' @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 areaName \code{character} The name of the area of your study, possible values are
+#' cwe_at (default), cwe and other. If you choose other, you have to give a csv file
+#' which explains how your area work.
+#' @param areacsv \code{character} file name of the csv you give if you chose
+#' other for the areaName parameter.
 #' @param nbFaces \code{numeric}, standard shape parameters: number of sides to select. By default, the value is 36.
 #' @param nbLines \code{numeric}, number of halflines drawn for the distance computation, default 10 000
 #' @param maxiter \code{numeric}, maximum number of iteration on the optimization problem, default 10
@@ -51,7 +56,8 @@
 #' \dontrun{
 #' # Compute models for all days and hours of a PTDF file, with no reports 
 #' # automatically generated at the same time
-#' computeFB(PTDF = system.file("testdata/2019-07-18ptdfraw.csv", package = "fbAntares"), reports = FALSE)
+#' computeFB(PTDF = system.file("testdata/2019-07-18ptdfraw.csv", package = "fbAntares"), 
+#' reports = FALSE, areaName = "cwe_at")
 #' 
 #' }
 #' @importFrom stats cutree dist hclust
@@ -60,6 +66,7 @@
 computeFB <- function(PTDF = system.file("testdata/2019-07-18ptdfraw.csv", package = "fbAntares"),
                       outputName =  paste0(getwd(), "/antaresInput"),
                       reports = TRUE,
+                      areaName = "cwe_at", areacsv = NULL,
                       dayType = "All", hour = "All", nbFaces = 36,
                       verbose = 1,
                       nbLines = 10000, maxiter = 10, thresholdIndic = 90, quad = F,
@@ -72,7 +79,6 @@ computeFB <- function(PTDF = system.file("testdata/2019-07-18ptdfraw.csv", packa
   # pb <- txtProgressBar(style = 3)
 
 
-
   ######### OK
   PTDF <- .readPTDF(PTDF)
 
@@ -98,6 +104,10 @@ computeFB <- function(PTDF = system.file("testdata/2019-07-18ptdfraw.csv", packa
     hour <- unique(PTDF$Period)
   }
 
+  ##From B to antares
+
+  antaresFace <- .fromBtoAntares(face, col_ptdf, areaName = areaName)
+
   combi <- data.table(expand.grid(hour, dayType))
   names(combi) <- c("hour", "dayType")
 
@@ -117,8 +127,10 @@ computeFB <- function(PTDF = system.file("testdata/2019-07-18ptdfraw.csv", packa
       thresholdIndic = thresholdIndic, quad = quad, verbose = verbose)
     res[, Face := NULL]
     error <- evalInter(A, res)
-    print(error)
-
+    if(verbose >= 2) {
+      print(error)
+    }
+
     PTDFRawDetails <- PTDFRaw[Period == combi[X, hour] & idDayType == combi[X, dayType],
                               .SD, .SDcols = c("idDayType", "Period", col_ptdfraw, "ram")]
     VERTDetails <- getVertices(res)
@@ -132,7 +144,7 @@ computeFB <- function(PTDF = system.file("testdata/2019-07-18ptdfraw.csv", packa
     setcolorder(VERTRawDetails, c("idDayType", "Period"))
 
     out <- data.table(Period = combi[X, hour], idDayType = combi[X, dayType],
-                        PTDFDetails = list(res), PTDFRawDetails = list(PTDFRawDetails),
+                      PTDFDetails = list(res), PTDFRawDetails = list(PTDFRawDetails),
                       VERTDetails = list(VERTDetails), VERTRawDetails = list(VERTRawDetails),
                       volIntraInter = error[1, 1],
                       error1 = error[1, 2], error2 = error[1, 3])
@@ -142,9 +154,7 @@ computeFB <- function(PTDF = system.file("testdata/2019-07-18ptdfraw.csv", packa
 
 
 
-  ##From B to antares
 
-  antaresFace <- .fromBtoAntares(face, col_ptdf)
 
   ######### OK
 

diff --git a/R/crtlFunctions.R b/R/crtlFunctions.R
@@ -88,21 +88,35 @@
 #' @param B \code{data.table}, face for 3 country, BE, DE anf FR
 #'
 #' @noRd
-.fromBtoAntares <- function(face, col_ptdf){
+.fromBtoAntares <- function(face, col_ptdf, areaName){
   B <- face[, .SD, .SDcols = col_ptdf]
   names(B) <- gsub("ptdf", "", names(B))
   nam <- as.character(1:nrow(B))
   nam <- ifelse(nchar(nam)==1, paste0(0, nam), nam)
 
 
-
-  coefAntares <- data.table(Name = paste0("FB", nam),
-                            BE.FR = round(B$BE - B$FR, 2),
-                            DE.FR = round(B$DE - B$FR, 2),
-                            DE.NL = round(B$DE, 2),
-                            BE.NL = round(B$BE, 2),
-                            BE.DE = round(B$BE - B$DE, 2),
-                            AT.DE = round(B$AT - B$DE, 2))
+  if (areaName == "cwe_at") {
+    coefAntares <- data.table(Name = paste0("FB", nam),
+                              BE.FR = round(B$BE - B$FR, 2),
+                              DE.FR = round(B$DE - B$FR, 2),
+                              DE.NL = round(B$DE, 2),
+                              BE.NL = round(B$BE, 2),
+                              BE.DE = round(B$BE - B$DE, 2),
+                              AT.DE = round(B$AT - B$DE, 2))
+  } else if (areaName == "cwe") {
+    coefAntares <- data.table(Name = paste0("FB", nam),
+                              BE.FR = round(B$BE - B$FR, 2),
+                              DE.FR = round(B$DE - B$FR, 2),
+                              DE.NL = round(B$DE, 2),
+                              BE.NL = round(B$BE, 2),
+                              BE.DE = round(B$BE - B$DE, 2))
+  } else if (areaName == "other") {
+
+  } else {
+    stop(paste("The value of areaName must be one of the following :",
+               "cwe, cwe_at, other,", "currently :", areaName))
+  }
+
 
 }