# \\\ # Copyright 2021-2022 Louis Héraut*1 # # *1 INRAE, France # louis.heraut@inrae.fr # # This file is part of ash R toolbox. # # ash R toolbox is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or (at # your option) any later version. # # ash R toolbox is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with ash R toolbox. If not, see <https://www.gnu.org/licenses/>. # /// # # # shortcut.R short_nPeriodMax = function (list_df2plot, Code) { # Gets a trend example df_trend = list_df2plot[[1]]$trend # Convert 'trend_period' to list trend_period = as.list(trend_period) # Number of trend period nPeriod_trend = length(trend_period) # Fix the maximal number of period to the minimal possible nPeriodMax = 0 # For all code for (code in 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 End = df_trend_code$period_end # Get the name of the different period UStart = levels(factor(Start)) UEnd = levels(factor(End)) # Compute the max of different start and end # so the number of different period nPeriod = max(length(UStart), length(UEnd)) # If the number of period for the trend is greater # than the current max period, stocks it if (nPeriod > nPeriodMax) { nPeriodMax = nPeriod } } res = list(npt=nPeriod_trend, npM=nPeriodMax) return (res) } short_tab = function (list_df2plot, Code, nbp, nCode, nPeriod_max) { # Blank array to store time info tab_Start = array(rep('', nCode*nbp*nPeriod_max), dim=c(nCode, nbp, nPeriod_max)) tab_End = array(rep('', nCode*nbp*nPeriod_max), dim=c(nCode, nbp, nPeriod_max)) # For all code for (k in 1:nCode) { # Gets the code code = Code[k] # For all the variable for (i in 1:nbp) { df_trend = list_df2plot[[i]]$trend # 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 End = df_trend_code$period_end # Get the name of the different period UStart = levels(factor(Start)) UEnd = levels(factor(End)) # Compute the max of different start and end # so the number of different period nPeriod = max(length(UStart), length(UEnd)) # For all the period for (j in 1:nPeriod_max) { # Saves the time info tab_Start[k, i, j] = as.character(Start[j]) tab_End[k, i, j] = as.character(End[j]) } } } res = list(start=tab_Start, end=tab_End) return (res) } short_trendExtremes = function (list_df2plot, tab_Start, tab_End, Code, nPeriod_trend, nbp, nCode, nPeriod_max) { # Blank array to store mean of the trend for each # station, perdiod and variable TrendValue_code = array(rep(1, nPeriod_trend*nbp*nCode), dim=c(nPeriod_trend, nbp, nCode)) # For all the period for (j in 1:nPeriod_max) { # For all the code for (k in 1:nCode) { # Gets the code code = Code[k] 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 # Extracts the type of the variable type = list_df2plot[[i]]$type alpha = list_df2plot[[i]]$alpha # Extracts the data corresponding to the code df_data_code = df_data[df_data$code == code,] df_trend_code = df_trend[df_trend$code == code,] # Gets the associated time info Start = tab_Start[k, i, j] End = tab_End[k, i, j] # 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,] } # If it is a flow variable if (type == 'sévérité') { # Computes the mean of the data on the period dataMean = mean(df_data_code_per$Value, na.rm=TRUE) # 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é') { trendValue = df_trend_code_per$trend } # If the p value is under the threshold if (df_trend_code_per$p <= alpha) { # Stores the mean trend TrendValue_code[j, i, k] = trendValue # Otherwise } else { # Do not stocks it TrendValue_code[j, i, k] = NA } } } } # Compute the min and the max of the mean trend for all the station minTrendValue = apply(TrendValue_code, c(1, 2), min, na.rm=TRUE) maxTrendValue = apply(TrendValue_code, c(1, 2), max, na.rm=TRUE) res = list(min=minTrendValue, max=maxTrendValue) return (res) }