analyse.R 27.7 KB
Newer Older
Heraut Louis's avatar
Heraut Louis committed
# \\\
Heraut Louis's avatar
Heraut Louis committed
# Copyright 2021-2022 Louis Héraut*1
Heraut Louis's avatar
Heraut Louis committed
#
# *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/>.
# ///
#
#
# processing/analyse.R
#
# File that realise all the possible analysis of data.
# This file regroup mainly the functions use to compute the trend
# analysis of hydrologic variables thanks to the Mann-Kendall Test.
# Functions needed for break or gap analysis are also present.


# Usefull library
library(dplyr)
library(zoo)
library(StatsAnalysisTrend)
Heraut Louis's avatar
Heraut Louis committed
library(lubridate)
library(trend)
Heraut Louis's avatar
Heraut Louis committed

# Sourcing R file
Heraut Louis's avatar
Heraut Louis committed
source('processing/format.R', encoding='latin1')
Heraut Louis's avatar
Heraut Louis committed
## 1. TREND ANALYSIS
### 1.0. Intercept of trend
Heraut Louis's avatar
Heraut Louis committed
# Compute intercept values of linear trends with first order values
# of trends and the data on which analysis is performed.
get_intercept = function (df_Xtrend, df_Xlist, unit2day=365.25) {
Heraut Louis's avatar
Heraut Louis committed

    # Create a column in trend full of NA
Heraut Louis's avatar
Heraut Louis committed
    df_Xtrend$intercept = NA
Heraut Louis's avatar
Heraut Louis committed
    # For all different group
    for (g in df_Xlist$info$group) {
Heraut Louis's avatar
Heraut Louis committed
        # Get the data and trend value linked to this group
        df_data_code = df_Xlist$data[df_Xlist$data$group == g,]
Heraut Louis's avatar
Heraut Louis committed
        df_Xtrend_code = df_Xtrend[df_Xtrend$group == g,]

Heraut Louis's avatar
Heraut Louis committed
        # Get the time start and end of the different periods
Heraut Louis's avatar
Heraut Louis committed
        Start = df_Xtrend_code$period_start
        End = df_Xtrend_code$period_end
Heraut Louis's avatar
Heraut Louis committed
        # Extract only the unrepeated dates
        UStart = levels(factor(Start))
Heraut Louis's avatar
Heraut Louis committed
        UEnd = levels(factor(End))
Heraut Louis's avatar
Heraut Louis committed
        # Get the number of different periods of trend analysis
Heraut Louis's avatar
Heraut Louis committed
        nPeriod = max(length(UStart), length(UEnd))

Heraut Louis's avatar
Heraut Louis committed
        # For each of these perdiods
Heraut Louis's avatar
Heraut Louis committed
        for (i in 1:nPeriod) {
Heraut Louis's avatar
Heraut Louis committed
            # Get data and trend associated to the period
Heraut Louis's avatar
Heraut Louis committed
            df_data_code_per = 
                df_data_code[df_data_code$Date >= Start[i] 
                             & df_data_code$Date <= End[i],]
            df_Xtrend_code_per = 
                df_Xtrend_code[df_Xtrend_code$period_start == Start[i] 
                              & df_Xtrend_code$period_end == End[i],]
Heraut Louis's avatar
Heraut Louis committed

            # Get the group associated to this period
Heraut Louis's avatar
Heraut Louis committed
            id = which(df_Xtrend$group == g 
                       & df_Xtrend$period_start == Start[i] 
                       & df_Xtrend$period_end == End[i])

Heraut Louis's avatar
Heraut Louis committed
            # Compute mean of flow and time period
Heraut Louis's avatar
Heraut Louis committed
            mu_X = mean(df_data_code_per$Value, na.rm=TRUE)
Heraut Louis's avatar
Heraut Louis committed
            mu_t = as.numeric(mean(c(Start[i],
                                     End[i]),
                                   na.rm=TRUE)) / unit2day
Heraut Louis's avatar
Heraut Louis committed

            # Get the intercept of the trend
Heraut Louis's avatar
Heraut Louis committed
            b = mu_X - mu_t * df_Xtrend_code_per$trend
Heraut Louis's avatar
Heraut Louis committed
            # And store it
Heraut Louis's avatar
Heraut Louis committed
            df_Xtrend$intercept[id] = b
        } 
    }
    return (df_Xtrend)
}

