Skip to content
GitLab
Select Git revision
  • master default
  • BRIEFCOM
  • ctfs
  • test.dplyr
  • package
Find file BlameHistoryPermalink
panel.R 9.71 KiB
1 
# Usefull library
2 
library(ggplot2)
3 
library(scales)
4 
library(qpdf)
5 
library(gridExtra)
6 
library(gridtext)
7 
library(dplyr)
8 
library(grid)
9
10
11 
# Time panel
12 
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='', missRect=FALSE, time_header=NULL, info_header=TRUE, header_ratio=2) {
13
14 
    if (all(class(df_data) != 'list')) {
15 
        df_data = list(df_data)
16 
    }
17
18 
    nbp = length(df_data)
19
20 
    if (all(class(df_trend) != 'list')) {
21 
        df_trend = list(df_trend)
22 
        if (length(df_trend) == 1) {
23 
            df_trend = replicate(nbp, df_trend)
24 
        }}
25
26 
    if (all(class(p_threshold) != 'list')) {
27 
        p_threshold = list(p_threshold)
28 
        if (length(p_threshold) == 1) {
29 
            p_threshold = replicate(nbp, p_threshold)
30 
        }}
31
32 
    if (all(class(unit2day) != 'list')) {
33 
        unit2day = list(unit2day)
34 
        if (length(unit2day) == 1) {
35 
            unit2day = replicate(nbp, unit2day)
36 
        }}
37
38 
    if (all(class(type) != 'list')) {
39 
        type = list(type)
40 
        if (length(type) == 1) {
41 
            type = replicate(nbp, type)
42 
        }}
43
44 
    if (all(class(missRect) != 'list')) {
45 
        missRect = list(missRect)
46 
        if (length(missRect) == 1) {
47 
            missRect = replicate(nbp, missRect)
48 
        }}
49
50 
    list_df2plot = vector(mode='list', length=nbp)
51
52 
    for (i in 1:nbp) {
53
54 
        df2plot = list(data=df_data[[i]],
55 
                       trend=df_trend[[i]],
56 
                       p_threshold=p_threshold[[i]],
57 
                       unit2day=unit2day[[i]],
58 
                       type=type[[i]],
59 
                       missRect=missRect[[i]])
60
61 
        list_df2plot[[i]] = df2plot
62 
    }
63
64
65 
    outfile = "Panels"
66 
    if (filename_opt != '') {
67 
        outfile = paste(outfile, '_', filename_opt, sep='')
68 
    }
69 
    outfile = paste(outfile, '.pdf', sep='')
70
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
# If there is not a dedicated figure directory it creats one outdir = file.path(figdir, filedir_opt, sep='') if (!(file.exists(outdir))) { dir.create(outdir) } outdirTmp = file.path(outdir, 'tmp') if (!(file.exists(outdirTmp))) { dir.create(outdirTmp) } # Get all different stations code Code = levels(factor(df_meta$code)) for (code in Code) { # 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 P = vector(mode='list', length=nbg) 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, missRect=TRUE, unit2day=365.25, type='time') P[[2]] = Htime } nbcol = ncol(as.matrix(layout_matrix)) 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 type = list_df2plot[[i]]$type p = time_panel(code, df_data, df_trend, missRect, p_threshold, unit2day, type, last=(i > nbp-nbcol)) P[[i+nbh]] = p } 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)
141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210
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(grobs=P, layout_matrix=LM) # 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, last=FALSE) { if (type == 'sqrt') { df_data[, 'Qm3s'] = apply(df_data[, 'Qm3s'], 1, sqrt) } df_data_code = df_data[df_data$code == code,] dDate = df_data_code$Date[length(df_data_code$Date)] - 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) } 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)])
211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280
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('dbit [', 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)) + annotate('text', x=as.Date(as.numeric(max(df_data_code$Date))*0.9), y=max(df_data_code$Qm3s, na.rm=TRUE)*1.05, label=type) if (type == '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 if (type == 'time') { 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)) } else { p = p + scale_y_continuous(limits=c(0, max(df_data_code$Qm3s, na.rm=TRUE)*1.1), expand=c(0, 0)) } if (last) { p = p + theme( panel.background=element_rect(fill="white"), plot.margin=margin(1, 5, 5, 5, unit="mm")) } else { p = p + theme( panel.background=element_rect(fill="white"), plot.margin=margin(1, 5, 1, 5, unit="mm")) } return(p) } text_panel = function(code, df_meta) {
281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314
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() )