shortcut.R 6.7 KB
Newer Older
Heraut Louis's avatar
Heraut Louis committed
# \\\
# 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)
}