Newer
Older
panel = function (df_data, df_meta, layout_matrix, figdir='', filedir_opt='', filename_opt='', variable='', df_trend=NULL, p_threshold=0.1, unit2day=365.25, type='', period=NULL, missRect=FALSE, time_header=NULL, info_header=TRUE, header_ratio=2) {
if (all(class(df_data) != 'list')) {
df_data = list(df_data)
}
nbp = length(df_data)
if (all(class(df_trend) != 'list')) {
df_trend = list(df_trend)
if (length(df_trend) == 1) {
df_trend = replicate(nbp, df_trend)
}}
if (all(class(p_threshold) != 'list')) {
p_threshold = list(p_threshold)
if (length(p_threshold) == 1) {
p_threshold = replicate(nbp, p_threshold)
}}
if (all(class(unit2day) != 'list')) {
unit2day = list(unit2day)
if (length(unit2day) == 1) {
unit2day = replicate(nbp, unit2day)
}}
if (all(class(type) != 'list')) {
type = list(type)
if (length(type) == 1) {
type = replicate(nbp, type)
}}
if (all(class(missRect) != 'list')) {
missRect = list(missRect)
if (length(missRect) == 1) {
missRect = replicate(nbp, missRect)
}}
list_df2plot = vector(mode='list', length=nbp)
for (i in 1:nbp) {
df2plot = list(data=df_data[[i]],
trend=df_trend[[i]],
p_threshold=p_threshold[[i]],
unit2day=unit2day[[i]],
type=type[[i]],
missRect=missRect[[i]])
if (filename_opt != '') {
outfile = paste(outfile, '_', filename_opt, sep='')
}
outfile = paste(outfile, '.pdf', sep='')
# If there is not a dedicated figure directory it creats one
outdirTmp = file.path(outdir, 'tmp')
if (!(file.exists(outdirTmp))) {
dir.create(outdirTmp)
}
# Print code of the station for the current plotting
print(paste("Plotting for sation :", code))
nbh = as.numeric(info_header) + as.numeric(!is.null(time_header))
nbg = nbp + nbh
if (info_header) {
Htext = text_panel(code, df_meta)
P[[1]] = Htext
}
if (!is.null(time_header)) {
Htime = time_panel(code, time_header, df_trend=NULL,
for (i in 1:nbp) {
df_data = list_df2plot[[i]]$data
df_trend = list_df2plot[[i]]$trend
p_threshold = list_df2plot[[i]]$p_threshold
unit2day = list_df2plot[[i]]$unit2day
missRect = list_df2plot[[i]]$missRect
layout_matrix = as.matrix(layout_matrix)
nel = nrow(layout_matrix)*ncol(layout_matrix)
##
idNA = which(is.na(layout_matrix), arr.ind=TRUE)
layout_matrix[idNA] = seq(max(layout_matrix, na.rm=TRUE) + 1,
max(layout_matrix, na.rm=TRUE) + 1 +
nel)
##
layout_matrix_H = layout_matrix + nbh
LM = c()
LMcol = ncol(layout_matrix_H)
LMrow = nrow(layout_matrix_H)
for (i in 1:(LMrow+nbh)) {
if (i <= nbh) {
LM = rbind(LM, rep(i, times=LMcol))
} else {
LM = rbind(LM,
matrix(rep(layout_matrix_H[i-nbh,],
times=header_ratio),
ncol=LMcol, byrow=TRUE))
# plot = grid.arrange(rbind(cbind(ggplotGrob(P[[2]]), ggplotGrob(P[[2]])), cbind(ggplotGrob(P[[3]]), ggplotGrob(P[[3]]))), heights=c(1/3, 2/3))
# Saving
ggsave(plot=plot,
path=outdirTmp,
filename=paste(as.character(code), '.pdf', sep=''),
width=21, height=29.7, units='cm', dpi=100)
pdf_combine(input=file.path(outdirTmp, list.files(outdirTmp)),
output=file.path(outdir, outfile))
unlink(outdirTmp, recursive=TRUE)
}
time_panel = function (code, df_data, df_trend, missRect, p_threshold, unit2day, type, period=NULL, norm=TRUE, last=FALSE) {
maxQ = max(df_data_code$Qm3s, na.rm=TRUE)
power = nchar(as.character(as.integer(maxQ))) - 1
dbrk = 10^power
if (norm) {
df_data_code$Qm3s = df_data_code$Qm3s / dbrk
maxQ = max(df_data_code$Qm3s, na.rm=TRUE)
if (maxQ >= 5) {
dbrk = 1.0
} else if (maxQ < 5 & maxQ >= 3) {
dbrk = 0.5
} else if (maxQ < 3 & maxQ >= 2) {
dbrk = 0.4
} else if (maxQ < 2 & maxQ >= 1) {
dbrk = 0.3
} else if (maxQ < 1) {
dbrk = 0.2
}
dDate = as.numeric(df_data_code$Date[length(df_data_code$Date)] -
df_data_code$Date[1]) / unit2day
# datebreak = round(as.numeric(dDate) / unit2day / 11 , 0)
if (dDate >= 100) {
datebreak = 25
dateminbreak = 5
} else if (dDate < 100 & dDate >= 50) {
datebreak = 10
dateminbreak = 1
} else if (dDate < 50) {
datebreak = 5
dateminbreak = 1
}
p = ggplot() +
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
ggtitle(bquote(.(type)~'['*m^{3}*'.'*s^{-1}*'] x'~10^{.(as.character(power))})) +
theme(panel.background=element_rect(fill='white'),
text=element_text(family='sans'),
panel.border=element_blank(),
panel.grid.major.y=element_line(color='grey85', size=0.3),
panel.grid.major.x=element_blank(),
axis.ticks.y=element_blank(),
axis.ticks.x=element_line(color='grey75', size=0.3),
axis.text.x=element_text(color='grey40'),
axis.text.y=element_text(color='grey40'),
ggh4x.axis.ticks.length.minor=rel(0.5),
axis.ticks.length=unit(1.5, 'mm'),
plot.title=element_text(size=10, vjust=-4,
hjust=0, color='grey20'),
axis.title.x=element_blank(),
axis.title.y=element_blank(),
# axis.title.y=element_text(size=8, color='grey20'),
axis.line.x=element_blank(),
axis.line.y=element_blank(),
)
if (last) {
p = p +
theme(plot.margin=margin(1, 5, 5, 5, unit="mm"))
} else {
p = p +
theme(plot.margin=margin(1, 5, 1, 5, unit="mm"))
}
if (type == 'sqrt(Q)' | type == 'Q') {
p = p +
geom_line(aes(x=df_data_code$Date, y=df_data_code$Qm3s),
color='grey20')
} else {
p = p +
geom_line(aes(x=df_data_code$Date, y=df_data_code$Qm3s),
color='grey65') +
geom_point(aes(x=df_data_code$Date, y=df_data_code$Qm3s),
shape=1, color='grey20', size=1)
}
if (missRect) {
NAdate = df_data_code$Date[is.na(df_data_code$Qm3s)]
dNAdate = diff(NAdate)
NAdate_Down = NAdate[append(Inf, dNAdate) != 1]
NAdate_Up = NAdate[append(dNAdate, Inf) != 1]
p = p +
geom_rect(aes(xmin=NAdate_Down,
ymin=0,
xmax=NAdate_Up,
linetype=0, fill='Wheat', alpha=0.3)
}
if ((type == 'sqrt(Q)' | type == 'Q') & !is.null(period)) {
period = as.Date(period)
p = p +
geom_rect(aes(xmin=min(df_data_code$Date),
ymin=0,
xmax=period[1],
ymax= maxQ*1.1),
linetype=0, fill='grey85', alpha=0.3) +
geom_rect(aes(xmin=period[2],
ymin=0,
xmax=max(df_data_code$Date),
ymax= maxQ*1.1),
linetype=0, fill='grey85', alpha=0.3)
}
if (!is.null(df_trend)) {
if (df_trend[df_trend$code == code,]$p < p_threshold) {
abs = c(df_data_code$Date[1],
df_data_code$Date[length(df_data_code$Date)])
abs_num = as.numeric(abs)/unit2day
ord = abs_num * df_trend$trend[df_trend$code == code] +
df_trend$intercept[df_trend$code == code]
p = p +
geom_line(aes(x=abs, y=ord),
color='cornflowerblue')
}}
# if (norm) {
# p = p +
# ylab(bquote('dbit ['*m^{3}*'.'*s^{-1}*'] x'~10^{.(as.character(power))}))
# } else {
# p = p +
# ylab(expression(paste('dbit [', m^{3}, '.',
# s^{-1}, ']', sep='')))
# }
date_minor_breaks=paste(as.character(dateminbreak),
'year', sep=' '),
guide='axis_minor',
date_labels="%Y",
limits=c(min(df_data_code$Date),
max(df_data_code$Date)),
scale_y_continuous(breaks=seq(0, maxQ*10, dbrk),
limits=c(0, maxQ*1.1),
expand=c(0, 0))
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
return(p)
}
text_panel = function(code, df_meta) {
df_meta_code = df_meta[df_meta$code == code,]
text = paste(
"<span style='font-size:18pt'> station <b>", code, "</b></span><br>",
"nom : ", df_meta_code$nom, "<br>",
"territoire : ", df_meta_code$territoire, "<br>",
"position : (", df_meta_code$L93X, "; ", df_meta_code$L93Y, ")", "<br>",
"surface : ", df_meta_code$surface_km2, " km<sup>2</sup>",
sep='')
gtext = richtext_grob(text,
x=0, y=1,
margin=unit(c(5, 5, 5, 5), "mm"),
hjust=0, vjust=1,
gp=gpar(col="grey20", fontsize=12))
return(gtext)
}
void = ggplot() + geom_blank(aes(1,1)) +
theme(
plot.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.background = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks = element_blank(),
axis.line = element_blank()
)