#' @importFrom utils URLencode
fread_antares <- function(opts, file, ...) {
if (identical(opts$typeLoad, "api")) {
file <- gsub("\\.txt$", "", file)
response <- api_get(
opts = opts,
endpoint = I(file),
query = list(formatted = FALSE)
)
suppressWarnings(
tryCatch(fread(response, ...), error = function(e){
message(file); message(e)
}))
} else {
suppressWarnings(
fread(file, ...))
}
}
empty_strings_as_NA <- function(x) {
if (identical(x, ""))
return(NA)
if (is.character(x))
return(x)
rapply(object = x, f = function(y) {
if (identical(y, "")) {
return(NA)
}
return(y)
}, how = "replace")
}
#' @importFrom utils URLencode
read_secure_json <- function(url, token = NULL, timeout = 60, config = list()) {
result <- api_get(
opts = list(token = token, timeout = timeout, httr_config = config),
endpoint = I(url)
)
empty_strings_as_NA(result)
}
.getPathsAPI <- function(host, study_id, simulation, ...){
simNames <- NULL
path <- paste0(host, "/v1/studies/", study_id)
path <- gsub("[/\\]$", "", path)
path <- paste0(path, "/raw?path=")
inputPath <- file.path(path, "input")
outputPath <- file.path(path, "output")
if(is.null(simulation) | (!is.null(simulation) && !simulation %in% c(0, "input"))){
outputContent <- names(read_secure_json(paste0(outputPath, "&depth=4"), ...))
simNames <- setdiff(basename(outputContent), c("maps", "logs"))
}
if (length(simNames) == 0) {
if (length(simulation) > 0 && !simulation %in% c(0, "input")) {
stop("Cannot find any simulation result")
} else {
simulation <- 0
}
}
if (is.null(simulation)) {
if (length(simNames) == 1) { # Case 2
simulation <- 1
} else { # Case 3
cat("Please, choose a simulation\n")
for (i in 1:length(simNames)) {
cat(sprintf(" %s - %s\n", i, simNames[i]))
}
simulation <- type.convert(scan(what = character(), nmax = 1), as.is = TRUE)
}
}
if (simulation %in% c(0, "input")) {
studyPath <- path
simPath <- NULL
} else {
out <- .giv_sim(simulation, simNames, path)
std_sel <- which(unlist(lapply(simNames, function(X){
grepl(paste0(X, "$"), out$simPath)
})))
# out$simPath <- gsub(simNames[std_sel], std_sel, out$simPath)
out$simOutputName <- simNames[std_sel]
return(out)
}
list(studyPath = studyPath,
simPath = simPath,
inputPath = inputPath)
}
.getSimOptionsAPI <- function(paths, host, ...){
## Read info from json
simPath <- paths$simPath
# Get basic information about the simulation
params <- read_secure_json(file.path(simPath, "about-the-study", "parameters"), ...)
info <- read_secure_json(file.path(simPath, "info", "general"), ...)
# Where are located the results ?
simDataPath <- file.path(simPath, tolower(as.character(info$mode)))
synthesis <- .getSuccess(file.path(simDataPath, "mc-all&depth=1"), ...)
yearByYear <- .getSuccess(file.path(simDataPath, "mc-ind&depth=1"), ...)
scenarios <- .getSuccess(file.path(simPath, "ts-numbers&depth=1"), ...)
if(yearByYear) {
year_no_filter <- names(read_secure_json(file.path(simDataPath, "mc-ind&depth=1"), ...))
mcYears <- as.numeric(year_no_filter[grep("^\\d{5}$", year_no_filter)])
} else mcYears <- numeric()
if (!synthesis & !yearByYear) stop("No results/data found in API", call. = FALSE)
# List of available areas and links
if (synthesis) {
dataPath <- file.path(simDataPath, "mc-all")
} else {
dataPath <- file.path(simDataPath, "mc-ind",sprintf("%05d", mcYears[1]))
}
areaList <- gsub("\r$", "", tolower(strsplit(
read_secure_json(file.path(paths$simPath, "about-the-study", "areas"), ...), "\n")[[1]]
))
districtList <- grep("^@", areaList, value=TRUE)
areaList <- areaList[!areaList %in% districtList]
linkList <- read_secure_json(file.path(dataPath, "links&depth=2"), ...)
linkList <- unlist(mapply(function(X, Y){
if(length(Y) >= 1){
paste(X, names(Y), sep = " - ")
} else {
NULL
}
}, names(linkList), linkList))
names(linkList) <- NULL
# Areas containing clusters
hasClusters <- unlist(
lapply(
read_secure_json(file.path(dataPath, "areas&depth=2"), ...),
function(x) any(grepl("(details-annual)|(details-daily)|(details-hourly)|(details-monthly)|(details-weekly)", names(x)))
)
)
areasWithClusters <- names(hasClusters)[hasClusters]
# Areas containing clusters
hasResClusters <- unlist(
lapply(
read_secure_json(file.path(dataPath, "areas&depth=2"), ...),
function(x) any(grepl("details-res-", names(x)))
)
)
areasWithResClusters <- names(hasResClusters)[hasResClusters]
# Available variables
variables <- list()
# Available variables for areas
d <- file.path(dataPath, "areas", areaList[1])
f <- names(read_secure_json(paste0(d, "&depth=1"), ...))
f <- f[grep("values", f)]
if (length(f) > 0) {
v <- .getOutputHeader(file.path(d, f[1]), "area", api = TRUE, ...)
if(exists("pkgEnv")){
variables$areas <- setdiff(v, pkgEnv$idVars)
} else {
variables$areas <- v
}
}
# Available variables for links
if(length(linkList) > 0){
d <- file.path(dataPath, "links", gsub(" - ", "/",linkList[1]))
f <- names(read_secure_json(paste0(d, "&depth=1"), ...))
f <- f[grep("values", f)]
if (length(f) > 0) {
v <- .getOutputHeader(file.path(d, f[1]), "link", api = TRUE, ...)
if(exists("pkgEnv")){
variables$links <- setdiff(v, pkgEnv$idVars)
} else {
variables$links <- v
}
}
}
linksDef <- .readLinksDef(strsplit(read_secure_json(file.path(paths$simPath, "about-the-study", "links"), ...), "\n")[[1]])
return(
list(
simDataPath = simDataPath,
name = as.character(info$name),
mode = as.character(info$mode),
simDate = info$date,
synthesis = synthesis,
yearByYear = yearByYear,
scenarios = scenarios,
mcYears = mcYears,
antaresVersion = info$version,
areaList = areaList,
districtList = gsub("^@ ?", "", districtList),
linkList = linkList[linkList %in% linksDef$link],
linksDef = linksDef,
areasWithClusters = intersect(areasWithClusters, areaList),
areasWithResClusters = intersect(areasWithResClusters, areaList),
variables = variables,
parameters = params
)
)
}
#' @importFrom httr GET timeout add_headers http_status
.getSuccess <- function(path, token, timeout = 60, config = list()) {
if (!is.null(token) && token != "") {
response <- GET(
URLencode(path), timeout(timeout),
add_headers(Authorization = paste0("Bearer ", token)),
config = config
)
} else {
response <- GET(path, timeout(timeout), config = config)
}
http_status(response)$category == "Success"
}
.getInputOptionsAPI <- function(paths, ...) {
studyPath <- paths$studyPath
inputPath <- paths$inputPath
outputPath <- paths$simPath
# Lists of areas, links and districts existing in the study
areaList <- unique(
tolower(unlist(read_secure_json(file.path(inputPath, "areas", "list"), ...)))
)
districtList <- unique(
tolower(names(read_secure_json(file.path(inputPath, "areas", "sets"), ...)))
)
areasWithLinks <- unique(names(read_secure_json(file.path(inputPath, "links&depth=1"), ...)))
areasWithLinks <- intersect(areasWithLinks, areaList)
allLinks <- read_secure_json(file.path(inputPath, "links&depth=3"), ...)
linksDef <- data.table::rbindlist(mapply(function(X, Y){
to = names(X$properties)
if (length(to) == 0) return(NULL)
data.frame(link = paste(Y, "-", to), from = Y, to = to, stringsAsFactors = TRUE)
}, allLinks, names(allLinks)))
# info <- read_secure_json(studyPath, ...)
antaresVersion <- paths$version
params <- read_secure_json(file.path(studyPath, "settings", "generaldata"), ...)
# Areas with clusters
clusterList <- read_secure_json(file.path(inputPath, "thermal", "clusters", "&depth=4"), ...)
areaHasClusters <- vapply(areaList, FUN.VALUE = logical(1), function(a) {
TF <- FALSE
try({
f <- clusterList[[a]]$list
if(!is.null(f))return(TRUE)
})
return(TF)
})
# Areas with renewable clusters
areaHasResClusters <- logical(0)
if (!is.null(params$`other preferences`$`renewable-generation-modelling`)){
if(params$`other preferences`$`renewable-generation-modelling` == "clusters"){
clusterResList <- read_secure_json(file.path(inputPath, "renewables", "clusters", "&depth=4"), ...)
areaHasResClusters <- vapply(areaList, FUN.VALUE = logical(1), function(a) {
TF <- FALSE
try({
f <- clusterResList[[a]]$list
if(!is.null(f))return(TRUE)
})
return(TF)
})
}
}
# Areas with st-storage (>=860)
if(paths$version>=860){
clusterSTList <- read_secure_json(file.path(inputPath, "st-storage", "clusters", "&depth=4"), ...)
areaHasSTClusters <- vapply(areaList, FUN.VALUE = logical(1), function(a) {
TF <- FALSE
try({
f <- clusterSTList[[a]]$list
if(!is.null(f))return(TRUE)
})
return(TF)
})
# return
list(
mode = "Input",
antaresVersion = antaresVersion,
areaList = areaList,
districtList = districtList,
linkList = as.character(linksDef$link),
linksDef = linksDef,
areasWithClusters = areaList[areaHasClusters],
areasWithResClusters = areaList[areaHasResClusters],
areasWithSTClusters = areaList[areaHasSTClusters],
parameters = params
)
}else
list(
mode = "Input",
antaresVersion = antaresVersion,
areaList = areaList,
districtList = districtList,
linkList = as.character(linksDef$link),
linksDef = linksDef,
areasWithClusters = areaList[areaHasClusters],
areasWithResClusters = areaList[areaHasResClusters],
parameters = params
)
}
# valid_url <- function(url_in, t = 2){
# con <- url(url_in)
# check <- suppressWarnings(try(open.connection(con, open = "rt",timeout = t), silent = T)[1])
# suppressWarnings(try(close.connection(con), silent = T))
# ifelse(is.null(check),TRUE ,FALSE )
# }
#' @import jsonlite
#' @export
#' @return
#' \item{sleep}{timer for api commande execute}
#' @rdname setSimulationPath
setSimulationPathAPI <- function(host, study_id, token, simulation = NULL,
timeout = 60, httr_config = list()) {
if (missing(host)) {
stop("Please specify an url to antares API host")
}
if (missing(study_id)) {
stop("Please specify the study_id")
}
if (missing(token)) {
stop("Please specify your access token")
}
valid_host <- tryCatch({
.getSuccess(file.path(host, "health"), token = "", timeout = timeout, config = httr_config)
}, error = function(e) FALSE)
if(!valid_host){
stop("setSimulationPathAPI : invalid host '", host, "'")
}
stopifnot(timeout > 0)
check_study <- tryCatch({
read_secure_json(file.path(host, "v1/studies", study_id), token = token,
timeout = timeout, config = httr_config
)
}, error = function(e){
# catch message from api_get() (from API)
stop(e)
})
# generic tests (legacy)
if(isTRUE(all.equal(names(check_study), "detail"))){
stop("Can't connect to API. Please verify token")
}
# generic tests (legacy)
if(!study_id %in% check_study$id){
stop("Can't find your 'study_id' on the API")
}
res <- .getPathsAPI(host,
study_id,
simulation,
token = token,
timeout = timeout,
config = httr_config)
res$studyName <- check_study$name
res$version <- check_study$version
# If "input mode", read options from the input folder, else read them from
# the simulation folder.
if (is.null(res$simPath) | length(res$simPath) == 0) {
res <- append(res,
.getInputOptionsAPI(res,
token = token,
timeout = timeout,
config = httr_config))
} else {
res$simPath <- URLencode(res$simPath)
res <- append(res,
.getSimOptionsAPI(res,
host,
token = token,
timeout = timeout,
config = httr_config))
}
# dates, TimeId min and max
tmin <- res$parameters$general$simulation.start
tmax <- res$parameters$general$simulation.end
res$timeIdMin <- 1 + (tmin - 1) * 24
res$timeIdMax <- ((tmax - tmin + 1) %/% 7 * 7 + tmin - 1) * 24
res$start <- .getStartDate(res$parameters)
res$firstWeekday <- as.character(res$parameters$general$first.weekday)
# Other informations that has to be read in input folder
res$districtsDef <- .readDistrictsDefAPI(res$inputPath, res$areaList, token, timeout)
res$energyCosts <- .readEnergyCostsAPI(res$inputPath, token, timeout)
res$typeLoad <- "api"
res$host <- host
res$study_id <- study_id
res$token <- token
res$timeout <- timeout
res$httr_config <- httr_config
res$modeAPI <- "sync"
# delete version to keep only "antares_version"
res$version <- NULL
# timer for api commande execute
res$sleep <- 0.5
class(res) <- c("simOptions")
options(antares = res)
res
}
#' Change API Timeout
#'
#' @param opts
#' list of simulation parameters returned by the function
#' \code{\link{setSimulationPathAPI}}
#' @param timeout \code{numeric} API timeout (seconds). Default to 60.
#'
#' @export
#'
#' @examples
#' \dontrun{
#' opts <- setTimeoutAPI(opts, timeout = 45)
#' }
#'
setTimeoutAPI <- function(opts, timeout){
if(opts$typeLoad == 'api'){
opts$timeout <- timeout
} else {
warning("setTimeoutAPI can only be use for API Simulation")
}
return(opts)
}
# Private function that reads the definition of the districts
.readDistrictsDefAPI <- function(inputPath, areas, token = NULL, timeout = 60) {
districts <- read_secure_json(file.path(inputPath, "areas/sets"), token = token, timeout = timeout)
if (length(districts) == 0) return(NULL)
res <- ldply(names(districts), function(n) {
x <- districts[[n]]
if (any(unlist(x) == "add-all")) {
areasToRemove <- unlist(x[names(x) == "-"], use.names = FALSE)
areas <- setdiff(areas, areasToRemove)
} else {
areas <- unlist(x[names(x) == "+"], use.names = FALSE)
}
if (length(areas) == 0) return(NULL)
data.frame(district = tolower(n), area = tolower(areas), stringsAsFactors = TRUE)
})
data.table(res)
}
# Private function that reads costs of unsuplied and spilled energy
.readEnergyCostsAPI <- function(inputPath, token = NULL, timeout = 60) {
costs <- read_secure_json(file.path(inputPath, "thermal", "areas"), token = token, timeout = timeout)
list(
unserved = unlist(costs$unserverdenergycost),
spilled = unlist(costs$spilledenergycost)
)
}
is_api_study <- function(opts) {
isTRUE(opts$typeLoad == "api")
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.