Skip to content
GitLab
Select Git revision
  • master default
Find file BlameHistoryPermalink
panel.R 87.33 KiB
1 
# \\\
2 
# Copyright 2021-2022 Louis Hraut*1
3 
#
4 
# *1   INRAE, France
5 
#      louis.heraut@inrae.fr
6 
#
7 
# This file is part of ash R toolbox.
8 
#
9 
# ash R toolbox is free software: you can redistribute it and/or modify
10 
# it under the terms of the GNU General Public License as published by
11 
# the Free Software Foundation, either version 3 of the License, or (at
12 
# your option) any later version.
13 
#
14 
# ash R toolbox is distributed in the hope that it will be useful, but
15 
# WITHOUT ANY WARRANTY; without even the implied warranty of
16 
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17 
# General Public License for more details.
18 
#
19 
# You should have received a copy of the GNU General Public License
20 
# along with ash R toolbox.  If not, see <https://www.gnu.org/licenses/>.
21 
# ///
22 
#
23 
#
24 
# plotting/panel.R
25 
#
26 
#
27
28
29 
# Usefull library
30 
library(ggplot2)
31 
library(scales)
32 
library(qpdf)
33 
library(gridExtra)
34 
library(gridtext)
35 
library(dplyr)
36 
library(grid)
37 
library(ggh4x)
38 
library(RColorBrewer)
39 
library(rgdal)
40 
library(shadowtext)
41
42
43 
palette_perso = c('#0f3b57',
44 
                  '#1d7881',
45 
                  '#80c4a9',
46 
                  '#e2dac6', #mid
47 
                  '#fadfad',
48 
                  '#d08363',
49 
                  '#7e392f')