Heraut Louis's avatar
Heraut Louis committed
### 1.1. QA
Heraut Louis's avatar
Heraut Louis committed
# Realise the trend analysis of the average annual flow (QA)
# hydrological variable
Heraut Louis's avatar
Heraut Louis committed
get_QAtrend = function (df_data, df_meta, period, alpha, yearLac_day) {
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
    # Removes incomplete data from time series
Heraut Louis's avatar
Heraut Louis committed
    df_data = missing_data(df_data, df_meta,
                           yearLac_day=yearLac_day,
                           yearStart='01-01')
Heraut Louis's avatar
Heraut Louis committed
    # Make sure to convert the period to a list
Heraut Louis's avatar
Heraut Louis committed
    period = as.list(period)
Heraut Louis's avatar
Heraut Louis committed

    # Set the max interval period as the minimal possible
Heraut Louis's avatar
Heraut Louis committed
    Imax = 0
Heraut Louis's avatar
Heraut Louis committed
    # Blank tibble for data to return
Heraut Louis's avatar
Heraut Louis committed
    df_QAtrendB = tibble()

Heraut Louis's avatar
Heraut Louis committed
    # For all periods
Heraut Louis's avatar
Heraut Louis committed
    for (per in period) {
Heraut Louis's avatar
Heraut Louis committed
        # Prepare the data to fit the entry of extract.Var
Heraut Louis's avatar
Heraut Louis committed
        df_QAlist = prepare(df_data, colnamegroup=c('code'))

Heraut Louis's avatar
Heraut Louis committed
        # Compute the yearly mean over the data
Heraut Louis's avatar
Heraut Louis committed
        df_QAEx = extract.Var(data.station=df_QAlist,
                              funct=mean,
                              timestep='year',
                              period=per,
                              pos.datetime=1,
                              na.rm=TRUE)
Heraut Louis's avatar
Heraut Louis committed
        # Compute the trend analysis
Heraut Louis's avatar
Heraut Louis committed
        df_QAtrend = Estimate.stats(data.extract=df_QAEx,
Heraut Louis's avatar
Heraut Louis committed
                                      level=alpha)
Heraut Louis's avatar
Heraut Louis committed
        # Get the associated time interval
Heraut Louis's avatar
Heraut Louis committed
        I = interval(per[1], per[2])
Heraut Louis's avatar
Heraut Louis committed
        # If it is the largest interval
Heraut Louis's avatar
Heraut Louis committed
        if (I > Imax) {
Heraut Louis's avatar
Heraut Louis committed
            # Store it and the associated data and info
Heraut Louis's avatar
Heraut Louis committed
            Imax = I
            df_QAlistB = df_QAlist
            df_QAExB = df_QAEx
        }

Heraut Louis's avatar
Heraut Louis committed
        # Specify the period of analyse
Heraut Louis's avatar
Heraut Louis committed
        df_QAtrend = get_period(per, df_QAtrend, df_QAEx, df_QAlist)
Heraut Louis's avatar
Heraut Louis committed
        # Store the trend
        df_QAtrendB = bind_rows(df_QAtrendB, df_QAtrend)   
Heraut Louis's avatar
Heraut Louis committed
    } 
Heraut Louis's avatar
Heraut Louis committed
    # Clean results of trend analyse
Heraut Louis's avatar
Heraut Louis committed
    res_QAtrend = clean(df_QAtrendB, df_QAExB, df_QAlistB)
    return (res_QAtrend)
}

