Skip to content
GitLab
Select Git revision
  • master default
Find file BlameHistoryPermalink
matrix.R 51.41 KiB
1 
# \\\
2 
# Copyright 2021-2022 Louis Héraut*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/matrix.R
25 
#
26 
# Allows the creation of a summarizing matrix of trend and break analyses
27
28
29 
## 1. MATRIX PANEL ___________________________________________________
30 
# Generates a summarizing matrix of the trend analyses of all station for different hydrological variables and periods. Also shows difference of means between specific periods.
31 
matrix_panel = function (list_df2plot, df_meta, trend_period, mean_period,
32 
                         colorForce=FALSE, slice=NULL, outdirTmp='',
33 
                         outnameTmp='matrix', title=NULL, A3=FALSE,
34 
                         foot_note=FALSE,
35 
                         foot_height=0, resources_path=NULL,
36 
                         logo_dir=NULL,
37 
                         AEAGlogo_file=NULL, INRAElogo_file=NULL,
38 
                         FRlogo_file=NULL, df_page=NULL) {
39
40 
    # Number of variable/plot
41 
    nbp = length(list_df2plot)
42
43 
    # Get all different stations code
44 
    Code = levels(factor(df_meta$code))
45 
    nCode = length(Code)
46
47 
    # Convert 'trend_period' to list
48 
    trend_period = as.list(trend_period)
49 
    # Number of trend period
50 
    nPeriod_trend = length(trend_period)
51
52 
    # Extracts the min and the max of the mean trend for all the station
53 
    res = short_trendExtremes(list_df2plot, Code, nPeriod_trend, nbp, nCode, colorForce)
54 
    minTrendValue = res$min
55 
    maxTrendValue = res$max
56
57 
    # Blank vectors to store info about trend analyses
58 
    Periods_trend = c()
59 
    NPeriod_trend = c()
60 
    Var_trend = c()
61 
    Type_trend = c()
62 
    Code_trend = c()
63 
    Alpha_trend = c()
64 
    TrendValue_trend = c()
65 
    DataMean_trend = c()
66 
    Fill_trend = c()
67 
    Color_trend = c()
68 
    # For all the trend period
69 
    for (j in 1:nPeriod_trend) {
70 
        # For all code
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
for (k in 1:nCode) { # Gets the code code = Code[k] # For all variable for (i in 1:nbp) { # Extracts the data corresponding to the current variable df_data = list_df2plot[[i]]$data # Extracts the trend corresponding to the # current variable df_trend = list_df2plot[[i]]$trend alpha = list_df2plot[[i]]$alpha # Extract the variable of the plot var = list_df2plot[[i]]$var # Extract the type of the variable to plot type = list_df2plot[[i]]$type # Extracts the data corresponding to the code df_data_code = df_data[df_data$code == code,] # Extracts the trend corresponding to the code df_trend_code = df_trend[df_trend$code == code,] # Extract start and end of trend periods Start = df_trend_code$period_start[j] End = df_trend_code$period_end[j] # Creates a period name Periods = paste(Start, End, sep=' / ') # Extracts the corresponding data for the period df_data_code_per = df_data_code[df_data_code$Date >= Start & df_data_code$Date <= End,] # Same for trend df_trend_code_per = df_trend_code[df_trend_code$period_start == Start & df_trend_code$period_end == End,] # Computes the number of trend analysis selected Ntrend = nrow(df_trend_code_per) # If there is more than one trend on the same period if (Ntrend > 1) { # Takes only the first because they are similar df_trend_code_per = df_trend_code_per[1,] } # Computes the mean of the data on the period dataMean = mean(df_data_code_per$Value, na.rm=TRUE) # If it is a flow variable if (type == 'sévérité') { # Normalises the trend value by the mean of the data trendValue = df_trend_code_per$trend / dataMean # If it is a date variable } else if (type == 'saisonnalité') { # Just stocks the trend value trendValue = df_trend_code_per$trend } # Gets the color associated to the averaged trend color_res = get_color(trendValue, minTrendValue[j, i], maxTrendValue[j, i], palette_name='perso', reverse=TRUE) pVal = df_trend_code_per$p # If the p value is under the threshold if (pVal <= alpha){ # Specifies the color fill and contour of
141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210
# table cells fill = color_res color = color_res Alpha = 'TRUE' } else if (pVal > alpha & colorForce) { # Specifies the color fill and contour of # table cells fill = 'white' color = color_res Alpha = 'FORCE' # Otherwise it is not significative } else { fill = 'white' color = 'grey85' Alpha = 'FALSE' } # Stores info needed to plot Periods_trend = append(Periods_trend, Periods) NPeriod_trend = append(NPeriod_trend, j) Var_trend = append(Var_trend, var) Type_trend = append(Type_trend, type) Code_trend = append(Code_trend, code) Alpha_trend = append(Alpha_trend, Alpha) TrendValue_trend = append(TrendValue_trend, trendValue) DataMean_trend = append(DataMean_trend, dataMean) Fill_trend = append(Fill_trend, fill) Color_trend = append(Color_trend, color) } } } # 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) res = short_meanExtremes(list_df2plot, Code, nPeriod_mean, nbp, nCode) minBreakValue = res$min maxBreakValue = res$max } else { nPeriod_mean = 1 } # If there is a 'mean_period' if (!is.null(mean_period)) { # Blank vectors to store info about breaking analysis Periods_mean = c() NPeriod_mean = c() Var_mean = c() Type_mean = c() Code_mean = c() DataMean_mean = c() breakValue_mean = c() # Blank array to store mean for a temporary period in order # to compute the difference of mean with a second period dataMeantmp = array(rep(NA, nbp*nCode), dim=c(nbp, nCode)) # For all period of breaking analysis for (j in 1:nPeriod_mean) { # For all the code for (k in 1:nCode) { # Gets the code code = Code[k] # For all variable
211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280
for (i in 1:nbp) { # Extracts the data corresponding to # the current variable df_data = list_df2plot[[i]]$data # Extract the variable of the plot var = list_df2plot[[i]]$var # Extract the type of the variable to plot type = list_df2plot[[i]]$type # Extracts the data corresponding to the code df_data_code = df_data[df_data$code == code,] # 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 max for the sub period Datemin = min(df_data_code_per$Date) Datemax = max(df_data_code_per$Date) # Creates a period name Periods = paste(Datemin, Datemax, sep=' / ') # Mean of the flow over the sub period dataMean = mean(df_data_code_per$Value, na.rm=TRUE) # If this in not the first period if (j > 1) { # Compute the difference of mean Break = dataMean - dataMeantmp[i, k] # Otherwise for the first period } else { # Stocks NA Break = NA } # If it is a flow variable if (type == 'sévérité') { # Normalises the break by the mean of the # initial period breakValue = Break / dataMeantmp[i, k] # If it is a date variable } else if (type == 'saisonnalité') { # Just stocks the break value breakValue = Break } # Stores temporarily the mean of the current period dataMeantmp[i, k] = dataMean # Stores info needed to plot Periods_mean = append(Periods_mean, Periods) NPeriod_mean = append(NPeriod_mean, j) Var_mean = append(Var_mean, var) Type_mean = append(Type_mean, type) Code_mean = append(Code_mean, code) DataMean_mean = append(DataMean_mean, dataMean) breakValue_mean = append(breakValue_mean, breakValue) } } } # Blanks vector to store color info Fill_mean = c()
281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350
Color_mean = c() # Index to count over all break computed ii = 1 for (j in 1:nPeriod_mean) { # For all the code for (k in 1:nCode) { # Gets the code code = Code[k] # For all variable for (i in 1:nbp) { # Extracts averaged breaking breakValue = breakValue_mean[ii] # Gets the color associated color_res = get_color(breakValue, minBreakValue[j, i], maxBreakValue[j, i], palette_name='perso', reverse=TRUE) # Gets the fill and contour color fill = color_res color = 'white' # Stores it Fill_mean = append(Fill_mean, fill) Color_mean = append(Color_mean, color) # Passes to the next index ii = ii + 1 } } } } # If the slice option is not specified, the info for all # stations will be draw on the same page if (is.null(slice)) { slice = nCode } allType = c() for (i in 1:nbp) { allType = c(allType, list_df2plot[[i]]$type) } countType = rle(sort(allType)) df_countType = tibble(type=countType$values, n=countType$lengths) nbpMax = max(df_countType$n) # Gets all the different type of plots Type = levels(factor(allType)) nbType = length(Type) # Number of pages N_loop = 0 # For all the type of plots for (itype in 1:nbType) { # Gets the type type = Type[itype] # Extracts each possibilities of hydrological region RH = rle(sort(df_meta$region_hydro))$values twoL = names(df_meta$region_hydro) # Number of different first letters nRH = length(RH) # For all the available first letter for (iR in 1:nRH) { # Gets the first letter rh = RH[iR] okL = rle(sort(twoL[df_meta$region_hydro == rh]))$values nL = nchar(okL[1]) # Get only station code with the same first letter subCodeRh = Code[substr(Code, 1, nL) %in% okL] # Counts the number of station in it
351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420
nsubCodeRh = length(subCodeRh) # Computes the number of pages needed to plot # all stations nMat = as.integer(nsubCodeRh/slice) + 1 # Counts the number of pages N_loop = N_loop + nMat } } # For all the type of plots for (itype in 1:nbType) { # Gets the type type = Type[itype] # Extracts each possibilities of hydrological region RH = rle(sort(df_meta$region_hydro))$values twoL = names(df_meta$region_hydro) # Number of different first letters nRH = length(RH) # For all the available first letter for (iR in 1:nRH) { # Gets the first letter rh = RH[iR] okL = rle(sort(twoL[df_meta$region_hydro == rh]))$values nL = nchar(okL[1]) # Get only station code with the same first letter subCodeRh = Code[substr(Code, 1, nL) %in% okL] # Counts the number of station in it nsubCodeRh = length(subCodeRh) # Computes the number of pages needed to # plot all stations nMat = as.integer(nsubCodeRh/slice) + 1 # For all the pages for (iMat in 1:nMat) { n_loop = iR + nRH*(itype-1) + (iMat-1) # Print the matrix name print(paste('Matrix ', iMat, '/', nMat, ' of ', type, ' for region : ', rh, " (", round(n_loop / N_loop * 100, 0), " %)", sep='')) # Extracts the station for the current page subCode = subCodeRh[(slice*(iMat-1)+1):(slice*iMat)] # Removes NA stations subCode = subCode[!is.na(subCode)] # Reverses verticale order of stations subCode = rev(subCode) # Gets the number of station for the page nsubCode = length(subCode) # Creates logical vector to select only info about # stations that will be plot on the page CodeRh_trend = Code_trend %in% subCode & Type_trend == type # Extracts those info subPeriods_trend = Periods_trend[CodeRh_trend] subNPeriod_trend = NPeriod_trend[CodeRh_trend] subVar_trend = Var_trend[CodeRh_trend] subType_trend = Type_trend[CodeRh_trend] subCode_trend = Code_trend[CodeRh_trend] subAlpha_trend = Alpha_trend[CodeRh_trend] subTrendValue_trend = TrendValue_trend[CodeRh_trend] subDataMean_trend = DataMean_trend[CodeRh_trend] subFill_trend = Fill_trend[CodeRh_trend] subColor_trend = Color_trend[CodeRh_trend] # Same for breaking analysis