Commit 8eb98849 authored by Renaud Lancelot's avatar Renaud Lancelot 🌍
Browse files

Changes in function grplot: possibility to change ylim and now draws a color...

Changes in function grplot: possibility to change ylim and now draws a color bar instead of vertical lines to show the lock-down effect.
parent 503646b5
......@@ -221,13 +221,13 @@ dmrplot <- function(dmr, start = as.Date("2020-03-01"),
## key
mykey <- list(
space = "right", border = 1,
text = list(c("data",
"trend",
text = list(c("Data",
"Trend",
"lockdown",
"post-lockdown\nd 11, 19, 46",
"peak"), cex = cex),
lines = list(lty = c(1, 1, 4, 4, 1),
col = c(grey(.8), 2, 1, 2, 2),
"Post-lockdown\nd 11 and 46",
"Peak"), cex = cex),
lines = list(lty = c(1, 1, 4, 1),
col = c(grey(.8), 2, 1, 2),
size = 3))
g <- xyplot(value ~ date | variable + name,
......@@ -285,8 +285,8 @@ dmrplot <- function(dmr, start = as.Date("2020-03-01"),
## add lockdown date and pivotal dates
lddt <- Z1$lockdown[subscripts]
ld <- unique(as.numeric(lddt))
panel.abline(v = ld + c(0, 11, 19, 46),
col = c(1, 2, 2, 2),
panel.abline(v = ld + c(0, 11, 46),
col = c(1, 2, 2),
lty = 4,
subscripts)
## add peak date
......@@ -296,7 +296,7 @@ dmrplot <- function(dmr, start = as.Date("2020-03-01"),
if(!is.na(xd2peak)){
xdatepeak <- xdate1st + xd2peak
panel.abline(v = xdatepeak,
col=2, lwd=1, lty=1)
col = 2)
}
})
## plot with outer strips for better use of space
......@@ -493,20 +493,20 @@ grplot <- function(gr, nc, asp=2/3, cex=.7, dYlim=NA, nam){
"95% conf. band",
"Lockdown start",
"Peak line (y=0)",
"Early/median/late\nlockdown effect",
"Early / late\nlockdown effect",
"Mortality peak"), cex = cex + .1)
mykey$lines <- list(type = "b",
pch = c(NA, 15, rep(NA, 4)),
col = c(4, 4, 1, 4, 2, 4),
lty = c(1, 0, 4, 2, 4, 4),
pch = c(NA, 15, NA, NA, 15, 4),
col = c(4, 4, 1, 4, "pink", 4),
lty = c(1, 0, 4, 2, 0, 4),
size = 3, lwd = 1.5)
mydata <- subset(gr, name %in% nam)
## set time = 0 to lockdown - 10
## set time = 0 to lockdown
myL <- by(mydata,
list(name = mydata$name),
function(x){
x$dayL <- as.numeric(x$date - x$lockdown)
subset(x, dayL >= 0)
subset(x, dayL >= -10)
})
mydata <- do.call("rbind", myL)
......@@ -535,12 +535,20 @@ grplot <- function(gr, nc, asp=2/3, cex=.7, dYlim=NA, nam){
ylab = list("Mortality growth rate", cex = cex),
par.strip.text = list(cex = cex),
panel = function(x, y, subscripts){
xdate1st <- unique(mydata$date1st[subscripts])
## lockdown effetc
grid.rect(
x = unit(11 + (46 - 11) / 2, "native"),
y = unit(0.5, "npc"),
width = unit(46 - 11, "native"),
height = unit(1, "npc"),
gp = gpar(fill = "pink",
col = NA,
alpha = .5)
)
xlock <- unique(
mydata$lockdown[subscripts])
t0 <- as.numeric(xlock - xdate1st) - 10
d2peak <- unique(mydata$d2peak[subscripts]) - t0
ld <- -10
ldpeak <- unique(
mydata$ldpeak[subscripts])
## draw the confidence band
o <- order(x); X <- x[o]; Y <- y[o]
pg <- cbind(
......@@ -548,20 +556,16 @@ grplot <- function(gr, nc, asp=2/3, cex=.7, dYlim=NA, nam){
c(mydata$dYlo[subscripts][o],
rev(mydata$dYhi[subscripts][o])))
panel.polygon(pg, border = NA,
col = "light blue", alpha = .5)
col = "light blue", alpha = .7)
## smoothed mean
panel.xyplot(X, Y, type = "l", col = 4)
if(!is.na(xlock)){
## lockdown effect
panel.abline(v = ld + c(0, 11, 19, 46),
col = c(1, 2, 2, 2),
lty = rep(4, 4))
## death rate threshold
panel.abline(h = 0, col = 4, lty = 4)
## position of the peak
cond1 <- !is.na(d2peak)
if(cond1)
panel.abline(v = d2peak, col = 4, lty = 4)
## lockdown
panel.abline(v = 0, col = 1, lty = 4)
## peak
panel.abline(v = ldpeak, col = 4, lty = 4)
## death rate threshold
panel.abline(h = 0, col = 4, lty = 4)
}
})
}
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