Commit 27782e46 authored by Heraut Louis's avatar Heraut Louis
Browse files

Start of plot function modular

parent cc1438b4
No related merge requests found
Showing with 131 additions and 87 deletions
+131 -87
...@@ -3,11 +3,12 @@ library(ggplot2) ...@@ -3,11 +3,12 @@ library(ggplot2)
library(scales) library(scales)
library(qpdf) library(qpdf)
library(gridExtra) library(gridExtra)
library(gridtext)
# Time panel # Time panel
panel = function (df_data, df_meta, figdir, p_threshold=0.1, filedir_opt='', filename_opt='', variable='', df_trend=NULL, unit2day=365.25, is_sqrt=FALSE, missRect=FALSE) { panel = function (df_data, df_meta, figdir, p_threshold=0.1, filedir_opt='', filename_opt='', variable='', df_trend=NULL, unit2day=365.25, is_sqrt=FALSE, missRect=FALSE) {
outfile = "Panels" outfile = "Panels"
if (filename_opt != '') { if (filename_opt != '') {
...@@ -39,106 +40,149 @@ panel = function (df_data, df_meta, figdir, p_threshold=0.1, filedir_opt='', fil ...@@ -39,106 +40,149 @@ panel = function (df_data, df_meta, figdir, p_threshold=0.1, filedir_opt='', fil
# Print code of the station for the current plotting # Print code of the station for the current plotting
print(paste("Plotting for sation :", code)) print(paste("Plotting for sation :", code))
df_data_code = df_data[df_data$code == code,]
dDate = df_data_code$Date[length(df_data_code$Date)] - p = time_panel(code, df_data, df_trend, missRect,
df_data_code$Date[1] p_threshold, unit2day, is_sqrt)
datebreak = round(as.numeric(dDate) / unit2day / 11 , 0)
gtext = text_panel(code, df_meta)
p = ggplot() + theme_bw() + plot = grid.arrange(gtext, p, void, void, ncol=1, nrow=4, heights=c(1/7, 2/7, 2/7, 2/7))
geom_line(aes(x=df_data_code$Date, y=df_data_code$Qm3s),
color='black')
# Saving
ggsave(plot=plot,
path=outdirTmp,
filename=paste(as.character(code), '.pdf', sep=''),
width=21, height=29.7, units='cm', dpi=100)
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]
pdf_combine(input=file.path(outdirTmp, list.files(outdirTmp)),
output=file.path(outdir, outfile))
unlink(outdirTmp, recursive=TRUE)
}
p = p +
geom_rect(aes(xmin=NAdate_Down,
ymin=0,
xmax=NAdate_Up,
ymax=max(df_data_code$Qm3s, na.rm=TRUE)*1.1),
linetype=0, fill='Wheat', 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], time_panel = function (code, df_data, df_trend, missRect, p_threshold, unit2day, is_sqrt) {
df_data_code$Date[length(df_data_code$Date)])
abs_num = as.numeric(abs)/unit2day df_data_code = df_data[df_data$code == code,]
ord = abs_num * df_trend$trend[df_trend$code == code] + dDate = df_data_code$Date[length(df_data_code$Date)] -
df_trend$intercept[df_trend$code == code] df_data_code$Date[1]
datebreak = round(as.numeric(dDate) / unit2day / 11 , 0)
p = ggplot() + theme_bw() +
geom_line(aes(x=df_data_code$Date, y=df_data_code$Qm3s),
color='black')
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,
ymax=max(df_data_code$Qm3s, na.rm=TRUE)*1.1),
linetype=0, fill='Wheat', alpha=0.3)
}
p = p + if (!is.null(df_trend)) {
geom_line(aes(x=abs, y=ord), if (df_trend[df_trend$code == code,]$p < p_threshold) {
color='cornflowerblue')
}}
p = p +
# ggtitle(paste(variable, 'station',
# as.character(code), sep=' ')) +
ylab(expression(paste('débit [', m^{3}, '.',
s^{-1}, ']', sep=''))) +
xlab('date') +
scale_x_date(date_breaks=paste(as.character(datebreak),
'year', sep=' '),
date_labels="%Y",
limits=c(min(df_data_code$Date),
max(df_data_code$Date)),
expand=c(0, 0))
if (is_sqrt) {
p = p +
scale_y_continuous(breaks=seq(0, 100, 10),
minor_breaks=seq(0, 100, 5),
limits=c(0,
max(df_data_code$Qm3s,
na.rm=TRUE)*1.1),
expand=c(0, 0))
} else {
p = p +
scale_y_continuous(breaks=seq(0, 10000, 1000),
minor_breaks=seq(0, 10000, 500),
limits=c(0,
max(df_data_code$Qm3s,
na.rm=TRUE)*1.1),
expand=c(0, 0))
}
df_meta_code = df_meta[df_meta$code == code,]
text = textGrob(paste(
'station ', code, '\n',
'nom : ', df_meta_code$nom, '\t',
'territoire : ', df_meta_code$territoire, '\n',
'position : (', df_meta_code$L93X, '; ', df_meta_code$L93Y, ')', '\t',
'surface : ', df_meta_code$surface_km2, ' km2',
sep=''),
just='left',
gp=gpar(col="darkgrey", fontsize=10))
plot = grid.arrange(text, p, ncol=1, nrow=2, heights=c(1/4, 3/4))
# Saving abs = c(df_data_code$Date[1],
ggsave(plot=plot, df_data_code$Date[length(df_data_code$Date)])
path=outdirTmp,
filename=paste(as.character(code), '.pdf', sep=''),
width=29.7, height=21, units='cm', dpi=100)
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')
}}
p = p +
# ggtitle(paste(variable, 'station',
# as.character(code), sep=' ')) +
ylab(expression(paste('débit [', m^{3}, '.',
s^{-1}, ']', sep=''))) +
xlab('date') +
scale_x_date(date_breaks=paste(as.character(datebreak),
'year', sep=' '),
date_labels="%Y",
limits=c(min(df_data_code$Date),
max(df_data_code$Date)),
expand=c(0, 0))
if (is_sqrt) {
p = p +
scale_y_continuous(breaks=seq(0, 100, 10),
minor_breaks=seq(0, 100, 5),
limits=c(0,
max(df_data_code$Qm3s,
na.rm=TRUE)*1.1),
expand=c(0, 0))
} else {
p = p +
scale_y_continuous(breaks=seq(0, 10000, 1000),
minor_breaks=seq(0, 10000, 500),
limits=c(0,
max(df_data_code$Qm3s,
na.rm=TRUE)*1.1),
expand=c(0, 0))
} }
# print(list.files(outdirTmp))
print(file.path(outdir, outfile))
pdf_combine(input=file.path(outdirTmp, list.files(outdirTmp)), p = p +
output=file.path(outdir, outfile)) theme(
unlink(outdirTmp, recursive=TRUE) panel.background=element_rect(fill="white"),
} plot.margin=margin(0, 5, 0, 5, unit="mm"))
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()
)
...@@ -8,7 +8,7 @@ install.packages("officer") ...@@ -8,7 +8,7 @@ install.packages("officer")
install.packages("lubridate") install.packages("lubridate")
install.packages('zoo') install.packages('zoo')
install.packages("qpdf") install.packages("qpdf")
install.packages("scales") install.packages("gridtext")
library(devtools) library(devtools)
install_github("https://github.com/benRenard/BFunk") #type '1' install_github("https://github.com/benRenard/BFunk") #type '1'
......
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