format.R 3.39 KB
Newer Older
# Usefull library
Heraut Louis's avatar
Heraut Louis committed
library(dplyr)

Heraut Louis's avatar
Heraut Louis committed
join = function (df_data_BH, df_data_NV, df_meta_BH, df_meta_NV) {

    if (!is.null(df_data_NV) & !is.null(df_data_BH)) {

        # Get the station in common
Heraut Louis's avatar
Heraut Louis committed
        common = levels(factor(df_meta_NV[df_meta_NV$code %in% df_meta_BH$code,]$code)) 
        # Get the Nv station to add
Heraut Louis's avatar
Heraut Louis committed
        NVadd = levels(factor(df_meta_NV[!(df_meta_NV$code %in% df_meta_BH$code),]$code))
Heraut Louis's avatar
Heraut Louis committed
        # Select only the NV meta to add
        df_meta_NVadd = df_meta_NV[df_meta_NV$code %in% NVadd,]
        # Join NV data to BH data
Heraut Louis's avatar
Heraut Louis committed
        df_meta = full_join(df_meta_BH, df_meta_NVadd, by=c("code", "nom", "L93X", "L93Y", "surface_km2", "file_path"))
Heraut Louis's avatar
Heraut Louis committed

        # Select only the NV data to add
        df_data_NVadd = df_data_NV[df_data_NV$code %in% NVadd,]
Heraut Louis's avatar
Heraut Louis committed
        # Join NV meta to BH meta
        df_data = full_join(df_data_BH, df_data_NVadd, by=c("Date", "Qm3s", "code"))
Heraut Louis's avatar
Heraut Louis committed

    } else if (is.null(df_data_NV) & !is.null(df_data_BH)) {
Heraut Louis's avatar
Heraut Louis committed
        df_meta = df_meta_BH
        df_data = df_data_BH
        df_data_NVadd = NULL
    } else if (!is.null(df_data_NV) & is.null(df_data_BH)) {
Heraut Louis's avatar
Heraut Louis committed
        df_meta = df_meta_NV
        df_data = df_data_NV
        df_data_NVadd = df_data_NV
    } else {
        stop('No data')
    }
    
    return (list(data=df_data, meta=df_meta, NVadd=df_data_NVadd))
prepare = function(df_data, colnamegroup=NULL) {
            
    colnamegroup = c(colnamegroup)
    colindgroup = which(colnames(df_data) == colnamegroup)
    df_data = group_by_at(df_data, colindgroup)

    data = tibble(Date=df_data$Date, 
                  group=group_indices(df_data),
                  Qm3s=df_data$Qm3s) 
    Gkey = group_keys(df_data)
    info = bind_cols(group=seq(1:nrow(Gkey)),
                     Gkey)
    return (list(data=data, info=info))
}
reprepare = function(df_XEx, df_Xlist, colnamegroup=NULL) {
    colnames(df_XEx) = c('Date', 'group', 'Qm3s')
    df_XEx$Date = as.character(df_XEx$Date)
    exDate = df_XEx$Date[1]
    nbt = lengths(regmatches(exDate, gregexpr('-', exDate)))
    
    if (nbt == 1) {
         df_XEx$Date = paste(df_XEx$Date, '01', sep='-')
    } else if (nbt == 0) {
         df_XEx$Date = paste(df_XEx$Date, '01', '01', sep='-')
    } else if (nbt != 2) {
        stop('erreur of date format')
    }

    df_XEx = bind_cols(Date=as.Date(df_XEx$Date,
                                       format="%Y-%m-%d"),
                       df_XEx[-1],
                       df_Xlist$info[df_XEx$group,
                                     2:ncol(df_Xlist$info)])
    df_XlistEx = prepare(df_XEx, colnamegroup=colnamegroup)
    return (df_XlistEx)
clean = function (df_Xtrend, df_XEx, df_Xlist) {
    df_Xlist = reprepare(df_XEx, df_Xlist, colnamegroup=c('code'))
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
    # print(df_Xlist)

Heraut Louis's avatar
Heraut Louis committed
    df_Xlist$data$code = NA
    for (g in df_Xlist$info$group) {
        df_Xlist$data$code[which(df_Xlist$data$group == g)] = df_Xlist$info$code[df_Xlist$info$group == g]
    }
    
    # df_Xlist$data = df_Xlist$data[, !names(df_Xlist$data) == "group")]

    df_Xtrend = bind_cols(df_Xtrend,
                          df_Xlist$info[df_Xtrend$group1,
                                       2:ncol(df_Xlist$info)])
Heraut Louis's avatar
Heraut Louis committed

    colnames(df_Xtrend)[1] = 'group'

Heraut Louis's avatar
Heraut Louis committed
    df_Xtrend = get_intercept(df_Xtrend, df_Xlist, unit2day=365.25)
Heraut Louis's avatar
Heraut Louis committed
    # df_Xtrend$intercept = intercept
    df_Xtrend = relocate(df_Xtrend, intercept, .after=trend)

    return (list(trend=df_Xtrend, data=df_Xlist$data, info=df_Xlist$info))
Heraut Louis's avatar
Heraut Louis committed
}