Heraut Louis's avatar
Heraut Louis committed
### 1.2. QMNA
Heraut Louis's avatar
Heraut Louis committed
# Realise the trend analysis of the monthly minimum flow in the
# year (QMNA) hydrological variable
Heraut Louis's avatar
Heraut Louis committed
get_QMNAtrend = function (df_data, df_meta, period, alpha, sampleSpan, yearLac_day) {
Heraut Louis's avatar
Heraut Louis committed

    # Removes incomplete data from time series
Heraut Louis's avatar
Heraut Louis committed
    df_data = missing_data(df_data, df_meta,
                           yearLac_day=yearLac_day, yearStart='01-01')
Heraut Louis's avatar
Heraut Louis committed
    # Samples the data
    df_data = sampling_data(df_data, df_meta,
                            sampleSpan=sampleSpan)
Heraut Louis's avatar
Heraut Louis committed
    # Make sure to convert the period to a list
Heraut Louis's avatar
Heraut Louis committed
    period = as.list(period)
    
Heraut Louis's avatar
Heraut Louis committed
    # Set the max interval period as the minimal possible
Heraut Louis's avatar
Heraut Louis committed
    Imax = 0
Heraut Louis's avatar
Heraut Louis committed
    # Blank tibble for data to return
Heraut Louis's avatar
Heraut Louis committed
    df_QMNAtrendB = tibble()

Heraut Louis's avatar
Heraut Louis committed
    # For all periods
Heraut Louis's avatar
Heraut Louis committed
    for (per in period) {
Heraut Louis's avatar
Heraut Louis committed
        # Prepare the data to fit the entry of extract.Var
Heraut Louis's avatar
Heraut Louis committed
        df_QMNAlist = prepare(df_data, colnamegroup=c('code'))
Heraut Louis's avatar
Heraut Louis committed
        # Compute the montly mean over the data
Heraut Louis's avatar
Heraut Louis committed
        df_QMNAEx = extract.Var(data.station=df_QMNAlist,
                                funct=mean,
                                period=per,
Heraut Louis's avatar
Heraut Louis committed
                                timestep='year-month',
                                per.start="01",
Heraut Louis's avatar
Heraut Louis committed
                                pos.datetime=1,
                                na.rm=TRUE)
Heraut Louis's avatar
Heraut Louis committed
        # Rerepare the data to fit the entry of extract.Var
Heraut Louis's avatar
Heraut Louis committed
        df_QMNAlist = reprepare(df_QMNAEx,
                                df_QMNAlist,
                                colnamegroup=c('code'))
Heraut Louis's avatar
Heraut Louis committed
        # Compute the yearly min over the data
Heraut Louis's avatar
Heraut Louis committed
        df_QMNAEx = extract.Var(data.station=df_QMNAlist,
                                funct=min,
                                period=per,
                                timestep='year',
                                pos.datetime=1,
                                na.rm=TRUE)
Heraut Louis's avatar
Heraut Louis committed
        # Compute the trend analysis        
Heraut Louis's avatar
Heraut Louis committed
        df_QMNAtrend = Estimate.stats(data.extract=df_QMNAEx,
Heraut Louis's avatar
Heraut Louis committed
                                      level=alpha)
Heraut Louis's avatar
Heraut Louis committed

        # Get the associated time interval
Heraut Louis's avatar
Heraut Louis committed
        I = interval(per[1], per[2])
Heraut Louis's avatar
Heraut Louis committed
        # If it is the largest interval
Heraut Louis's avatar
Heraut Louis committed
        if (I > Imax) {
Heraut Louis's avatar
Heraut Louis committed
            # Store it and the associated data and info
Heraut Louis's avatar
Heraut Louis committed
            Imax = I
            df_QMNAlistB = df_QMNAlist
            df_QMNAExB = df_QMNAEx
        }
Heraut Louis's avatar
Heraut Louis committed
        
        # Specify the period of analyse
Heraut Louis's avatar
Heraut Louis committed
        df_QMNAtrend = get_period(per, df_QMNAtrend,
                                  df_QMNAEx,
Heraut Louis's avatar
Heraut Louis committed
                                  df_QMNAlist)
Heraut Louis's avatar
Heraut Louis committed
        # Store the trend
Heraut Louis's avatar
Heraut Louis committed
        df_QMNAtrendB = bind_rows(df_QMNAtrendB, df_QMNAtrend)
    }
Heraut Louis's avatar
Heraut Louis committed
    # Clean results of trend analyse
Heraut Louis's avatar
Heraut Louis committed
    res_QMNAtrend = clean(df_QMNAtrendB, df_QMNAExB, df_QMNAlistB)
    return (res_QMNAtrend)
Heraut Louis's avatar
Heraut Louis committed
### 1.3. VCN10
Heraut Louis's avatar
Heraut Louis committed
# Realises the trend analysis of the minimum 10 day average flow
# over the year (VCN10) hydrological variable
Heraut Louis's avatar
Heraut Louis committed
get_VCN10trend = function (df_data, df_meta, period, alpha, sampleSpan, yearLac_day) {
Heraut Louis's avatar
Heraut Louis committed
    # Removes incomplete data from time series
Heraut Louis's avatar
Heraut Louis committed
    df_data = missing_data(df_data, df_meta,
                           yearLac_day=yearLac_day, yearStart='01-01')
Heraut Louis's avatar
Heraut Louis committed

    # Samples the data
    df_data = sampling_data(df_data, df_meta,
                            sampleSpan=sampleSpan)
    # Get all different stations code
Heraut Louis's avatar
Heraut Louis committed
    Code = levels(factor(df_meta$code))
Heraut Louis's avatar
Heraut Louis committed
    # Blank tibble to store the data averaged
    df_data_roll = tibble()

Heraut Louis's avatar
Heraut Louis committed
    # For all the code
Heraut Louis's avatar
Heraut Louis committed
    for (code in Code) {
Heraut Louis's avatar
Heraut Louis committed
        # Get the data associated to the code
Heraut Louis's avatar
Heraut Louis committed
        df_data_code = df_data[df_data$code == code,]
Heraut Louis's avatar
Heraut Louis committed
        # Perform the roll mean of the flow over 10 days
Heraut Louis's avatar
Heraut Louis committed
        df_data_roll_code = tibble(Date=df_data_code$Date,
                                   Value=rollmean(df_data_code$Value, 
                                                  10,
                                                  fill=NA),
                                   code=code)
Heraut Louis's avatar
Heraut Louis committed
        # Store the results
Heraut Louis's avatar
Heraut Louis committed
        df_data_roll = bind_rows(df_data_roll, df_data_roll_code)
Heraut Louis's avatar
Heraut Louis committed
    # Make sure to convert the period to a list
Heraut Louis's avatar
Heraut Louis committed
    period = as.list(period)
Heraut Louis's avatar
Heraut Louis committed
    # Set the max interval period as the minimal possible
Heraut Louis's avatar
Heraut Louis committed
    Imax = 0
Heraut Louis's avatar
Heraut Louis committed
    # Blank tibble for data to return
Heraut Louis's avatar
Heraut Louis committed
    df_VCN10trendB = tibble()
Heraut Louis's avatar
Heraut Louis committed

    # For all periods
Heraut Louis's avatar
Heraut Louis committed
    for (per in period) {
Heraut Louis's avatar
Heraut Louis committed
        # Prepare the data to fit the entry of extract.Var
Heraut Louis's avatar
Heraut Louis committed
        df_VCN10list = prepare(df_data_roll, colnamegroup=c('code'))
Heraut Louis's avatar
Heraut Louis committed
        # Compute the yearly min over the averaged data
Heraut Louis's avatar
Heraut Louis committed
        df_VCN10Ex = extract.Var(data.station=df_VCN10list,
                                 funct=min,
                                 period=per,
                                 timestep='year',
                                 pos.datetime=1,
                                 na.rm=TRUE)
Heraut Louis's avatar
Heraut Louis committed
        # Compute the trend analysis
Heraut Louis's avatar
Heraut Louis committed
        df_VCN10trend = Estimate.stats(data.extract=df_VCN10Ex,
Heraut Louis's avatar
Heraut Louis committed
                                      level=alpha)
Heraut Louis's avatar
Heraut Louis committed

        # Get the associated time interval
        I = interval(per[1], per[2])
        # If it is the largest interval       
        if (I > Imax) {
            # Store it and the associated data and info           
            Imax = I
            df_VCN10listB = df_VCN10list
            df_VCN10ExB = df_VCN10Ex
        }

        # Specify the period of analyse
        df_VCN10trend = get_period(per, df_VCN10trend, df_VCN10Ex,
                                   df_VCN10list)
        # Store the trend
        df_VCN10trendB = bind_rows(df_VCN10trendB, df_VCN10trend)
    }
    # Clean results of trend analyse
    res_VCN10trend = clean(df_VCN10trendB, df_VCN10ExB, df_VCN10listB)
    return (res_VCN10trend)
}

### 1.4. DEB date
which_underfirst = function (L, UpLim, select_longest=TRUE) {
Heraut Louis's avatar
Heraut Louis committed
    ID = which(L <= UpLim)
    if (select_longest) {
        dID = diff(ID)
        dID = c(10, dID)
        
        IDjump = which(dID != 1)
        Njump = length(IDjump)
        Periods = vector(mode='list', length=Njump)
        Nperiod = c()
        for (i in 1:Njump) {
            idStart = IDjump[i]
            
            if (i < Njump) {
                idEnd = IDjump[i+1] - 1
            } else {
                idEnd = length(ID)
            }
            
            period = ID[idStart:idEnd]
            Periods[[i]] = period
            Nperiod = c(Nperiod, length(period))
        period_max = Periods[[which.max(Nperiod)]]
        id = period_max[1]
    } else {
        id = ID[1]
Heraut Louis's avatar
Heraut Louis committed
    return (id)
}

Heraut Louis's avatar
Heraut Louis committed
get_DEBtrend = function (df_data, df_meta, period, alpha, sampleSpan, yearLac_day, thresold_type='VCN10', select_longest=TRUE) {
Heraut Louis's avatar
Heraut Louis committed
    # Get all different stations code
    Code = levels(factor(df_meta$code))
    # Gets the number of station
    nCode = length(Code)
    
    # Blank tibble to store the data averaged
    df_data_roll = tibble() 

    # For all the code
    for (code in Code) {
        # Get the data associated to the code
        df_data_code = df_data[df_data$code == code,]
        # Perform the roll mean of the flow over 10 days
        df_data_roll_code = tibble(Date=df_data_code$Date,
                                   Value=rollmean(df_data_code$Value, 
                                                  10,
                                                  fill=NA),
                                   code=code)
        # Store the results
        df_data_roll = bind_rows(df_data_roll, df_data_roll_code)
    }

    # Removes incomplete data from time series
Heraut Louis's avatar
Heraut Louis committed
    df_data = missing_data(df_data,
                           df_meta=df_meta,
                           yearLac_day=yearLac_day)
    # Samples the data
    df_data = sampling_data(df_data,
                            df_meta=df_meta,
                            sampleSpan=sampleSpan)
    
    # Removes incomplete data from the averaged time series
Heraut Louis's avatar
Heraut Louis committed
    df_data_roll = missing_data(df_data_roll,
                                df_meta=df_meta,
                                yearLac_day=yearLac_day)
    # Samples the data
    df_data_roll = sampling_data(df_data_roll,
                                 df_meta=df_meta,
                                 sampleSpan=sampleSpan)
Heraut Louis's avatar
Heraut Louis committed

    # Make sure to convert the period to a list
    period = as.list(period)
    # Set the max interval period as the minimal possible
    Imax = 0
    # Blank tibble for data to return
    df_DEBtrendB = tibble()
Heraut Louis's avatar
Heraut Louis committed

    # For all periods
    for (per in period) {

        if (thresold_type == 'QNj') {
            # Prepare the data to fit the entry of extract.Var
            df_QTlist = prepare(df_data,
                                colnamegroup=c('code'))
        } else if (thresold_type == 'VCN10') {
            # Prepare the data to fit the entry of extract.Var
            df_QTlist = prepare(df_data_roll,
                                colnamegroup=c('code'))
        }
        
        # Compute the yearly mean over the data
        df_QTEx = extract.Var(data.station=df_QTlist,
                              funct=min,
                              timestep='year',
                               period=per,
                              pos.datetime=1,
                              na.rm=TRUE)
        
        df_QT = summarise(group_by(df_QTEx, group1),
                          values=max(values, na.rm=TRUE))
        
        # Renames the column of group of trend results
        colnames(df_QT) = c('group', 'Thresold')
        df_QT = full_join(df_QT, df_QTlist$info, by='group')
        df_QT = df_QT[-1]
        
        # print(df_QT)
        
        df_DEBEx = tibble()
        df_DEBlist = list(data=tibble(), info=tibble())
Heraut Louis's avatar
Heraut Louis committed
        
        # For all the code
        for (k in 1:nCode) {
            # Gets the code
            code = Code[k]
            
Heraut Louis's avatar
Heraut Louis committed
            # Get the data associated to the code
            df_data_code = df_data[df_data$code == code,]
            # Get the averaged data associated to the code
            df_data_roll_code = df_data_roll[df_data_roll$code == code,]
Heraut Louis's avatar
Heraut Louis committed
            
Heraut Louis's avatar
Heraut Louis committed
            # Prepare the data to fit the entry of extract.Var
            df_DEBlist_code = prepare(df_data_roll_code,
Heraut Louis's avatar
Heraut Louis committed
                                      colnamegroup=c('code'))
Heraut Louis's avatar
Heraut Louis committed

            QT_code = df_QT$Thresold[df_QT$code == code]
Heraut Louis's avatar
Heraut Louis committed
            
            # Compute the yearly min over the averaged data
            df_DEBEx_code = extract.Var(data.station=df_DEBlist_code,
                                        funct=which_underfirst,
Heraut Louis's avatar
Heraut Louis committed
                                        period=per,
                                        timestep='year',
Heraut Louis's avatar
Heraut Louis committed
                                        pos.datetime=1,
                                        UpLim=QT_code,
                                        select_longest=select_longest)
Heraut Louis's avatar
Heraut Louis committed

            df_DEBEx_code$group1 = k
            df_DEBlist_code$data$group = k
            df_DEBlist_code$info$group = k
Heraut Louis's avatar
Heraut Louis committed
            
            # Converts index of the DEB to the julian date associated
            df_DEBEx_code = prepare_date(df_DEBEx_code,
                                          df_DEBlist_code)
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
            # Store the results
            df_DEBEx = bind_rows(df_DEBEx, df_DEBEx_code)
Heraut Louis's avatar
Heraut Louis committed
            
            df_DEBlist$data = bind_rows(df_DEBlist$data,
                                         df_DEBlist_code$data)
Heraut Louis's avatar
Heraut Louis committed
            
            df_DEBlist$info = bind_rows(df_DEBlist$info,
                                         df_DEBlist_code$info)
Heraut Louis's avatar
Heraut Louis committed
        }
Heraut Louis's avatar
Heraut Louis committed
        # Compute the trend analysis
        df_DEBtrend = Estimate.stats(data.extract=df_DEBEx,
Heraut Louis's avatar
Heraut Louis committed
                                      level=alpha)
Heraut Louis's avatar
Heraut Louis committed
        # Get the associated time interval
        I = interval(per[1], per[2])
        # If it is the largest interval       
        if (I > Imax) {
            # Store it and the associated data and info           
            Imax = I
            df_DEBlistB = df_DEBlist
            df_DEBExB = df_DEBEx
Heraut Louis's avatar
Heraut Louis committed
        }
Heraut Louis's avatar
Heraut Louis committed
        
Heraut Louis's avatar
Heraut Louis committed
        # Specify the period of analyse
        df_DEBtrend = get_period(per, df_DEBtrend, df_DEBEx,
                                   df_DEBlist)
Heraut Louis's avatar
Heraut Louis committed
        # Store the trend
        df_DEBtrendB = bind_rows(df_DEBtrendB, df_DEBtrend)
Heraut Louis's avatar
Heraut Louis committed
    }
    # Clean results of trend analyse
    res_DEBtrend = clean(df_DEBtrendB, df_DEBExB, df_DEBlistB)    
    return (res_DEBtrend)
Heraut Louis's avatar
Heraut Louis committed
}
### 1.5. CEN date
Heraut Louis's avatar
Heraut Louis committed
# Realises the trend analysis of the date of the minimum 10 day
# average flow over the year (VCN10) hydrological variable
Heraut Louis's avatar
Heraut Louis committed
get_CENtrend = function (df_data, df_meta, period, alpha, sampleSpan, yearLac_day) {
Heraut Louis's avatar
Heraut Louis committed
    # Get all different stations code
    Code = levels(factor(df_meta$code))
    # Blank tibble to store the data averaged
    df_data_roll = tibble() 

    # For all the code
Heraut Louis's avatar
Heraut Louis committed
    for (code in Code) {
Heraut Louis's avatar
Heraut Louis committed
        # Get the data associated to the code
Heraut Louis's avatar
Heraut Louis committed
        df_data_code = df_data[df_data$code == code,]
Heraut Louis's avatar
Heraut Louis committed
        # Perform the roll mean of the flow over 10 days
Heraut Louis's avatar
Heraut Louis committed
        df_data_roll_code = tibble(Date=df_data_code$Date,
                                   Value=rollmean(df_data_code$Value, 
                                                  10,
                                                  fill=NA),
                                   code=code)
Heraut Louis's avatar
Heraut Louis committed
        # Store the results
Heraut Louis's avatar
Heraut Louis committed
        df_data_roll = bind_rows(df_data_roll, df_data_roll_code)
Heraut Louis's avatar
Heraut Louis committed
    # Removes incomplete data from time series
Heraut Louis's avatar
Heraut Louis committed
    df_data_roll = missing_data(df_data_roll, df_meta,
                                yearLac_day=yearLac_day,
                                yearStart='01-01')
Heraut Louis's avatar
Heraut Louis committed
    # Samples the data
    df_data_roll = sampling_data(df_data_roll, df_meta,
                                 sampleSpan=sampleSpan)
Heraut Louis's avatar
Heraut Louis committed
    # Make sure to convert the period to a list
    period = as.list(period)
    # Set the max interval period as the minimal possible
    Imax = 0
    # Blank tibble for data to return
    df_CENtrendB = tibble()
Heraut Louis's avatar
Heraut Louis committed

    # For all periods
    for (per in period) {
        # Prepare the data to fit the entry of extract.Var
        df_CENlist = prepare(df_data_roll, colnamegroup=c('code'))
Heraut Louis's avatar
Heraut Louis committed
        # Compute the yearly min over the averaged data
        df_CENEx = extract.Var(data.station=df_CENlist,
Heraut Louis's avatar
Heraut Louis committed
                               funct=which.min,
                               period=per,
                               timestep='year',
                               pos.datetime=1)
        # Converts index of the CEN to the julian date associated
        df_CENEx = prepare_date(df_CENEx, df_CENlist)
Heraut Louis's avatar
Heraut Louis committed
        
        # Compute the trend analysis
        df_CENtrend = Estimate.stats(data.extract=df_CENEx,
Heraut Louis's avatar
Heraut Louis committed
                                      level=alpha)
Heraut Louis's avatar
Heraut Louis committed
        # Get the associated time interval
Heraut Louis's avatar
Heraut Louis committed
        I = interval(per[1], per[2])
Heraut Louis's avatar
Heraut Louis committed
        # If it is the largest interval       
Heraut Louis's avatar
Heraut Louis committed
        if (I > Imax) {
Heraut Louis's avatar
Heraut Louis committed
            # Store it and the associated data and info           
Heraut Louis's avatar
Heraut Louis committed
            Imax = I
            df_CENlistB = df_CENlist
            df_CENExB = df_CENEx
Heraut Louis's avatar
Heraut Louis committed
        # Specify the period of analyse
        df_CENtrend = get_period(per, df_CENtrend, df_CENEx,
                                   df_CENlist)
Heraut Louis's avatar
Heraut Louis committed
        # Store the trend
        df_CENtrendB = bind_rows(df_CENtrendB, df_CENtrend)
Heraut Louis's avatar
Heraut Louis committed
    }
Heraut Louis's avatar
Heraut Louis committed
    # Clean results of trend analyse
    res_CENtrend = clean(df_CENtrendB, df_CENExB, df_CENlistB)
    return (res_CENtrend)
Heraut Louis's avatar
Heraut Louis committed
## 2. OTHER ANALYSES
Heraut Louis's avatar
Heraut Louis committed
### 2.1. Hydrograph
xref = matrix(
Heraut Louis's avatar
Heraut Louis committed
    c(0.099, 0.100, 0.101, 0.099, 0.088, 0.078, 0.072,
Heraut Louis's avatar
Heraut Louis committed
      0.064, 0.064, 0.069, 0.076, 0.089,
Heraut Louis's avatar
Heraut Louis committed
      0.133, 0.126, 0.111, 0.110, 0.081, 0.056, 0.038,
Heraut Louis's avatar
Heraut Louis committed
      0.027, 0.042, 0.063, 0.098, 0.117,
Heraut Louis's avatar
Heraut Louis committed
      0.128, 0.142, 0.122, 0.128, 0.105, 0.065, 0.035,
Heraut Louis's avatar
Heraut Louis committed
      0.024, 0.031, 0.044, 0.074, 0.101,
Heraut Louis's avatar
Heraut Louis committed
      0.157, 0.130, 0.119, 0.094, 0.062, 0.042, 0.028,
Heraut Louis's avatar
Heraut Louis committed
      0.021, 0.035, 0.062, 0.099, 0.150,
Heraut Louis's avatar
Heraut Louis committed
      0.204, 0.163, 0.118, 0.102, 0.060, 0.030, 0.018,
Heraut Louis's avatar
Heraut Louis committed
      0.012, 0.023, 0.041, 0.087, 0.143,
Heraut Louis's avatar
Heraut Louis committed
      0.156, 0.154, 0.117, 0.119, 0.086, 0.044, 0.025,
Heraut Louis's avatar
Heraut Louis committed
      0.015, 0.025, 0.044, 0.089, 0.127,
Heraut Louis's avatar
Heraut Louis committed
      0.139, 0.092, 0.082, 0.099, 0.087, 0.039, 0.015,
Heraut Louis's avatar
Heraut Louis committed
      0.012, 0.036, 0.108, 0.159, 0.131,
Heraut Louis's avatar
Heraut Louis committed
      0.112, 0.098, 0.101, 0.125, 0.122, 0.072, 0.036,
Heraut Louis's avatar
Heraut Louis committed
      0.024, 0.039, 0.067, 0.102, 0.102,
Heraut Louis's avatar
Heraut Louis committed
      0.058, 0.050, 0.100, 0.142, 0.158, 0.092, 0.067,
Heraut Louis's avatar
Heraut Louis committed
      0.050, 0.042, 0.058, 0.083, 0.100,
Heraut Louis's avatar
Heraut Louis committed
      0.050, 0.050, 0.058, 0.083, 0.150, 0.167, 0.117,
Heraut Louis's avatar
Heraut Louis committed
      0.083, 0.058, 0.058, 0.067, 0.058,
Heraut Louis's avatar
Heraut Louis committed
      0.033, 0.025, 0.033, 0.075, 0.167, 0.217, 0.142,
Heraut Louis's avatar
Heraut Louis committed
      0.092, 0.067, 0.058, 0.050, 0.042,
Heraut Louis's avatar
Heraut Louis committed
      0.017, 0.008, 0.017, 0.042, 0.108, 0.183, 0.200,
      0.175, 0.117, 0.067, 0.042, 0.025),
Heraut Louis's avatar
Heraut Louis committed
    ncol=12, byrow=TRUE)

colnames(xref) = seq(1, 12, 1)
Heraut Louis's avatar
Heraut Louis committed
row.names(xref) = c('GROUP1', 'GROUP2', 'GROUP3', 'GROUP4',
                    'GROUP5', 'GROUP6', 'GROUP7', 'GROUP8',
                    'GROUP9', 'GROUP10', 'GROUP11', 'GROUP12')    
Heraut Louis's avatar
Heraut Louis committed

# Computes the hydrograph of a station
get_hydrograph = function (df_data, period=NULL, df_meta=NULL) {

    # If there is a specified period
    if (!is.null(period)) {
        # Extracts only the data of this period
        df_data = df_data[df_data$Date >= as.Date(period[1])
                          & df_data$Date <= as.Date(period[2]),]
    }
    
    # If there is the metadata
    if (!is.null(df_meta)) {
        # New column in metadata for hydrological regime
        df_meta$regime_hydro = NA
Heraut Louis's avatar
Heraut Louis committed
        # New column in metadata for the start of the hydrological year
        df_meta$start_year = NA
Heraut Louis's avatar
Heraut Louis committed

        # Get all different stations code
        Code = levels(factor(df_meta$code))
        # Number of stations
        nCode = length(Code)
        
    # Otherwise it is just a list of flow from one station
    } else {
        # Only one code is present
        nCode = 1
    }

    # Blank tibble to store data
    df_QM = tibble()
    # For all accessible code
    for (k in 1:nCode) {
        # If there is the metadata
        if (!is.null(df_meta)) {
            # Gets the code
            code = Code[k]
            # Get the associated data
            df_data_code = df_data[df_data$code == code,]
        } else {
            # The data are the date for the current code
            df_data_code = df_data
        }
        
        # Gets a list of the month of the data as numeric
        monthData = as.numeric(format(df_data_code$Date, "%m"))
        # Blank list to stock month mean
        QM_code = c()
        # For all months
        for (i in 1:12) {
            # Gets all the flow data associated to the current month
            data = df_data_code$Value[monthData == i]
            # Averages the data
            QM_code[i] = mean(data, na.rm=TRUE)
        }

        regime = 0
        classRegime = ""
        distance = rep(0, length(xref[,1]))
        distancemin = 0
        for (j in 1:length(xref[,1])) {
            distance[j] = sum((QM_code / mean(QM_code) - xref[j,])^2)
        }
        regime = 1 + length(xref[,1]) - which.min(distance)
        distancemin = distance[which.min(distance)]
        
        if (regime < 7) {
            classRegime = "Pluvial"
        } else if (regime >= 7 & regime < 10) {
            classRegime = "Transition"
        } else if (regime >= 10) {
Heraut Louis's avatar
Heraut Louis committed
            classRegime = "Nival Glaciaire"
        } 
Heraut Louis's avatar
Heraut Louis committed
        
        # If there is the metadata
        if (!is.null(df_meta)) {
            # Creates a temporary tibble to store hydrograph results
            df_QMtmp = tibble(QM=QM_code, code=code)
            # Stores it
            df_QM = bind_rows(df_QM, df_QMtmp)
            # Stores result of the hydrological regime
            df_meta$regime_hydro[df_meta$code == code] = classRegime
Heraut Louis's avatar
Heraut Louis committed
            # Computes the month of the max QM
Heraut Louis's avatar
Heraut Louis committed
            maxMonth = which.max(QM_code)
            
Heraut Louis's avatar
Heraut Louis committed
            # Stores it as the start of the hydrological year
            df_meta$start_year[df_meta$code == code] = maxMonth
Heraut Louis's avatar
Heraut Louis committed
        # Otherwise
        } else {
            # No tibble needed
            df_QM = QM_code
            df_meta = classRegime
        }
    }
    # Returns the hydrograph and meta data
    return (list(QM=df_QM, meta=df_meta))
}
    
### 2.2. Break date
Heraut Louis's avatar
Heraut Louis committed
# Compute the break date of the flow data by station 
Heraut Louis's avatar
Heraut Louis committed
get_break = function (df_data, df_meta, alpha=0.05) {
Heraut Louis's avatar
Heraut Louis committed
    
    # Get all different stations code
    Code = levels(factor(df_meta$code))
    # Number of stations
    nCode = length(Code)

    # Blank date break list and associated station code vector
    date_break = list()
    Code_break = c()

    # For all accessible code
    for (code in Code) {
        # Get the associated data
        df_data_code = df_data[df_data$code == code,] 
        # Remove NA data
Heraut Louis's avatar
Heraut Louis committed
        df_data_codeNoNA = df_data_code[!is.na(df_data_code$Value),]
Heraut Louis's avatar
Heraut Louis committed
        # Perform the break analysis thanks to the Pettitt test
Heraut Louis's avatar
Heraut Louis committed
        res_break = pettitt.test(df_data_codeNoNA$Value)
Heraut Louis's avatar
Heraut Louis committed

        # Extract p value
        p_value = res_break$p
        # The length of the data analysed
        nbreak = res_break$nobs
        # Index of the break date
        ibreak = res_break$estimate

        # If the p value results is under the thresold
Heraut Louis's avatar
Heraut Louis committed
        if (p_value <= alpha) {
Heraut Louis's avatar
Heraut Louis committed
            # Get the mean of the index break if there is several
            ibreak = round(mean(ibreak), 0)
            # Store the date break with its associated code
            date_break = append(date_break, 
                                df_data_codeNoNA$Date[ibreak])
            Code_break = append(Code_break, code)
        }
Heraut Louis's avatar
Heraut Louis committed
        # step1 = mean(df_data_codeNoNA$Value[1:ibreak])
        # step2 = mean(df_data_codeNoNA$Value[(ibreak+1):nbreak])
Heraut Louis's avatar
Heraut Louis committed
    }
    # Create a tibble with the break analysis results
    df_break = tibble(code=Code_break, Date=as.Date(date_break))
    return (df_break)
}

Heraut Louis's avatar
Heraut Louis committed
### 2.3. Time gap
Heraut Louis's avatar
Heraut Louis committed
# Compute the time gap by station
get_lacune = function (df_data, df_meta) {
    
    # Get all different stations code
    Code = levels(factor(df_meta$code))
    
    # Create new vector to stock results for cumulative and mean
    # time gap by station
    tLac = c()
    meanLac = c()

    # Get rows where there is no NA
    NoNA = complete.cases(df_data)
    # Get data where there is no NA
    df_data_NoNA = df_data[NoNA,]

    # For every station
    for (code in Code) {   
        # Get only the data rows for the selected station
        df_data_code = df_data[df_data$code==code,]
        # Get date for the selected station
        Date = df_data_code$Date
        # Get time span for the selection station
        span = as.numeric(Date[length(Date)] - Date[1])
        
        # Get only the data rows with no NA for the selected station
        df_data_NoNA_code = df_data_NoNA[df_data_NoNA$code==code,]
        # Get date for the selected station
        Date_NoNA = df_data_NoNA_code$Date
        
        # Compute the time gap
        lac = as.numeric(diff(Date_NoNA) - 1)

        # Compute the cumulative gap
        lac_sum = sum(lac)
        # Store the cumulative gap rate
        tLac = c(tLac, lac_sum/span)

        # Compute the mean gap
        lac_mean = mean(lac[lac != 0])
        # Store the mean gap
        meanLac = c(meanLac, lac_mean) 
    }
    
    # Compute the cumulative gap rate in pourcent
    tLac100 = tLac * 100
    # Create tibble for lacune
    df_lac = tibble(code=Code, tLac100=tLac100, meanLac=meanLac)
    # Join a tibble
    df_meta = full_join(df_meta, df_lac)
    return (df_meta)
}
Heraut Louis's avatar
Heraut Louis committed