panel.R 24.2 KB
Newer Older
# Usefull library
Heraut Louis's avatar
Heraut Louis committed
library(ggplot2)
Heraut Louis's avatar
Heraut Louis committed
library(scales)
Heraut Louis's avatar
Heraut Louis committed
library(qpdf)
library(gridExtra)
library(gridtext)
Heraut Louis's avatar
Heraut Louis committed
library(dplyr)
library(grid)
Heraut Louis's avatar
Heraut Louis committed
library(ggh4x)
Heraut Louis's avatar
Heraut Louis committed
library(RColorBrewer)
louis_heraut's avatar
louis_heraut committed

Heraut Louis's avatar
Heraut Louis committed
time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missRect=FALSE, unit2day=365.25, period=NULL, last=FALSE, first=FALSE, color=NULL) {
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
    if (type == 'sqrt(Q)') {
Heraut Louis's avatar
Heraut Louis committed
        df_data_code$Qm3s = sqrt(df_data_code$Qm3s)
Heraut Louis's avatar
Heraut Louis committed
    }
Heraut Louis's avatar
Heraut Louis committed
    
    maxQ = max(df_data_code$Qm3s, na.rm=TRUE)
Heraut Louis's avatar
Heraut Louis committed
    power = get_power(maxQ) 

    maxQtmp = maxQ/10^power
    if (maxQtmp >= 5) {
Heraut Louis's avatar
Heraut Louis committed
        dbrk = 1.0
Heraut Louis's avatar
Heraut Louis committed
    } else if (maxQtmp < 5 & maxQtmp >= 3) {
Heraut Louis's avatar
Heraut Louis committed
        dbrk = 0.5
Heraut Louis's avatar
Heraut Louis committed
    } else if (maxQtmp < 3 & maxQtmp >= 2) {
Heraut Louis's avatar
Heraut Louis committed
        dbrk = 0.4
Heraut Louis's avatar
Heraut Louis committed
    } else if (maxQtmp < 2 & maxQtmp >= 1) {
Heraut Louis's avatar
Heraut Louis committed
        dbrk = 0.2
Heraut Louis's avatar
Heraut Louis committed
    } else if (maxQtmp < 1) {
Heraut Louis's avatar
Heraut Louis committed
        dbrk = 0.1
Heraut Louis's avatar
Heraut Louis committed
    }
Heraut Louis's avatar
Heraut Louis committed
    
Heraut Louis's avatar
Heraut Louis committed
    dbrk = dbrk * 10^power
    accuracy = NULL
Heraut Louis's avatar
Heraut Louis committed
    dDate = as.numeric(df_data_code$Date[length(df_data_code$Date)] -
Heraut Louis's avatar
Heraut Louis committed
                       df_data_code$Date[1]) / unit2day
Heraut Louis's avatar
Heraut Louis committed
    if (dDate >= 100) {
        datebreak = 25
        dateminbreak = 5
    } else if (dDate < 100 & dDate >= 50) {
        datebreak = 10
        dateminbreak = 1
    } else if (dDate < 50) {
        datebreak = 5
        dateminbreak = 1
    }
    
    p = ggplot() + 
Heraut Louis's avatar
Heraut Louis committed
        
Heraut Louis's avatar
Heraut Louis committed
        # theme_bw() +

    theme(panel.background=element_rect(fill='white'),
          text=element_text(family='sans'),

Heraut Louis's avatar
Heraut Louis committed
          # panel.border=element_blank(),
          panel.border = element_rect(color="grey85",
                                    fill=NA,
                                    size=0.7),

          # panel.grid.major.y=element_line(color='grey85', size=0.3),
          panel.grid.major.y=element_line(color='grey85', size=0.15),
Heraut Louis's avatar
Heraut Louis committed
          panel.grid.major.x=element_blank(),
          
Heraut Louis's avatar
Heraut Louis committed
          # axis.ticks.y=element_blank(),
          axis.ticks.y=element_line(color='grey75', size=0.3),
Heraut Louis's avatar
Heraut Louis committed
          axis.ticks.x=element_line(color='grey75', size=0.3),
          
          axis.text.x=element_text(color='grey40'),
          axis.text.y=element_text(color='grey40'),

          ggh4x.axis.ticks.length.minor=rel(0.5),
          axis.ticks.length=unit(1.5, 'mm'),

Heraut Louis's avatar
Heraut Louis committed
          plot.title=element_text(size=9, vjust=-2, 
Heraut Louis's avatar
Heraut Louis committed
                                  hjust=-1E-3, color='grey20'), 
Heraut Louis's avatar
Heraut Louis committed
          axis.title.x=element_blank(),
          axis.title.y=element_blank(),
          # axis.title.y=element_text(size=8, color='grey20'),
          axis.line.x=element_blank(),
          axis.line.y=element_blank(),
          )

    if (last) {
Heraut Louis's avatar
Heraut Louis committed
        if (first) {
            p = p +
                theme(plot.margin=margin(5, 5, 5, 5, unit="mm"))
        } else {
            p = p +
                theme(plot.margin=margin(0, 5, 5, 5, unit="mm"))
        }

Heraut Louis's avatar
Heraut Louis committed
    } else {
Heraut Louis's avatar
Heraut Louis committed
        if (first) {
            p = p +
                theme(plot.margin=margin(5, 5, 0, 5, unit="mm"))
        } else {
            p = p +
                theme(plot.margin=margin(0, 5, 0, 5, unit="mm"))
        }
Heraut Louis's avatar
Heraut Louis committed
    }
Heraut Louis's avatar
Heraut Louis committed
        
Heraut Louis's avatar
Heraut Louis committed

    if (type == 'sqrt(Q)' | type == 'Q') {
        p = p +
Heraut Louis's avatar
Heraut Louis committed
            geom_line(aes(x=df_data_code$Date, y=df_data_code$Qm3s),
Heraut Louis's avatar
Heraut Louis committed
                      color='grey20',
                      size=0.3)
Heraut Louis's avatar
Heraut Louis committed
    } else {
        p = p +
Heraut Louis's avatar
Heraut Louis committed
            geom_point(aes(x=df_data_code$Date, y=df_data_code$Qm3s),
Heraut Louis's avatar
Heraut Louis committed
                       shape=1, color='grey20', size=1)
    }

    if (missRect) {
Heraut Louis's avatar
Heraut Louis committed
        NAdate = df_data_code$Date[is.na(df_data_code$Qm3s)]
        dNAdate = diff(NAdate)
        NAdate_Down = NAdate[append(Inf, dNAdate) != 1]
        NAdate_Up = NAdate[append(dNAdate, Inf) != 1]

        p = p +
            geom_rect(aes(xmin=NAdate_Down, 
                          ymin=0, 
                          xmax=NAdate_Up, 
Heraut Louis's avatar
Heraut Louis committed
                          ymax=maxQ*1.1),
Heraut Louis's avatar
Heraut Louis committed
                      linetype=0, fill='Wheat', alpha=0.4)
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
    if ((type == 'sqrt(Q)' | type == 'Q') & !is.null(period)) {
Heraut Louis's avatar
Heraut Louis committed
        
        period = as.list(period)
        Imin = 10^99
        for (per in period) {
            I = interval(per[1], per[2])
            if (I < Imin) {
                Imin = I
                period_min = as.Date(per)
            }
Heraut Louis's avatar
Heraut Louis committed
        }

Heraut Louis's avatar
Heraut Louis committed
        p = p + 
            geom_rect(aes(xmin=min(df_data_code$Date),
                          ymin=0, 
                          xmax=period_min[1], 
                          ymax= maxQ*1.1),
                      linetype=0, fill='grey85', alpha=0.3) +
            
            geom_rect(aes(xmin=period_min[2],
                          ymin=0, 
                          xmax=max(df_data_code$Date), 
                          ymax= maxQ*1.1),
                      linetype=0, fill='grey85', alpha=0.3) 
    }

Heraut Louis's avatar
Heraut Louis committed
    if (!is.null(df_trend_code)) {
Heraut Louis's avatar
Heraut Louis committed
        
        # print(df_trend_code)
Heraut Louis's avatar
Heraut Louis committed
        Start = df_trend_code$period_start
        UStart = levels(factor(Start))
        End = df_trend_code$period_end
        UEnd = levels(factor(End))
        
        nPeriod = max(length(UStart), length(UEnd))
        
        Periods = vector(mode='list', length=nPeriod)
        # for (i in 1:nPeriod) {
        #     Periods[[i]] = as.Date(c(Period_start[i], Period_end[i]))
        # }    
        
        ltype = c('solid', 'dashed', 'dotted', 'twodash')
Heraut Louis's avatar
Heraut Louis committed
        lty = c('solid', '22', 'dotted', 'twodash')
Heraut Louis's avatar
Heraut Louis committed
        
        ii = 0
Heraut Louis's avatar
Heraut Louis committed
        for (i in 1:nPeriod) {
Heraut Louis's avatar
Heraut Louis committed
            df_trend_code_per = 
                df_trend_code[df_trend_code$period_start == Start[i] 
                              & df_trend_code$period_end == End[i],]
Heraut Louis's avatar
Heraut Louis committed
            if (df_trend_code_per$p <= p_threshold) {

Heraut Louis's avatar
Heraut Louis committed
                ii = ii + 1

Heraut Louis's avatar
Heraut Louis committed
                iStart = which.min(abs(df_data_code$Date - Start[i]))
                iEnd = which.min(abs(df_data_code$Date - End[i]))

                abs = c(df_data_code$Date[iStart],
                        df_data_code$Date[iEnd])
                
                abs_num = as.numeric(abs) / unit2day


                ord = abs_num * df_trend_code_per$trend +
                    df_trend_code_per$intercept

                plot = tibble(abs=abs, ord=ord)

Heraut Louis's avatar
Heraut Louis committed
                if (!is.na(color[i])) {
Heraut Louis's avatar
Heraut Louis committed
                    p = p + 
                        geom_line(data=plot, aes(x=abs, y=ord), 
                                      color=color[i], 
                                      linetype=ltype[i], size=0.7)
Heraut Louis's avatar
Heraut Louis committed
                } else {                    
Heraut Louis's avatar
Heraut Louis committed
                    p = p + 
                        geom_line(aes(x=abs, y=ord), 
                                  color='cornflowerblue')
                }

Heraut Louis's avatar
Heraut Louis committed
                codeDate = df_data_code$Date
                codeQ = df_data_code$Qm3s
                
Heraut Louis's avatar
Heraut Louis committed
                x = gpct(2, codeDate, shift=TRUE)
Heraut Louis's avatar
Heraut Louis committed
                xend = x + gpct(3, codeDate)
               
Heraut Louis's avatar
Heraut Louis committed
                dy = gpct(6, codeQ, ref=0)
                y = gpct(100, codeQ, ref=0) - (ii-1)*dy
Heraut Louis's avatar
Heraut Louis committed

                xt = xend + gpct(1, codeDate)
                label = bquote(bold(.(format(df_trend_code$trend, scientific=TRUE, digits=3)))~'['*m^{3}*'.'*s^{-1}*'.'*an^{-1}*']')
    
                p = p +
                    annotate("segment",
                             x=x, xend=xend,
                             y=y, yend=y,
                             color=color[i],
                             lty=lty[i], lwd=1) +
                    
                    annotate("text", 
                             label=label, size=3,
                             x=xt, y=y, 
                             hjust=0, vjust=0.4,
                             color=color[i])
            }
        }
    }
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
    p = p +
        ggtitle(bquote(bold(.(type))~~'['*m^{3}*'.'*s^{-1}*']')) +
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
        scale_x_date(date_breaks=paste(as.character(datebreak), 
                                       'year', sep=' '),
Heraut Louis's avatar
Heraut Louis committed
                     date_minor_breaks=paste(as.character(dateminbreak), 
                                             'year', sep=' '),
                     guide='axis_minor',
                     date_labels="%Y",
                     limits=c(min(df_data_code$Date), 
                              max(df_data_code$Date)),
Heraut Louis's avatar
Heraut Louis committed
                     expand=c(0, 0))

    p = p +
Heraut Louis's avatar
Heraut Louis committed
        scale_y_continuous(breaks=seq(0, maxQ*10, dbrk),
                           limits=c(0, maxQ*1.1),
Heraut Louis's avatar
Heraut Louis committed
                           expand=c(0, 0),
                           labels=label_number(accuracy=accuracy))

    return(p)
}


text_panel = function(code, df_meta) {
    df_meta_code = df_meta[df_meta$code == code,]

Heraut Louis's avatar
Heraut Louis committed
    text1 = paste(
Heraut Louis's avatar
Heraut Louis committed
        "<b>", code, '</b>  -  ', df_meta_code$nom, ' &#40;',
        df_meta_code$region_hydro, '&#41;', 
Heraut Louis's avatar
Heraut Louis committed
        sep='')

    text2 = paste(
        "<b>",
Heraut Louis's avatar
Heraut Louis committed
        "Gestionnaire : ", df_meta_code$gestionnaire, "<br>", 
Heraut Louis's avatar
Heraut Louis committed
        "</b>",
        sep='')

    text3 = paste(
        "<b>",
Heraut Louis's avatar
Heraut Louis committed
        "Superficie : ", df_meta_code$surface_km2_IN, 
        ' (', df_meta_code$surface_km2_BH, ')', "  [km<sup>2</sup>] <br>",
        "X = ", df_meta_code$L93X_m_IN, 
        ' (', df_meta_code$L93X_m_BH, ')', "  [m ; Lambert 93]", 
Heraut Louis's avatar
Heraut Louis committed
        "</b>",
        sep='')
        
    text4 = paste(
        "<b>",
Heraut Louis's avatar
Heraut Louis committed
        "Altitude : ", df_meta_code$altitude_m_IN, 
        ' (', df_meta_code$altitude_m_BH, ')', "  [m]<br>",
        "Y = ", df_meta_code$L93Y_m_IN, 
        ' (', df_meta_code$L93Y_m_BH, ')', "  [m ; Lambert 93]",
Heraut Louis's avatar
Heraut Louis committed
        "</b>",
        sep='')

    text5 = paste(
        "<b>",
Heraut Louis's avatar
Heraut Louis committed
        "INRAE (Banque Hydro)<br>",
        "INRAE (Banque Hydro)",
Heraut Louis's avatar
Heraut Louis committed
        "</b>",
Heraut Louis's avatar
Heraut Louis committed
    gtext1 = richtext_grob(text1,
                           x=0, y=1,
                           margin=unit(c(t=5, r=5, b=0, l=5), "mm"),
                           hjust=0, vjust=1,
                           gp=gpar(col="#00A3A8", fontsize=14))

    gtext2 = richtext_grob(text2,
Heraut Louis's avatar
Heraut Louis committed
                           x=0, y=0.55,
Heraut Louis's avatar
Heraut Louis committed
                           margin=unit(c(t=0, r=5, b=0, l=5), "mm"),
                           hjust=0, vjust=1,
Heraut Louis's avatar
Heraut Louis committed
                           gp=gpar(col="grey20", fontsize=8))
Heraut Louis's avatar
Heraut Louis committed
    
    gtext3 = richtext_grob(text3,
                           x=0, y=1,
                           margin=unit(c(t=0, r=5, b=5, l=5), "mm"),
                           hjust=0, vjust=1,
                           gp=gpar(col="grey20", fontsize=9))
    
    gtext4 = richtext_grob(text4,
                           x=0, y=1,
                           margin=unit(c(t=0, r=5, b=5, l=5), "mm"),
                           hjust=0, vjust=1,
                           gp=gpar(col="grey20", fontsize=9))

    gtext5 = richtext_grob(text5,
                           x=0, y=1,
                           margin=unit(c(t=0, r=5, b=5, l=5), "mm"),
                           hjust=0, vjust=1,
                           gp=gpar(col="grey20", fontsize=9))
    
    gtext_merge = grid.arrange(grobs=list(gtext1, gtext2, gtext3, 
                                          gtext4, gtext5), 
                               layout_matrix=matrix(c(1, 1, 1,
                                                      2, 2, 2,
                                                      3, 4, 5), 
                                                    nrow=3, 
                                                    byrow=TRUE))
    return(gtext_merge)
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
matrice_panel = function (list_df2plot, df_meta, period) {
Heraut Louis's avatar
Heraut Louis committed
    nbp = length(list_df2plot)

    # Get all different stations code
    Code = levels(factor(df_meta$code))
Heraut Louis's avatar
Heraut Louis committed
    nCode = length(Code)

    nPeriod_max = 0
    Start_code = vector(mode='list', length=nCode)
    End_code = vector(mode='list', length=nCode)
    Code_code = vector(mode='list', length=nCode)
Heraut Louis's avatar
Heraut Louis committed
    Periods_code = vector(mode='list', length=nCode)
Heraut Louis's avatar
Heraut Louis committed

    df_trend = list_df2plot[[1]]$trend

    for (j in 1:nCode) {
        
        code = Code[j]

        df_trend_code = df_trend[df_trend$code == code,]
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
        Start = df_trend_code$period_start
        UStart = levels(factor(Start))
        
        End = df_trend_code$period_end
        UEnd = levels(factor(End))
        
        nPeriod = max(length(UStart), length(UEnd))

Heraut Louis's avatar
Heraut Louis committed
        Periods = c()
Heraut Louis's avatar
Heraut Louis committed

            for (i in 1:nPeriod) {
Heraut Louis's avatar
Heraut Louis committed
                Periods = append(Periods, 
                                 paste(Start[i], End[i], sep=' / '))
Heraut Louis's avatar
Heraut Louis committed
            }

        Start_code[[j]] = Start
        End_code[[j]] = End
        Code_code[[j]] = code
Heraut Louis's avatar
Heraut Louis committed
        Periods_code[[j]] = Periods
Heraut Louis's avatar
Heraut Louis committed
        
        if (nPeriod > nPeriod_max) {
            nPeriod_max = nPeriod
        }
    }

Heraut Louis's avatar
Heraut Louis committed

    TrendMean_code = array(rep(1, nPeriod_max*nbp*nCode),
                              dim=c(nPeriod_max, nbp, nCode))

    for (j in 1:nPeriod_max) {

        for (k in 1:nCode) {
            
            code = Code[k]
            
            for (i in 1:nbp) {
                
                df_data = list_df2plot[[i]]$data
                df_trend = list_df2plot[[i]]$trend
                p_threshold = list_df2plot[[i]]$p_threshold

                df_data_code = df_data[df_data$code == code,] 
                df_trend_code = df_trend[df_trend$code == code,]

                Start = Start_code[Code_code == code][[1]][j]
                End = End_code[Code_code == code][[1]][j]
                Periods = Periods_code[Code_code == code][[1]][j]

                df_data_code_per =
                    df_data_code[df_data_code$Date >= Start 
                                 & df_data_code$Date <= End,]

                df_trend_code_per = 
                    df_trend_code[df_trend_code$period_start == Start 
                                  & df_trend_code$period_end == End,]

                Ntrend = nrow(df_trend_code_per)
                if (Ntrend > 1) {
                    df_trend_code_per = df_trend_code_per[1,]
                }
                
                dataMean = mean(df_data_code_per$Qm3s, na.rm=TRUE)
                trendMean = df_trend_code_per$trend / dataMean

                TrendMean_code[j, i, k] = trendMean
            }
        }
    }

    minTrendMean = apply(TrendMean_code, c(1, 2), min, na.rm=TRUE)
    maxTrendMean = apply(TrendMean_code, c(1, 2), max, na.rm=TRUE)
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
    Periods_mat = c()
    NPeriod_mat = c()
Heraut Louis's avatar
Heraut Louis committed
    Type_mat = list()
Heraut Louis's avatar
Heraut Louis committed
    Code_mat = c()
Heraut Louis's avatar
Heraut Louis committed
    Pthresold_mat = c()
    TrendMean_mat = c()
    DataMean_mat = c()
Heraut Louis's avatar
Heraut Louis committed
    Fill_mat = c()
Heraut Louis's avatar
Heraut Louis committed
    Color_mat = c()

Heraut Louis's avatar
Heraut Louis committed
    for (j in 1:nPeriod_max) {

        for (code in Code) {
Heraut Louis's avatar
Heraut Louis committed
            
Heraut Louis's avatar
Heraut Louis committed
            for (i in 1:nbp) {
Heraut Louis's avatar
Heraut Louis committed
                df_data = list_df2plot[[i]]$data
Heraut Louis's avatar
Heraut Louis committed
                df_trend = list_df2plot[[i]]$trend
                p_threshold = list_df2plot[[i]]$p_threshold
                type = list_df2plot[[i]]$type
                
Heraut Louis's avatar
Heraut Louis committed
                df_data_code = df_data[df_data$code == code,] 
Heraut Louis's avatar
Heraut Louis committed
                df_trend_code = df_trend[df_trend$code == code,]
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
                Start = Start_code[Code_code == code][[1]][j]
                End = End_code[Code_code == code][[1]][j]
                Periods = Periods_code[Code_code == code][[1]][j]
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
                df_data_code_per =
                    df_data_code[df_data_code$Date >= Start 
                                 & df_data_code$Date <= End,]

Heraut Louis's avatar
Heraut Louis committed
                df_trend_code_per = 
                    df_trend_code[df_trend_code$period_start == Start 
                                  & df_trend_code$period_end == End,]
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
                Ntrend = nrow(df_trend_code_per)
                if (Ntrend > 1) {
                    df_trend_code_per = df_trend_code_per[1,]
                }
                
                dataMean = mean(df_data_code_per$Qm3s, na.rm=TRUE)
                trendMean = df_trend_code_per$trend / dataMean

Heraut Louis's avatar
Heraut Louis committed
                if (df_trend_code_per$p <= p_threshold){
Heraut Louis's avatar
Heraut Louis committed
                    color_res = get_color(trendMean, 
                                          minTrendMean[j, i],
                                          minTrendMean[j, i],
Heraut Louis's avatar
Heraut Louis committed
                                          palette_name='perso',
                                          reverse=FALSE)
                    fill = color_res$color
                    color = 'white'
Heraut Louis's avatar
Heraut Louis committed
                    Pthresold = p_thresold
Heraut Louis's avatar
Heraut Louis committed
                } else { 
                    fill = 'white'
Heraut Louis's avatar
Heraut Louis committed
                    color = 'grey85'  
Heraut Louis's avatar
Heraut Louis committed
                    Pthresold = NA
Heraut Louis's avatar
Heraut Louis committed
                }

Heraut Louis's avatar
Heraut Louis committed
                Periods_mat = append(Periods_mat, Periods)
                NPeriod_mat = append(NPeriod_mat, j)
Heraut Louis's avatar
Heraut Louis committed
                Type_mat = append(Type_mat, type)
                Code_mat = append(Code_mat, code)
Heraut Louis's avatar
Heraut Louis committed
                Pthresold_mat = append(Pthresold_mat, Pthresold)
                TrendMean_mat = append(TrendMean_mat, trendMean)
                DataMean_mat = append(DataMean_mat, dataMean)
Heraut Louis's avatar
Heraut Louis committed
                Fill_mat = append(Fill_mat, fill)
                Color_mat = append(Color_mat, color)
            }
Heraut Louis's avatar
Heraut Louis committed
        }
Heraut Louis's avatar
Heraut Louis committed
    }
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
    height = length(Code)
    width = nbp * 2 * nPeriod_max
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
    options(repr.plot.width=width, repr.plot.height=height)
Heraut Louis's avatar
Heraut Louis committed
    
Heraut Louis's avatar
Heraut Louis committed
    mat = ggplot() +
Heraut Louis's avatar
Heraut Louis committed
        
        theme(
Heraut Louis's avatar
Heraut Louis committed
            panel.background=element_rect(fill='white'),
            text=element_text(family='sans'),
            panel.border=element_blank(),
            
            panel.grid.major.y=element_blank(),
            panel.grid.major.x=element_blank(),
            
Heraut Louis's avatar
Heraut Louis committed
            axis.text.x=element_blank(),
            axis.text.y=element_blank(),
Heraut Louis's avatar
Heraut Louis committed
            
Heraut Louis's avatar
Heraut Louis committed
            axis.ticks.y=element_blank(),
            axis.ticks.x=element_blank(),
Heraut Louis's avatar
Heraut Louis committed
            
            ggh4x.axis.ticks.length.minor=rel(0.5),
            axis.ticks.length=unit(1.5, 'mm'),
            
            plot.title=element_text(size=9, vjust=-3, 
                                    hjust=-1E-3, color='grey20'), 
            
            axis.title.x=element_blank(),
            axis.title.y=element_blank(),
            
            axis.line.x=element_blank(),
            axis.line.y=element_blank(),
            
            plot.margin=margin(5, 5, 5, 5, unit="mm"),
            )

Heraut Louis's avatar
Heraut Louis committed
    # xt = -1
    # yt = height + 1.75
    # Title = bquote(bold(Territoire))
    
    # mat = mat +
    #     annotate("text", x=xt, y=yt,
    #              label=Title,
    #              hjust=0, vjust=0.5, 
    #              size=6, color="#00A3A8")
Heraut Louis's avatar
Heraut Louis committed
    
    for (j in 1:nPeriod_max) {
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
        Type_mat_per = Type_mat[NPeriod_mat == j]
        Code_mat_per = Code_mat[NPeriod_mat == j]
Heraut Louis's avatar
Heraut Louis committed
        Pthresold_mat_per = Pthresold_mat[NPeriod_mat == j]
        TrendMean_mat_per = TrendMean_mat[NPeriod_mat == j]
        DataMean_mat_per = DataMean_mat[NPeriod_mat == j]
Heraut Louis's avatar
Heraut Louis committed
        Fill_mat_per = Fill_mat[NPeriod_mat == j]
        Color_mat_per = Color_mat[NPeriod_mat == j]
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
        Xtmp = as.integer(factor(as.character(Type_mat_per)))
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
        Xm = Xtmp + (j - 1)*nbp*2
        X = Xtmp + (j - 1)*nbp*2 + nbp
Heraut Louis's avatar
Heraut Louis committed

        Y = as.integer(factor(Code_mat_per))

Heraut Louis's avatar
Heraut Louis committed
        x = Xm[1] - 0.25
        xend = X[length(X)] + 0.25
        y = height + 1
        yend = height + 1

        mat = mat +
            annotate("segment",
                     x=x, xend=xend,
                     y=y, yend=yend, 
                     color="grey40", size=0.35)
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
        xt = X[1] - 0.5
        yt = y + 0.15
        Start = period[[j]][1]
        End = period[[j]][2]
        periodName = bquote(bold(.(Start))~'/'~bold(.(End)))

        mat = mat +
            annotate("text", x=xt, y=yt,
                     label=periodName,
                     hjust=0.5, vjust=0.5, 
                     size=3, color='grey40')
            
Heraut Louis's avatar
Heraut Louis committed
        for (i in 1:length(X)) {
            mat = mat +
Heraut Louis's avatar
Heraut Louis committed
                gg_circle(r=0.45, xc=X[i], yc=Y[i],
Heraut Louis's avatar
Heraut Louis committed
                          fill=Fill_mat_per[i], color=Color_mat_per[i]) +
Heraut Louis's avatar
Heraut Louis committed
                gg_circle(r=0.45, xc=Xm[i], yc=Y[i],
                          fill='white', color='grey40')
Heraut Louis's avatar
Heraut Louis committed
        }
Heraut Louis's avatar
Heraut Louis committed

        for (i in 1:length(TrendMean_mat_per)) {
            trendMean = TrendMean_mat_per[i]
            trendC = round(trendMean*100, 2)

            if (!is.na(Pthresold_mat_per[i])) {
                Tcolor = 'white'
Heraut Louis's avatar
Heraut Louis committed
            } else {
Heraut Louis's avatar
Heraut Louis committed
                Tcolor = 'grey85'
Heraut Louis's avatar
Heraut Louis committed
            }
Heraut Louis's avatar
Heraut Louis committed
            
            dataMean = round(DataMean_mat_per[i], 2)
Heraut Louis's avatar
Heraut Louis committed

            mat = mat +
                annotate('text', x=X[i], y=Y[i],
Heraut Louis's avatar
Heraut Louis committed
                         label=trendC,
                         hjust=0.5, vjust=0.5, 
                         size=3, color=Tcolor) + 

                annotate('text', x=Xm[i], y=Y[i],
                         label=dataMean,
                         hjust=0.5, vjust=0.5, 
                         size=3, color='grey40')
        }

        for (i in 1:nbp) {
            type = list_df2plot[[i]]$type
            mat = mat +
                annotate('text', x=X[i], y=max(Y) + 0.6,
                         label=bquote(.(type)),
Heraut Louis's avatar
Heraut Louis committed
                         hjust=0.5, vjust=0, 
Heraut Louis's avatar
Heraut Louis committed
                         size=3.5, color='grey20') +
                
                annotate('text', x=Xm[i], y=max(Y) + 0.6,
                         label=bquote(.(type)*'b'),
                         hjust=0.5, vjust=0, 
                         size=3.5, color='grey20')  
Heraut Louis's avatar
Heraut Louis committed
        }
    }
Heraut Louis's avatar
Heraut Louis committed
    
    for (i in 1:length(Code)) {
Heraut Louis's avatar
Heraut Louis committed

        code = Code[i]
Heraut Louis's avatar
Heraut Louis committed
        name = df_meta[df_meta$code == code,]$nom
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
        mat = mat +
Heraut Louis's avatar
Heraut Louis committed
            annotate('text', x=-1, y=i,
Heraut Louis's avatar
Heraut Louis committed
                     label=bquote(bold(.(code))),
                     hjust=0, vjust=-0.1, 
                     size=3.5, color="#00A3A8") + 
Heraut Louis's avatar
Heraut Louis committed

            annotate('text', x=-1, y=i,
Heraut Louis's avatar
Heraut Louis committed
                     label=paste(substr(name, 1, 15), '...', sep=''),
                     hjust=0, vjust=1.1, 
                     size=2.5, color="#00A3A8")   
Heraut Louis's avatar
Heraut Louis committed
    }

Heraut Louis's avatar
Heraut Louis committed
    mat = mat +

    coord_fixed() +
Heraut Louis's avatar
Heraut Louis committed
    
Heraut Louis's avatar
Heraut Louis committed
    scale_x_continuous(limits=c(1 - rel(2), 
Heraut Louis's avatar
Heraut Louis committed
                                width + rel(0.5)),
                       expand=c(0, 0)) + 
Heraut Louis's avatar
Heraut Louis committed
        
Heraut Louis's avatar
Heraut Louis committed
    scale_y_continuous(limits=c(1 - rel(0.5), 
Heraut Louis's avatar
Heraut Louis committed
                                height + rel(2)),
Heraut Louis's avatar
Heraut Louis committed
                       expand=c(0, 0))
Heraut Louis's avatar
Heraut Louis committed
    
    return (mat)
}


Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed


get_color = function (value, min, max, ncolor=256, palette_name='perso', reverse=FALSE) {
    
    if (palette_name == 'perso') {
        palette = colorRampPalette(c(
            '#1a4157',
            '#00af9d',
            '#fbdd7e',
            '#fdb147',
            '#fd4659'
        ))(ncolor)
        
    } else {
        palette = colorRampPalette(brewer.pal(11, palette_name))(ncolor)
    }
Heraut Louis's avatar
Heraut Louis committed

    if (reverse) {
        palette = rev(palette)
    }
    
Heraut Louis's avatar
Heraut Louis committed
    palette_cold = palette[1:as.integer(ncolor/2)]
    palette_hot = palette[(as.integer(ncolor/2)+1):ncolor]
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
    ncolor_cold = length(palette_cold)
    ncolor_hot = length(palette_hot)
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
    if (value < 0) {
        idNorm = (value - min) / (0 - min)
        id = round(idNorm*(ncolor_cold - 1) + 1, 0)
        color = palette_cold[id]
    } else {
        idNorm = (value - 0) / (max - 0)
        id = round(idNorm*(ncolor_hot - 1) + 1, 0)
        color = palette_hot[id]
    }
Heraut Louis's avatar
Heraut Louis committed
    
    return(list(color=color, palette=palette))
Heraut Louis's avatar
Heraut Louis committed
}

void = ggplot() + geom_blank(aes(1,1)) +
    theme(
        plot.background = element_blank(), 
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(), 
        panel.border = element_blank(),
        panel.background = element_blank(),
        axis.title.x = element_blank(),
        axis.title.y = element_blank(),
        axis.text.x = element_blank(), 
        axis.text.y = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_blank()
    )
Heraut Louis's avatar
Heraut Louis committed



palette_tester = function () {

    n = 300
    X = 1:n
    Y = rep(0, times=n)

    palette = colorRampPalette(c(
        '#1a4157',
        '#00af9d',
        '#fbdd7e',
        '#fdb147',
        '#fd4659'
    ))(n)

    p = ggplot() + 
        geom_line(aes(x=X, y=Y), color=palette[X], size=10) +
        scale_y_continuous(expand=c(0, 0))

    ggsave(plot=p,
           path='/figures',
           filename=paste('palette_test', '.pdf', sep=''),
           width=10, height=10, units='cm', dpi=100)
}

# palette_teste()
Heraut Louis's avatar
Heraut Louis committed


get_power = function (value) {
    
    if (value > 1) {
        power = nchar(as.character(as.integer(value))) - 1
    } else {
        dec = gsub('0.', '', as.character(value), fixed=TRUE)
        ndec = nchar(dec)
        nnum = nchar(as.character(as.numeric(dec)))
        power = -(ndec - nnum + 1)
    }
    
    return(power)
}


gg_circle = function(r, xc, yc, color="black", fill=NA, ...) {
    x = xc + r*cos(seq(0, pi, length.out=100))
    ymax = yc + r*sin(seq(0, pi, length.out=100))
    ymin = yc + r*sin(seq(0, -pi, length.out=100))
    annotate("ribbon", x=x, ymin=ymin, ymax=ymax, color=color, fill=fill, ...)
}
Heraut Louis's avatar
Heraut Louis committed



gpct = function (pct, L, ref=NULL, shift=FALSE) {
    
    if (is.null(ref)) {
        minL = min(L, na.rm=TRUE)
    } else {
        minL = ref
    }
    
    maxL = max(L, na.rm=TRUE)
    spanL = maxL - minL
 
    xL = pct/100 * as.numeric(spanL)

    if (shift) {
        xL = xL + minL
    }
    return (xL)
}