50
51
52 
display_type = function (type, bold=FALSE) {
53
54 
    if (type == "QA") {
55 
        if (bold) {
56 
            disp = bquote(Q[A])
57 
        } else {
58 
            disp = bquote(bold(Q[A]))
59 
        }
60 
    } else if (type == "QMNA") {
61 
        if (bold) {
62 
            disp = bquote(Q[MNA])
63 
        } else {
64 
            disp = bquote(bold(Q[MNA]))
65 
        }
66 
    } else if (type == "VCN10") {
67 
        if (bold) {
68 
            disp = bquote(V[CN10])
69 
        } else {
70 
            disp = bquote(bold(V[CN10]))
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
} } return (disp) } # Personal theme theme_ash = theme( # White background panel.background=element_rect(fill='white'), # Font text=element_text(family='sans'), # Border of plot panel.border = element_rect(color="grey85", fill=NA, size=0.7), # Grid panel.grid.major.x=element_blank(), panel.grid.major.y=element_blank(), # Ticks marker axis.ticks.x=element_line(color='grey75', size=0.3), axis.ticks.y=element_line(color='grey75', size=0.3), # Ticks label axis.text.x=element_text(color='grey40'), axis.text.y=element_text(color='grey40'), # Ticks length axis.ticks.length=unit(1.5, 'mm'), # Ticks minor ggh4x.axis.ticks.length.minor=rel(0.5), # Title plot.title=element_text(size=9, vjust=-2, hjust=-1E-3, color='grey20'), # Axis title axis.title.x=element_blank(), axis.title.y=element_blank(), # Axis line axis.line.x=element_blank(), axis.line.y=element_blank(), ) time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missRect=FALSE, unit2day=365.25, trend_period=NULL, mean_period=NULL, axis_xlim=NULL, grid=TRUE, last=FALSE, first=FALSE, color=NULL) { # If 'type' is square root apply it to data if (type == 'sqrt(Q)') { df_data_code$Qm3s = sqrt(df_data_code$Qm3s) } # Compute max of flow maxQ = max(df_data_code$Qm3s, na.rm=TRUE) # Get the magnitude of the max of flow power = get_power(maxQ) # Normalize the max flow by it's magnitude maxQtmp = maxQ/10^power # Compute the spacing between y ticks if (maxQtmp >= 5) { dbrk = 1.0 } else if (maxQtmp < 5 & maxQtmp >= 3) { dbrk = 0.5 } else if (maxQtmp < 3 & maxQtmp >= 2) { dbrk = 0.4 } else if (maxQtmp < 2 & maxQtmp >= 1) { dbrk = 0.2 } else if (maxQtmp < 1) { dbrk = 0.1 }
141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210
# Get the spacing in the right magnitude dbrk = dbrk * 10^power # Fix the accuracy for label accuracy = NULL # Time span in the unit of time dDate = as.numeric(df_data_code$Date[length(df_data_code$Date)] - df_data_code$Date[1]) / unit2day # Compute the spacing between x ticks 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 } # Open new plot p = ggplot() + theme_ash # If it is the lats plot of the pages or not if (last) { if (first) { p = p + theme(plot.margin=margin(5, 5, 5, 5, unit="mm")) } else { p = p + theme(plot.margin=margin(0, 5, 5, 5, unit="mm")) } # If it is the first plot of the pages or not } else { if (first) { p = p + theme(plot.margin=margin(5, 5, 0, 5, unit="mm")) } else { p = p + theme(plot.margin=margin(0, 5, 0, 5, unit="mm")) } } ## Sub period background ## if (!is.null(trend_period)) { # trend_period = as.list(trend_period) # Imin = 10^99 # for (per in trend_period) { # I = interval(per[1], per[2]) # if (I < Imin) { # Imin = I # trend_period_min = as.Date(per) # } # } # p = p + # geom_rect(aes(xmin=min(df_data_code$Date), # ymin=0, # xmax=trend_period_min[1], # ymax= maxQ*1.1), # linetype=0, fill='grey97') + # geom_rect(aes(xmin=trend_period_min[2], # ymin=0, # xmax=max(df_data_code$Date), # ymax= maxQ*1.1), # linetype=0, fill='grey97') # Convert trend period to list if it is not
211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280
trend_period = as.list(trend_period) # Fix a disproportionate minimum for period Imin = 10^99 # For all the sub period of analysis in 'trend_period' for (per in trend_period) { # Compute time interval of period I = interval(per[1], per[2]) # If it is the smallest interval if (I < Imin) { # Store it Imin = I # Fix min period of analysis trend_period_min = as.Date(per) } } # Search for the index of the closest existing date # to the start of the min period of analysis idMinPer = which.min(abs(df_data_code$Date - trend_period_min[1])) # Same for the end of the min period of analysis idMaxPer = which.min(abs(df_data_code$Date - trend_period_min[2])) # Get the start and end date associated minPer = df_data_code$Date[idMinPer] maxPer = df_data_code$Date[idMaxPer] # If it is not a flow or sqrt of flow time serie if (type != 'sqrt(Q)' & type != 'Q') { # If there is an 'axis_lim' if (!is.null(axis_xlim)) { # If the temporary start of period is smaller # than the fix start of x axis limit if (minPer < axis_xlim[1]) { # Set the start of the period to the start of # the x axis limit minPer = axis_xlim[1] } } } # If it is not a flow or sqrt of flow time serie if (type != 'sqrt(Q)' & type != 'Q') { # If there is an 'axis_lim' if (!is.null(axis_xlim)) { # If the temporary end of period plus one year # is smaller than the fix end of x axis limit if (maxPer + years(1) < axis_xlim[2]) { # Add one year the the temporary end of period maxPer = maxPer + years(1) } else { # Set the start of the period to the start of # the x axis limit maxPer = axis_xlim[2] } # Add one year the the temporary end of period # if there is no 'axis_lim' } else { maxPer = maxPer + years(1) } } # Draw rectangle to delimiting the sub period p = p + geom_rect(aes(xmin=minPer, ymin=0, xmax=maxPer, ymax= maxQ*1.1), linetype=0, fill='grey97') } ## Mean step ## # If there is a 'mean_period' if (!is.null(mean_period)) {
281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350
# Convert 'mean_period' to list mean_period = as.list(mean_period) # Number of mean period nPeriod_mean = length(mean_period) # Blank tibble to store variable in order to plot # rectangle for mean period plot_mean = tibble() # Blank tibble to store variable in order to plot # upper limit of rectangle for mean period plot_line = tibble() # For all mean period for (j in 1:nPeriod_mean) { # Get the current start and end of the sub period Start_mean = mean_period[[j]][1] End_mean = mean_period[[j]][2] # Extract the data corresponding to this sub period df_data_code_per = df_data_code[df_data_code$Date >= Start_mean & df_data_code$Date <= End_mean,] # Min for the sub period xmin = min(df_data_code_per$Date) # If the min over the sub period is greater # than the min of the entier period and # it is not the first sub period if (xmin > min(df_data_code$Date) & j != 1) { # Substract 6 months to be in the middle of # the previous year xmin = xmin - months(6) } # If it is not a flow or sqrt of flow time serie and # it is the first period if (type != 'sqrt(Q)' & type != 'Q' & j == 1) { # If there is an x axis limit if (!is.null(axis_xlim)) { # If the min of the period is before the x axis min if (xmin < axis_xlim[1]) { # The min for the sub period is the x axis xmin = axis_xlim[1] } } } # Max for the sub period xmax = max(df_data_code_per$Date) # If the max over the sub period is smaller # than the max of the entier period and # it is not the last sub period if (xmax < max(df_data_code$Date) & j != nPeriod_mean) { # Add 6 months to be in the middle of # the following year xmax = xmax + months(6) } # If it is not a flow or sqrt of flow time serie and # it is the last period if (type != 'sqrt(Q)' & type != 'Q' & j == nPeriod_mean) { # If there is an x axis limit if (!is.null(axis_xlim)) { # If the max of the period plus 1 year # is smaller thant the max of the x axis limit if (xmax + years(1) < axis_xlim[2]) { # Add one year to the max to include # the entire last year graphically xmax = xmax + years(1) } else { # The max of this sub period is the max # of the x axis limit xmax = axis_xlim[2] }