Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
CSIRO-INRA
landsepi
Commits
e94a5af3
Commit
e94a5af3
authored
Jun 17, 2021
by
Loup
Browse files
update outputs in video
parent
c5f04281
Changes
4
Hide whitespace changes
Inline
Side-by-side
R/Methods-LandsepiParams.R
View file @
e94a5af3
...
...
@@ -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
...
...
R/output.R
View file @
e94a5af3
...
...
@@ -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.
...
...
R/simul_landsepi.R
View file @
e94a5af3
...
...
@@ -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
...
...
inst/shiny-landsepi/server.R
View file @
e94a5af3
...
...
@@ -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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment