datasheet.R

            if (trendC >= 0) {
                # Adds two space in order to compensate for the minus
                # sign that sometimes is present for the other periods
                trendC = paste('  ', trendC, sep='')
            }
            # Converts mean trend to character
            trendMeanC = as.character(format(round(trendMean*100, 2),
                                             nsmall=2))
            if (trendMeanC >= 0) {
                # Adds two space in order to compensate for the minus
                # sign that sometimes is present for the other periods
                trendMeanC = paste('  ', trendMeanC, sep='')
            }

            # Create temporary tibble with variable to plot legend
            leg_trendtmp = tibble(x=x, xend=xend, 
                                  y=y, yend=yend, 
                                  xt=xt,
                                  trendC=trendC,
                                  powerC=powerC,
                                  spaceC=spaceC,
                                  trendMeanC=trendMeanC,
                                  pValC=pValC,
                                  xminR=xminR, yminR=yminR,
                                  xmaxR=xmaxR, ymaxR=ymaxR,
                                  period=i)
            # Bind it to the main tibble to store it with other period
            leg_trend = bind_rows(leg_trend, leg_trendtmp)  
        }

        # For all periods
        for (i in 1:nPeriod_trend) {
            # Extract the trend of the current sub period
            leg_trend_per = leg_trend[leg_trend$period == i,]

            # Plot the background for legend
            p = p +
                geom_rect(data=leg_trend_per,
                          aes(xmin=xminR, 
                              ymin=yminR, 
                              xmax=xmaxR, 
                              ymax=ymaxR),
                          linetype=0, fill='white', alpha=0.5)
        }
        
        # For all periods
        for (i in 1:nPeriod_trend) {
            # Extract the trend of the current sub period
            leg_trend_per = leg_trend[leg_trend$period == i,]

            # Get the character variable for naming the trend
            trendC = leg_trend_per$trendC
            powerC = leg_trend_per$powerC
            spaceC = leg_trend_per$spaceC
            trendMeanC = leg_trend_per$trendMeanC
            pValC = leg_trend_per$pValC

            # If it is a flow variable
            if (type == 'sévérité') {
                # Create the name of the trend
                label = bquote(bold(.(trendC)~'x'~'10'^{.(powerC)}*.(spaceC))~'['*m^{3}*'.'*s^{-1}*'.'*an^{-1}*']'~~bold(.(trendMeanC))~'[%.'*an^{-1}*']')
                    
            # If it is a date variable
            } else if ( type == 'saisonnalité') {
                # Create the name of the trend
                label = bquote(bold(.(trendC)~'x'~'10'^{.(powerC)}*.(spaceC))~'[jour.'*an^{-1}*']')
            }

            # Plot the trend symbole and value of the legend
            p = p +
                annotate("segment",
                         x=leg_trend_per$x, xend=leg_trend_per$xend,
                         y=leg_trend_per$y, yend=leg_trend_per$yend,
                         color=color[i],
                         linetype='solid',
                         lwd=0.8) +

                annotate("text",
                         label=label, size=2.8,
                         x=leg_trend_per$xt, y=leg_trend_per$y, 
                         hjust=0, vjust=0.5,
                         color=color[i])
        }

        # For all periods
        for (i in 1:nPeriod_trend) {
            # Extract the trend of the current sub period
            plot_trend_per = plot_trend[plot_trend$period == i,]
            
            # Plot the line of white background of each trend
            p = p + 
                geom_line(data=plot_trend_per, 
                          aes(x=abs, y=ord),
                          color='white',
                          linetype='solid',
                          size=1.5,
                          lineend="round")
        }

        # For all periods
        for (i in 1:nPeriod_trend) {
            # Extract the trend of the current sub period
            plot_trend_per = plot_trend[plot_trend$period == i,]

            # Plot the line of trend
            p = p + 
                geom_line(data=plot_trend_per, 
                          aes(x=abs, y=ord),
                          color=color[i],
                          linetype='solid',
                          size=0.75,
                          lineend="round")
        }
    }

    # Y axis title
    # If it is a flow variable
    if (type == 'sévérité') {
        p = p +
            ylab(bquote(bold(.(var))~~'['*m^{3}*'.'*s^{-1}*']'))
    # If it is a date variable
    } else if (type == 'saisonnalité') {
        p = p +
            ylab(bquote(bold(.(var))~~"[jour de l'année]"))
    }
    
    if (!last & !first) {
        p = p + 
            theme(axis.text.x=element_blank())
    }

    if (first) {
        position = 'top'
    } else {
        position = 'bottom'
    }

    if (is.null(axis_xlim)) {
        limits = c(min(df_data_code$Date), max(df_data_code$Date))
    } else {
        limits = axis_xlim
    }

    # Parameters of the x axis contain the limit of the date data
    p = p +
        scale_x_date(breaks=seq(minDate_lim, maxDate_lim,
                                by=paste(breakDate, 'years')),
                     minor_breaks=seq(minor_minDate_lim,
                                      minor_maxDate_lim,
                                      by=paste(minor_breakDate,
                                               'years')),
                     guide='axis_minor',
                     date_labels="%Y",
                     limits=limits,
                     position=position, 
                     expand=c(0, 0))

    
    
    # If it is a date variable 
    if (type == 'saisonnalité') {
        # The number of digit is 6 because months are display
        # with 3 characters
        Nspace = 6
        
        prefix = strrep(' ', times=NspaceMax-Nspace)
        accuracy = NULL
        
    # If it is a flow variable
    } else if (type == 'sévérité') {
        # Gets the max number of digit on the label
        maxtmp = max(df_data_code$Value, na.rm=TRUE)
        # Taking into account of the augmentation of
        # max for the window
        maxtmp = maxtmp * (1 + lim_pct/100)

        # If the max is greater than 10
        if (maxtmp >= 10) {
            # The number of digit is the magnitude plus
            # the first number times 2
            Nspace = (get_power(maxtmp) + 1)*2
            # Plus spaces between thousands hence every 8 digits
            Nspace = Nspace + as.integer(Nspace/8)            
            # Gets the associated number of white space
            prefix = strrep(' ', times=NspaceMax-Nspace)
            # The accuracy is 1
            accuracy = 1
            
        # If the max is less than 10 and greater than 1
        } else if (maxtmp < 10 & maxtmp >= 1) {
            # The number of digit is the magnitude plus
            # the first number times 2 plus 1 for the dot
            # and 2 for the first decimal
            Nspace = (get_power(maxtmp) + 1)*2 + 3
            # Gets the associated number of white space
            prefix = strrep(' ', times=NspaceMax-Nspace)
            # The accuracy is 0.1
            accuracy = 0.1
            
        # If the max is less than 1 (and obviously more than 0)
        } else if (maxtmp < 1) {
            # Fixes the number of significant decimals to 3
            maxtmp = signif(maxtmp, 3)
            # The number of digit is the number of character
            # of the max times 2 minus 1 for the dots that
            # count just 1 space
            Nspace = nchar(as.character(maxtmp))*2 - 1
            # Gets the associated number of white space
            prefix = strrep(' ', times=NspaceMax-Nspace)
            # Computes the accuracy
            accuracy = 10^(-nchar(as.character(maxtmp))+2)
        }
    }
    
    # Parameters of the y axis
    # If it is a flow variable
    if (type == 'sévérité') {        
        p = p +
            scale_y_continuous(breaks=seq(minQ_lim, maxQ_lim, breakQ),
                               limits=c(minQ_win, maxQ_win),
                               expand=c(0, 0),
                               labels=number_format(accuracy=accuracy,
                                                    prefix=prefix))
    # If it is a date variable
    } else if (type == 'saisonnalité') {
        # monthNum = as.numeric(format(seq(as.Date(minQ_lim),
                                       # as.Date(maxQ_lim),
                                       # by=paste(breakQ, 'days')),
        # "%m"))

        monthStart = as.Date(paste(substr(as.Date(minQ_lim), 1, 7),
                                   '-01', sep=''))
        monthEnd = as.Date(paste(substr(as.Date(maxQ_lim), 1, 7),
                                 '-01', sep=''))

        byMonth = round(breakQ/30.4, 0)
        if (byMonth == 0) {
            byMonth = 1
        }
        
        breaksDate = seq(monthStart, monthEnd,
                         by=paste(byMonth, 'months'))
        breaksNum = as.numeric(breaksDate)
        breaksMonth = as.numeric(format(breaksDate, "%m"))

        monthName = c('Jan', 'Fév', 'Mar', 'Avr', 'Mai', 'Jui',
                      'Jui', 'Aou', 'Sep', 'Oct', 'Nov', 'Déc')      
        monthName = paste(prefix, monthName, sep='')
        
        labels = monthName[breaksMonth]
        
        p = p +
            scale_y_continuous(breaks=breaksNum,
                               limits=c(minQ_win, maxQ_win),
                               labels=labels,  
                               expand=c(0, 0))
        
    }
    return(p)
}

### 2.2. Info panel __________________________________________________
# Plots the header that regroups all the info on the station
info_panel = function(list_df2plot, df_meta, trend_period, mean_period, periodHyd, df_shapefile, codeLight, df_data_code=NULL) {

    # If there is a data serie for the given code
    if (!is.null(df_data_code)) {
        # Computes the hydrograph
        hyd = hydrograph_panel(df_data_code, period=periodHyd,
                               margin=margin(t=0, r=0, b=0, l=5,
                                             unit="mm"))
    # Otherwise
    } else {
        # Puts it blank
        hyd = void
    }

    # Computes the map associated to the station
    map =  map_panel(list_df2plot,
                     df_meta,
                     trend_period=trend_period,
                     mean_period=mean_period,
                     df_shapefile=df_shapefile,
                     codeLight=codeLight,
                     margin=margin(t=0, r=-12, b=0, l=0, unit="mm"),
                     showSea=FALSE,
                     verbose=FALSE)
    
    # Gets the metadata about the station
    df_meta_code = df_meta[df_meta$code == codeLight,]
    # Extracts the name
    nom = df_meta_code$nom
    # Corrects some errors about the formatting of title with dash
    nom = gsub("-", "-&nbsp;", nom)

    # Computes the time span of data, the start and the end
    duration = as.numeric(format(as.Date(df_meta_code$fin), "%Y")) -
        as.numeric(format(as.Date(df_meta_code$debut), "%Y"))
    debut = format(as.Date(df_meta_code$debut), "%d/%m/%Y")
    fin = format(as.Date(df_meta_code$fin), "%d/%m/%Y")

    # Name of the datasheet
    text1 = paste(
        "<b>", codeLight, '</b>  -  ', nom,
        sep='')

    # Subitle info
    text2 = paste(
        "<b>",
        "Gestionnaire : ", df_meta_code$gestionnaire, "<br>",
        "Région hydro : ", df_meta_code$region_hydro,
        "</b>",
        sep='')

    # Spatial info about station
    text3 = paste(
        "<b>",
        "Superficie : ", df_meta_code$surface_km2_BH, "  [km<sup>2</sup>] <br>",
        "Altitude : ", df_meta_code$altitude_m_BH, "  [m]<br>",
        "X = ", df_meta_code$L93X_m_BH, "  [m ; Lambert 93]<br>",
        "Y = ", df_meta_code$L93Y_m_BH, "  [m ; Lambert 93]",
        "</b>",
        sep='')

    # Time info about station
    text4 = paste(
        "<b>",
        "Date de début : ", debut, "<br>",
        "Date de fin : ", fin, "<br>",
        "Nombre d'années : ", duration, "  [ans]", "<br>",
        "Taux de lacunes : ", signif(df_meta_code$tLac100, 2), "  [%]",
        "</b>",
        sep='')

    # Converts all texts to graphical object in the right position
    gtext1 = richtext_grob(text1,
                           x=0, y=1,
                           margin=unit(c(t=0, r=5, b=0, l=0), "mm"),
                           hjust=0, vjust=1,
                           gp=gpar(col="#00A3A8", fontsize=14))
    
    gtext2 = richtext_grob(text2,
                           x=0, y=1.25,
                           margin=unit(c(t=0, r=0, b=0, l=0), "mm"),
                           hjust=0, vjust=1,
                           gp=gpar(col="grey20", fontsize=8))
    
    gtext3 = richtext_grob(text3,
                           x=0, y=1,
                           margin=unit(c(t=0, r=0, b=0, l=0), "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=0, b=0, l=0), "mm"),
                           hjust=0, vjust=1,
                           gp=gpar(col="grey20", fontsize=9))

    # Makes a list of all plots
    P = list(gtext1, gtext2, gtext3, gtext4, hyd, map)
    # P = list(void, void, void, void, void, void, void)
    
    # Creates the matrix layout
    LM = matrix(c(1, 1, 1, 6,
                  2, 2, 5, 6,
                  3, 4, 5, 6,
                  3, 4, 5, 6),
                nrow=4, 
                byrow=TRUE)
    # And sets the relative height of each plot
    heights = rep(1, times=nrow(LM))
    # heights[2] = 0.1
    heights[2] = 0.8

    # Arranges all the graphical objetcs
    plot = grid.arrange(grobs=P,
                        layout_matrix=LM,
                        heights=heights)
    # Return the plot object
    return(plot)
} 

### 2.3. Hydrograph panel ____________________________________________
# Creates a hydrograph for a station with the data serie of flow
hydrograph_panel = function (df_data_code, period, margin=NULL) {

    # Computes the hydrograph
    res_hydrograph = get_hydrograph(df_data_code, period=period)
    # Extracts the results
    monthMean = res_hydrograph$QM
    regime_hydro = res_hydrograph$meta
    
    # Vector of month index
    monthNum = 1:12
    # Vector of month name abbreviation
    monthName = c("J", "F", "M", "A", "M", "J",
                  "J", "A", "S", "O", "N", "D")

    # Open a new plot with the personalise theme
    hyd = ggplot() + theme_ash +
        # Theme modification
        theme(
            # plot.background=element_rect(fill=NA, color="#EC4899"),
            panel.border=element_blank(),
            axis.text.x=element_text(margin=unit(c(0, 0, 0, 0), "mm"),
                                     vjust=1, hjust=0.5),
            axis.ticks.x=element_blank(),
            axis.line.y=element_line(color='grey85', size=0.3),
            plot.title=element_text(size=8, vjust=-0.5, 
                                    hjust=-1E-3, color='grey40'),
            axis.title.y=element_text(size=8, vjust=0, 
                                      hjust=0.5,
                                      color='grey40')) +
        
        # Adds a title to the y axis
        ggtitle(regime_hydro) +
        # Y axis title
        ylab(bquote(bold('QM')~~'['*m^{3}*'.'*s^{-1}*']'))
    
    # If there is no margins specified
    if (is.null(margin)) {
        # Sets all margins to 0
        hyd = hyd + 
            theme(plot.margin=margin(t=0, r=0, b=0, l=0, unit="mm"))
    # Otherwise
    } else {
        # Sets margins to the given ones
        hyd = hyd + 
            theme(plot.margin=margin)
    }

    hyd = hyd +
        # Plots the bar
        geom_bar(aes(x=monthNum, y=monthMean), 
                 stat='identity',
                 fill="grey70",
                 width=0.75, size=0.2) +
        # X axis
        scale_x_continuous(breaks=monthNum,
                           labels=monthName,
                           limits=c(0, max(monthNum)+0.5),
                           expand=c(0, 0)) + 
        # Y axis
        scale_y_continuous(limits=c(0, max(monthMean)),
                           expand=c(0, 0))
    # Returns the plot
    return (hyd)
}