Commit e94a5af3 authored by Loup's avatar Loup
Browse files

update outputs in video

parent c5f04281
......@@ -465,7 +465,7 @@ saveDeploymentStrategy <- function(params, outputGPKG = "landsepi_landscape.gpkg
#' @param writeTXT a logical indicating if outputs must be written in text files (TRUE, default)
#' or not (FALSE).
#' @param videoMP4 a logical indicating if a video must be generated (TRUE) or not (FALSE, default).
#' Works only if graphic=TRUE and audpc is computed.
#' Works only if graphic=TRUE and audpc_rel is computed.
#' @param keepRawResults a logical indicating if binary files must be kept after the end of
#' the simulation (default=FALSE). Careful, many files may be generated if keepRawResults=TRUE.
#' @details See ?landsepi for details on the model, assumptions and outputs, and our vignettes
......@@ -2089,7 +2089,7 @@ loadOutputs <- function(epid_outputs = "all", evol_outputs = "all"){
#' \item GLAnoDis = the absolute Green Leaf Area in absence of disease (used to compute
#' economic outputs).
#' \item audpc100S = the audpc in a fully susceptible landscape (used as reference value
#' for graphics and video).
#' for graphics).
#' }
#' @details "epid_outputs" is a character string (or a vector of character strings if several
#' outputs are to be computed) specifying the type of epidemiological and economic outputs
......
......@@ -178,15 +178,15 @@ epid_output <- function(types = "all", time_param, Npatho, area, rotation, cropt
C_host[C_host == 0] <- NA
area_host[, Nhost + 1] <- areaTot
## IMPORTATION OF THE SIMULATION OUTPUT (only those required depending on parameter "types")
requireH <- sum(is.element(substr(types, 1, 3), c("gla", "eco"))) > 0
requireL <- sum(is.element(types, c("audpc_rel", "gla_rel", "eco_yield", "eco_product", "eco_cost", "eco_margin"))) > 0
requireIR <- sum(is.element(types, c("audpc", "audpc_rel", "gla_rel", "eco_yield", "eco_product", "eco_cost", "eco_margin"))) > 0
if (graphic & sum(substr(types, nchar(types) - 7, nchar(types)) == "dynamics") > 0) {
requireH <- 1
requireL <- 1
requireIR <- 1
}
## IMPORTATION OF THE SIMULATION OUTPUT (only those required depending on parameter "types" --> not necessary any more)
# requireH <- sum(is.element(substr(types, 1, 3), c("gla", "eco"))) > 0
# requireL <- sum(is.element(types, c("audpc_rel", "gla_rel", "eco_yield", "eco_product", "eco_cost", "eco_margin"))) > 0
# requireIR <- sum(is.element(types, c("audpc", "audpc_rel", "gla_rel", "eco_yield", "eco_product", "eco_cost", "eco_margin"))) > 0
# if (graphic & sum(substr(types, nchar(types) - 7, nchar(types)) == "dynamics") > 0) {
# requireH <- 1
# requireL <- 1
# requireIR <- 1
# }
H <- as.list(1:nTS)
# Hjuv <- as.list(1:nTS)
# P <- as.list(1:nTS)
......@@ -198,11 +198,11 @@ epid_output <- function(types = "all", time_param, Npatho, area, rotation, cropt
# print("Reading binary files to compute epidemiological model outputs")
for (year in 1:Nyears) {
# print(paste("year", year, "/", Nyears))
if (requireH) {
# if (requireH) {
binfileH <- file(paste(path, sprintf("/H-%02d", year), ".bin", sep = ""), "rb")
H.tmp <- readBin(con = binfileH, what = "int", n = Npoly * Nhost * nTSpY, size = 4, signed = T, endian = "little")
close(binfileH)
}
# }
# binfileHjuv = file(paste(path, sprintf("/Hjuv-%02d", year), ".bin",sep=""), "rb")
# Hjuv.tmp <- readBin(con=binfileHjuv, what="int", n=Npoly*Nhost*nTSpY, size = 4, signed=T,endian="little")
# close(binfileHjuv)
......@@ -214,12 +214,12 @@ epid_output <- function(types = "all", time_param, Npatho, area, rotation, cropt
# signed = T,
# endian = "little")
# close(binfileP)
if (requireL) {
# if (requireL) {
binfileL <- file(paste(path, sprintf("/L-%02d", year), ".bin", sep = ""), "rb")
L.tmp <- readBin(con = binfileL, what = "int", n = Npoly * Npatho * Nhost * nTSpY, size = 4, signed = T, endian = "little")
close(binfileL)
}
if (requireIR) {
# }
# if (requireIR) {
binfileI <- file(paste(path, sprintf("/I-%02d", year), ".bin", sep = ""), "rb")
I.tmp <- readBin(con = binfileI, what = "int", n = Npoly * Npatho * Nhost * nTSpY, size = 4, signed = T, endian = "little")
close(binfileI)
......@@ -227,21 +227,21 @@ epid_output <- function(types = "all", time_param, Npatho, area, rotation, cropt
binfileR <- file(paste(path, sprintf("/R-%02d", year), ".bin", sep = ""), "rb")
R.tmp <- readBin(con = binfileR, what = "int", n = Npoly * Npatho * Nhost * nTSpY, size = 4, signed = T, endian = "little")
close(binfileR)
}
# }
for (t in 1:nTSpY) {
if (requireH) {
# if (requireH) {
H[[t + index]] <- matrix(H.tmp[((Nhost * Npoly) * (t - 1) + 1):(t * (Nhost * Npoly))], ncol = Nhost, byrow = T)
}
# }
# Hjuv[[t + index]] <- matrix(Hjuv.tmp[((Nhost*Npoly)*(t-1)+1):(t*(Nhost*Npoly))],ncol=Nhost,byrow=T)
# P[[t + index]] <- matrix(P.tmp[((Npatho * Npoly) * (t - 1) + 1):(t * (Npatho * Npoly))], ncol = Npatho, byrow = T)
if (requireL) {
# if (requireL) {
L[[t + index]] <- array(
data = L.tmp[((Npatho * Npoly * Nhost) * (t - 1) + 1):(t * (Npatho * Npoly * Nhost))],
dim = c(Nhost, Npatho, Npoly)
)
}
if (requireIR) {
# }
# if (requireIR) {
I[[t + index]] <- array(
data = I.tmp[((Npatho * Npoly * Nhost) * (t - 1) + 1):(t * (Npatho * Npoly * Nhost))],
dim = c(Nhost, Npatho, Npoly)
......@@ -250,7 +250,7 @@ epid_output <- function(types = "all", time_param, Npatho, area, rotation, cropt
data = R.tmp[((Npatho * Npoly * Nhost) * (t - 1) + 1):(t * (Npatho * Npoly * Nhost))],
dim = c(Nhost, Npatho, Npoly)
)
}
# }
} ## for t
index <- index + nTSpY
......@@ -261,22 +261,22 @@ epid_output <- function(types = "all", time_param, Npatho, area, rotation, cropt
L_host <- NULL
I_host <- NULL
R_host <- NULL
if (requireH) {
# if (requireH) {
for (t in 1:nTS) {
H_host <- cbind(H_host, apply(H[[t]], 2, sum))
}
}
if (requireL) {
# }
# if (requireL) {
for (t in 1:nTS) {
L_host <- cbind(L_host, apply(L[[t]], 1, sum))
}
}
if (requireIR) {
# }
# if (requireIR) {
for (t in 1:nTS) {
I_host <- cbind(I_host, apply(I[[t]], 1, sum))
R_host <- cbind(R_host, apply(R[[t]], 1, sum))
}
}
# }
N_host <- H_host + L_host + I_host + R_host
......@@ -877,7 +877,7 @@ evol_output <- function(types = "all", time_param, Npoly, cultivars_param, genes
#' used to delimit durabilities of the resistance genes. No line is drawn if keyDates=NULL (default).
#' @param nMapPY an integer specifying the number of epidemic maps per year to generate.
#' @param path path where binary files are located and where the video will be generated.
#' @details The left panel shows the year-after-year dynamics of AUDPC, relative to a fully susceptible landscape,
#' @details The left panel shows the year-after-year dynamics of AUDPC,
#' for each cultivar as well as the global average. The right panel illustrates the landscape,
#' where fields are hatched depending on the cultivated croptype, and coloured depending on the prevalence of the disease.
#' Note that up to 9 different croptypes can be represented properly in the right panel.
......
......@@ -125,11 +125,11 @@
#' above which a pathogen genotype is unlikely to go extinct, used to characterise the time to invasion
#' of resistant hosts (several values are computed if several thresholds are given in a vector).
#' @param GLAnoDis the absolute Green Leaf Area in absence of disease (used to compute economic outputs).
#' @param audpc100S the audpc in a fully susceptible landscape (used as reference value for graphics and video).
#' @param audpc100S the audpc in a fully susceptible landscape (used as reference value for graphics).
#' @param writeTXT a logical indicating if outputs must be written in text files (TRUE, default) or not (FALSE).
#' @param graphic a logical indicating if graphics must be generated (TRUE, default) or not (FALSE).
#' @param videoMP4 a logical indicating if a video must be generated (TRUE) or not (FALSE, default).
#' Works only if graphic=TRUE and epid_outputs="audpc" (or epid_outputs="all").
#' Works only if graphic=TRUE and epid_outputs="audpc_rel" (or epid_outputs="all").
#' @param keepRawResults a logical indicating if binary files must be kept after the end of the simulation (default=FALSE).
#' Careful, many files may be generated if keepRawResults=TRUE.
#' @details See ?landsepi for details on the model and assumptions.
......@@ -346,7 +346,7 @@ simul_landsepi <- function(seed = 12345, time_param = list(Nyears = 20, nTSpY =
}
## Video
if (videoMP4 & !is.null(epid_res[["audpc"]])) {
if (videoMP4 & !is.null(epid_res[["audpc_rel"]])) {
video(
epid_res[["audpc_rel"]], time_param, Npatho, landscape, area, rotation, croptypes_cultivars_prop,
croptype_names, cultivars_param
......
......@@ -7,7 +7,7 @@ simul_params <- setInoculum(simul_params, 5e-4)
## Outputs
simul_params <- setOutputs(simul_params, list(
epid_outputs = "audpc", evol_outputs = "",
epid_outputs = "audpc_rel", evol_outputs = "",
thres_breakdown = 50000,
GLAnoDis = 1.48315,
audpc100S = 0.76
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment