Skip to content
GitLab
Select Git revision
  • master default
Find file BlameHistoryPermalink
time.R 33.82 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/datasheet.R
25 
#
26 
#
27
28
29 
time_panel = function (list_df2plot, df_meta, trend_period, info_header, time_header, layout_matrix, info_ratio, time_ratio, var_ratio, outdirTmp) {
30
31
32 
    # Number of type/variable
33 
    nbp = length(list_df2plot)
34
35 
    # Get all different stations code
36 
    Code = levels(factor(df_meta$code))
37 
    nCode = length(Code)
38
39
40 
    df_trend = list_df2plot[[1]]$trend
41
42 
    # Convert 'trend_period' to list
43 
    trend_period = as.list(trend_period)
44 
    # Number of trend period
45 
    nPeriod_trend = length(trend_period)
46
47 
    nPeriod_max = 0
48 
    for (code in Code) {
49
50 
        df_trend_code = df_trend[df_trend$code == code,]
51
52 
        Start = df_trend_code$period_start
53 
        UStart = levels(factor(Start))
54
55 
        End = df_trend_code$period_end
56 
        UEnd = levels(factor(End))
57
58 
        nPeriod = max(length(UStart), length(UEnd))
59
60 
        if (nPeriod > nPeriod_max) {
61 
            nPeriod_max = nPeriod
62 
        }
63 
    }
64
65
66 
    Start_code = vector(mode='list', length=nCode)
67 
    End_code = vector(mode='list', length=nCode)
68 
    Code_code = vector(mode='list', length=nCode)
69 
    Periods_code = vector(mode='list', length=nCode)
70
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
for (j in 1:nCode) { code = Code[j] df_trend_code = df_trend[df_trend$code == code,] Start = df_trend_code$period_start UStart = levels(factor(Start)) End = df_trend_code$period_end UEnd = levels(factor(End)) nPeriod = max(length(UStart), length(UEnd)) Periods = c() for (i in 1:nPeriod_trend) { Periods = append(Periods, paste(Start[i], End[i], sep=' / ')) } Start_code[[j]] = Start End_code[[j]] = End Code_code[[j]] = code Periods_code[[j]] = Periods } TrendMean_code = array(rep(1, nPeriod_trend*nbp*nCode), dim=c(nPeriod_trend, nbp, nCode)) for (j in 1:nPeriod_max) { for (k in 1:nCode) { code = Code[k] for (i in 1:nbp) { df_data = list_df2plot[[i]]$data df_trend = list_df2plot[[i]]$trend p_threshold = list_df2plot[[i]]$p_threshold df_data_code = df_data[df_data$code == code,] df_trend_code = df_trend[df_trend$code == code,] Start = Start_code[Code_code == code][[1]][j] End = End_code[Code_code == code][[1]][j] Periods = Periods_code[Code_code == code][[1]][j] df_data_code_per = df_data_code[df_data_code$Date >= Start & df_data_code$Date <= End,] df_trend_code_per = df_trend_code[df_trend_code$period_start == Start & df_trend_code$period_end == End,] Ntrend = nrow(df_trend_code_per) if (Ntrend > 1) { df_trend_code_per = df_trend_code_per[1,] } dataMean = mean(df_data_code_per$Qm3s, na.rm=TRUE) trendMean = df_trend_code_per$trend / dataMean if (df_trend_code_per$p <= p_threshold){ TrendMean_code[j, i, k] = trendMean
141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210
} else { TrendMean_code[j, i, k] = NA } } } } minTrendMean = apply(TrendMean_code, c(1, 2), min, na.rm=TRUE) maxTrendMean = apply(TrendMean_code, c(1, 2), max, na.rm=TRUE) for (code in Code) { # Print code of the station for the current plotting print(paste("Datasheet for station :", code)) nbh = as.numeric(info_header) + as.numeric(!is.null(time_header)) nbg = nbp + nbh P = vector(mode='list', length=nbg) if (info_header) { time_header_code = time_header[time_header$code == code,] Hinfo = info_panel(list_df2plot, df_meta, df_shapefile=df_shapefile, codeLight=code, df_data_code=time_header_code) P[[1]] = Hinfo # P[[1]] = void } if (!is.null(time_header)) { time_header_code = time_header[time_header$code == code,] axis_xlim = c(min(time_header_code$Date), max(time_header_code$Date)) Htime = time_panel_alone(time_header_code, df_trend_code=NULL, trend_period=trend_period, missRect=TRUE, unit2day=365.25, type='Q', grid=TRUE, first=FALSE) P[[2]] = Htime } # map = map_panel() 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 df_data_code = df_data[df_data$code == code,] df_trend_code = df_trend[df_trend$code == code,] color = c() # for (j in 1:nrow(df_trend_code)) { grey = 85 for (j in 1:nPeriod_max) { if (df_trend_code$p[j] <= p_threshold){ # color_res = get_color(df_trend_code$trend[j], # minTrend[i], # maxTrend[i], # palette_name='perso', # reverse=TRUE)
211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280
Start = Start_code[Code_code == code][[1]][j] End = End_code[Code_code == code][[1]][j] Periods = Periods_code[Code_code == code][[1]][j] df_data_code_per = df_data_code[df_data_code$Date >= Start & df_data_code$Date <= End,] df_trend_code_per = df_trend_code[df_trend_code$period_start == Start & df_trend_code$period_end == End,] Ntrend = nrow(df_trend_code_per) if (Ntrend > 1) { df_trend_code_per = df_trend_code_per[1,] } dataMean = mean(df_data_code$Qm3s, na.rm=TRUE) trendMean = df_trend_code_per$trend / dataMean color_res = get_color(trendMean, minTrendMean[j, i], maxTrendMean[j, i], palette_name='perso', reverse=TRUE) colortmp = color_res } else { colortmp = paste('grey', grey, sep='') grey = grey - 10 } color = append(color, colortmp) } p = time_panel_alone(df_data_code, df_trend_code, type=type, p_threshold=p_threshold, missRect=missRect, trend_period=trend_period, mean_period=mean_period, axis_xlim=axis_xlim, unit2day=unit2day, grid=FALSE, last=(i > nbp-nbcol), color=color) 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 info_ratio_scale = info_ratio time_ratio_scale = time_ratio var_ratio_scale = var_ratio ndec_info = 0 ndec_time = 0 ndec_var = 0 if (info_ratio_scale != round(info_ratio_scale)) { ndec_info = nchar(gsub('^[0-9]+.', '', as.character(info_ratio_scale))) }
281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350
if (time_ratio_scale != round(time_ratio_scale)) { ndec_time = nchar(gsub('^[0-9]+.', '', as.character(time_ratio_scale))) } if (var_ratio_scale != round(var_ratio_scale)) { ndec_var = nchar(gsub('^[0-9]+.', '', as.character(var_ratio_scale))) } ndec = max(c(ndec_info, ndec_time, ndec_var)) info_ratio_scale = info_ratio_scale * 10^ndec time_ratio_scale = time_ratio_scale * 10^ndec var_ratio_scale = var_ratio_scale * 10^ndec LM = c() LMcol = ncol(layout_matrix_H) LMrow = nrow(layout_matrix_H) for (i in 1:(LMrow+nbh)) { if (info_header & i == 1) { # LM = rbind(LM, rep(i, times=LMcol)) LM = rbind(LM, matrix(rep(rep(i, times=LMcol), times=info_ratio_scale), ncol=LMcol, byrow=TRUE)) } else if (!is.null(time_header) & i == 2) { LM = rbind(LM, matrix(rep(rep(i, times=LMcol), times=time_ratio_scale), ncol=LMcol, byrow=TRUE)) } else { LM = rbind(LM, matrix(rep(layout_matrix_H[i-nbh,], times=var_ratio_scale), 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) } } time_panel_alone = 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
351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420
# 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 } # 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 +
421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490
# 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 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) } }
491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560
# 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)) { # 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) {
561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630
# 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] } # If there is no axis limit } else { # Add one year to the max to include # the entire last year graphically xmax = xmax + years(1) } } # Mean of the flow over the sub period ymax = mean(df_data_code_per$Qm3s, na.rm=TRUE) # Create temporary tibble with variable # to create rectangle for mean step plot_meantmp = tibble(xmin=xmin, xmax=xmax, ymin=0, ymax=ymax, period=j) # Bind it to the main tibble to store it with other period plot_mean = bind_rows(plot_mean, plot_meantmp) # Create vector for the upper limit of the rectangle abs = c(xmin, xmax) ord = c(ymax, ymax) # Create temporary tibble with variable # to create upper limit for rectangle plot_linetmp = tibble(abs=abs, ord=ord, period=j) # Bind it to the main tibble to store it with other period plot_line = bind_rows(plot_line, plot_linetmp) } # Plot rectangles p = p + geom_rect(data=plot_mean, aes(xmin=xmin, ymin=ymin, xmax=xmax, ymax=ymax), linetype=0, fill='grey93') # Plot upper line for rectangle p = p + geom_line(data=plot_line, aes(x=abs, y=ord, group=period), color='grey85', size=0.15) # for all the sub periods except the last one for (i in 1:(nPeriod_mean-1)) { # The y limit of rectangle is the max of # the two neighboring mean step rectangle yLim = max(c(plot_mean$ymax[i], plot_mean$ymax[i+1])) # The x limit is the x max of the ith rectangle xLim = plot_mean$xmax[i] # Make a tibble to store data plot_lim = tibble(x=c(xLim, xLim), y=c(0, yLim)) # Plot the limit of rectangles p = p + geom_line(data=plot_lim, aes(x=x, y=y), linetype='dashed', size=0.15, color='grey85') } }
631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700
### Grid ### if (grid) { # If there is no axis limit if (is.null(axis_xlim)) { # The min and the max is set by # the min and the max of the date data xmin = min(df_data_code$Date) xmax = max(df_data_code$Date) } else { # Min and max is set with the limit axis parameter xmin = axis_xlim[1] xmax = axis_xlim[2] } # Create a vector for all the y grid position ygrid = seq(0, maxQ*10, dbrk) # Blank vector to store position ord = c() abs = c() # For all the grid element for (i in 1:length(ygrid)) { # Store grid position ord = c(ord, rep(ygrid[i], times=2)) abs = c(abs, xmin, xmax) } # Create a tibble to store all the position plot_grid = tibble(abs=as.Date(abs), ord=ord) # Plot the y grid p = p + geom_line(data=plot_grid, aes(x=abs, y=ord, group=ord), color='grey85', size=0.15) } ### Data ### # If it is a square root flow or flow if (type == 'sqrt(Q)' | type == 'Q') { # Plot the data as line p = p + geom_line(aes(x=df_data_code$Date, y=df_data_code$Qm3s), color='grey20', size=0.3, lineend="round") } else { # Plot the data as point p = p + geom_point(aes(x=df_data_code$Date, y=df_data_code$Qm3s), shape=21, color='grey50', fill='grey97', size=1) } ### Missing data ### # If the option is TRUE if (missRect) { # Remove NA data NAdate = df_data_code$Date[is.na(df_data_code$Qm3s)] # Get the difference between each point of date data without NA dNAdate = diff(NAdate) # If difference of day is not 1 then # it is TRUE for the beginning of each missing data period NAdate_Down = NAdate[append(Inf, dNAdate) != 1] # If difference of day is not 1 then # it is TRUE for the ending of each missing data period NAdate_Up = NAdate[append(dNAdate, Inf) != 1] # Plot the missing data period p = p + geom_rect(aes(xmin=NAdate_Down, ymin=0, xmax=NAdate_Up, ymax=maxQ*1.1),
701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770
linetype=0, fill='Wheat', alpha=0.4) } ### Trend ### # If there is trends if (!is.null(df_trend_code)) { # Extract starting period of trends Start = df_trend_code$period_start # Get the name of the different period UStart = levels(factor(Start)) # Same for ending End = df_trend_code$period_end UEnd = levels(factor(End)) # Compute the max of different start and end # so the number of different period nPeriod_trend = max(length(UStart), length(UEnd)) # Blank tibble to store trend data and legend data plot_trend = tibble() leg_trend = tibble() # For all the different period for (i in 1:nPeriod_trend) { # Get the trend associated to the first period df_trend_code_per = df_trend_code[df_trend_code$period_start == Start[i] & df_trend_code$period_end == End[i],] # Number of trend selected Ntrend = nrow(df_trend_code_per) # If the number of trend is greater than a unique one if (Ntrend > 1) { # Extract only the first hence it is the same period df_trend_code_per = df_trend_code_per[1,] } # Search for the index of the closest existing date # to the start of the trend period of analysis iStart = which.min(abs(df_data_code$Date - Start[i])) # Same for the end iEnd = which.min(abs(df_data_code$Date - End[i])) # Get the start and end date associated xmin = df_data_code$Date[iStart] xmax = df_data_code$Date[iEnd] # If there is a x axis limit if (!is.null(axis_xlim)) { # If the min of the current period # is smaller than the min of the x axis limit if (xmin < axis_xlim[1]) { # The min of the period is the min # of the x axis limit xmin = axis_xlim[1] } # Same for end if (xmax > axis_xlim[2]) { xmax = axis_xlim[2] } } # Create vector to store x data abs = c(xmin, xmax) # Convert the number of day to the unit of the period abs_num = as.numeric(abs) / unit2day # Compute the y of the trend ord = abs_num * df_trend_code_per$trend + df_trend_code_per$intercept
771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840
# Create temporary tibble with variable to plot trend # for each period plot_trendtmp = tibble(abs=abs, ord=ord, period=i) # Bind it to the main tibble to store it with other period plot_trend = bind_rows(plot_trend, plot_trendtmp) # If there is a x axis limit if (!is.null(axis_xlim)) { # The x axis limit is selected codeDate = axis_xlim } else { # The entire date data is selected codeDate = df_data_code$Date } # The flow data is extract codeQ = df_data_code$Qm3s # Position of the x beginning and end of the legend symbol x = gpct(2, codeDate, shift=TRUE) xend = x + gpct(3, codeDate) # Position of the y beginning and end of the legend symbol dy = gpct(7, codeQ, ref=0) y = gpct(100, codeQ, ref=0) - (i-1)*dy yend = y # Position of x for the beginning of the associated text xt = xend + gpct(1, codeDate) # Position of the background rectangle of the legend xminR = x - gpct(1, codeDate) yminR = y - gpct(4, codeQ, ref=0) xmaxR = x + gpct(24, codeDate) ymaxR = y + gpct(5, codeQ, ref=0) # Get the tendance analyse trend = df_trend_code_per$trend # Compute the magnitude of the trend power = get_power(trend) # Convert it to character powerC = as.character(power) # Get the power of ten of magnitude brk = 10^power # Convert trend to character for sientific expression trendC = as.character(round(trend / brk, 2)) # Create temporary tibble with variable to plot legend leg_trendtmp = tibble(x=x, xend=xend, y=y, yend=yend, xt=xt, trendC=trendC, powerC=powerC, xminR=xminR, yminR=yminR, xmaxR=xmaxR, ymaxR=ymaxR, period=i) # Bind it to the main tibble to store it with other period leg_trend = bind_rows(leg_trend, leg_trendtmp) } # For all periods for (i in 1:nPeriod_trend) { # Extract the trend of the current sub period leg_trend_per = leg_trend[leg_trend$period == i,] # Plot the background for legend p = p + geom_rect(data=leg_trend_per, aes(xmin=xminR, ymin=yminR,
841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910
xmax=xmaxR, ymax=ymaxR), linetype=0, fill='white', alpha=0.5) } # For all periods for (i in 1:nPeriod_trend) { # Extract the trend of the current sub period leg_trend_per = leg_trend[leg_trend$period == i,] # Get the character variable for naming the trend trendC = leg_trend_per$trendC powerC = leg_trend_per$powerC # Create the name of the trend label = bquote(bold(.(trendC)~'x'~'10'^{.(powerC)})~'['*m^{3}*'.'*s^{-1}*'.'*an^{-1}*']') # Plot the trend symbole and value of the legend p = p + annotate("segment", x=leg_trend_per$x, xend=leg_trend_per$xend, y=leg_trend_per$y, yend=leg_trend_per$yend, color=color[i], linetype='solid', lwd=1) + annotate("text", label=label, size=3, x=leg_trend_per$xt, y=leg_trend_per$y, hjust=0, vjust=0.4, color=color[i]) } # For all periods for (i in 1:nPeriod_trend) { # Extract the trend of the current sub period plot_trend_per = plot_trend[plot_trend$period == i,] # Plot the line of white background of each trend p = p + geom_line(data=plot_trend_per, aes(x=abs, y=ord), color='white', linetype='solid', size=1.5, lineend="round") } # For all periods for (i in 1:nPeriod_trend) { # Extract the trend of the current sub period plot_trend_per = plot_trend[plot_trend$period == i,] # Plot the line of trend p = p + geom_line(data=plot_trend_per, aes(x=abs, y=ord), color=color[i], linetype='solid', size=0.75, lineend="round") } } # Title p = p + ggtitle(bquote(bold(.(type))~~'['*m^{3}*'.'*s^{-1}*']')) # If the is no x axis limit if (is.null(axis_xlim)) {
911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950
# Parameters of the x axis contain the limit of the date data p = p + scale_x_date(date_breaks=paste( as.character(datebreak), 'year', 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)), expand=c(0, 0)) } else { # Parameters of the x axis contain the x axis limit p = p + scale_x_date(date_breaks=paste( as.character(datebreak), 'year', sep=' '), date_minor_breaks=paste( as.character(dateminbreak), 'year', sep=' '), guide='axis_minor', date_labels="%Y", limits=axis_xlim, expand=c(0, 0)) } # Parameters of the y axis p = p + scale_y_continuous(breaks=seq(0, maxQ*10, dbrk), limits=c(0, maxQ*1.1), expand=c(0, 0), labels=label_number(accuracy=accuracy)) return(p) }