layout.R 15 KB
Newer Older
Heraut Louis's avatar
Heraut Louis committed
# \\\
# Copyright 2021-2022 Louis Hraut*1
#
# *1   INRAE, France
#      louis.heraut@inrae.fr
#
# This file is part of ash R toolbox.
#
# ash R toolbox is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
#
# ash R toolbox is distributed in the hope that it will be useful, but 
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with ash R toolbox.  If not, see <https://www.gnu.org/licenses/>.
# ///
#
#
# plotting/layout.R
#
Heraut Louis's avatar
Heraut Louis committed
# Regroups general parameters about plotting like the theme used ang
# color management. It mainly deals with the calling to specific
# plotting functions and the organisation of each plot for the
# generation of the PDF.
Heraut Louis's avatar
Heraut Louis committed


Heraut Louis's avatar
Heraut Louis committed
# Usefull library
library(ggplot2)
library(scales)
library(qpdf)
library(gridExtra)
library(gridtext)
library(dplyr)
library(grid)
library(ggh4x)
library(RColorBrewer)
Heraut Louis's avatar
Heraut Louis committed
library(rgdal)
library(shadowtext)
Heraut Louis's avatar
Heraut Louis committed

# Sourcing R file
Heraut Louis's avatar
Heraut Louis committed
source('plotting/datasheet.R', encoding='latin1')
Heraut Louis's avatar
Heraut Louis committed
source('plotting/map.R', encoding='latin1')
source('plotting/matrix.R', encoding='latin1')
Heraut Louis's avatar
Heraut Louis committed
source('plotting/break.R', encoding='latin1')
Heraut Louis's avatar
Heraut Louis committed


## 1. PERSONALISATION
### 1.1. Personal theme
theme_ash =
    theme(
        # White background
        panel.background=element_rect(fill='white'),
        # Font
        text=element_text(family='sans'),
        # Border of plot
        panel.border = element_rect(color="grey85",
                                    fill=NA,
                                    size=0.7),
        # Grid
        panel.grid.major.x=element_blank(),
        panel.grid.major.y=element_blank(),
        # Ticks marker
        axis.ticks.x=element_line(color='grey75', size=0.3),
        axis.ticks.y=element_line(color='grey75', size=0.3),
        # Ticks label
        axis.text.x=element_text(color='grey40'),
        axis.text.y=element_text(color='grey40'),
        # Ticks length
        axis.ticks.length=unit(1.5, 'mm'),
        # Ticks minor
        ggh4x.axis.ticks.length.minor=rel(0.5),
        # Title
        plot.title=element_text(size=9, vjust=-2, 
                                hjust=-1E-3, color='grey20'), 
        # Axis title
        axis.title.x=element_blank(),
        axis.title.y=element_blank(),
        # Axis line
        axis.line.x=element_blank(),
        axis.line.y=element_blank(),
        )

### 1.2. Color palette
Heraut Louis's avatar
Heraut Louis committed
palette_perso = c('#0f3b57', # cold
Heraut Louis's avatar
Heraut Louis committed
                  '#1d7881',
                  '#80c4a9',
Heraut Louis's avatar
Heraut Louis committed
                  '#e2dac6', # mid
Heraut Louis's avatar
Heraut Louis committed
                  '#fadfad',
                  '#d08363',
Heraut Louis's avatar
Heraut Louis committed
                  '#7e392f') # hot
Heraut Louis's avatar
Heraut Louis committed


Heraut Louis's avatar
Heraut Louis committed
## 2. USEFUL GENERICAL PLOT
### 2.1. Void plot
# A plot completly blank
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()
    )

### 2.2. Circle
# Allow to draw circle in ggplot2 with a radius and a center position
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, ...)
}


## 3. LAYOUT
# Generates a PDF that gather datasheets, map and summarize matrix about the trend analyses realised on selected stations
datasheet_layout = function (df_data, df_meta, layout_matrix,
                             isplot=c('datasheet', 'matrix', 'map'),
                             figdir='', filedir_opt='', filename_opt='',
                             variable='', df_trend=NULL,
                             p_threshold=0.1, unit2day=365.25, type='',
                             trend_period=NULL, mean_period=NULL,
                             axis_xlim=NULL, missRect=FALSE,
                             time_header=NULL, info_header=TRUE,
                             info_ratio=1, time_ratio=2, var_ratio=3,
                             df_shapefile=NULL) {

    # Name of the document
Heraut Louis's avatar
Heraut Louis committed
    outfile = "Panels"
Heraut Louis's avatar
Heraut Louis committed
    # If there is an option to mention in the filename it adds it
Heraut Louis's avatar
Heraut Louis committed
    if (filename_opt != '') {
        outfile = paste(outfile, '_', filename_opt, sep='')
    }
Heraut Louis's avatar
Heraut Louis committed
    # Add the 'pdf' extensionto the name
Heraut Louis's avatar
Heraut Louis committed
    outfile = paste(outfile, '.pdf', sep='')

    # If there is not a dedicated figure directory it creats one
    outdir = file.path(figdir, filedir_opt, sep='')
    if (!(file.exists(outdir))) {
        dir.create(outdir)
    }

Heraut Louis's avatar
Heraut Louis committed
    # Names of a temporary directory to store all the independent pages
Heraut Louis's avatar
Heraut Louis committed
    outdirTmp = file.path(outdir, 'tmp')
Heraut Louis's avatar
Heraut Louis committed
    # Creates it if it does not exist
Heraut Louis's avatar
Heraut Louis committed
    if (!(file.exists(outdirTmp))) {
        dir.create(outdirTmp)
Heraut Louis's avatar
Heraut Louis committed
    # If it already exists it deletes the pre-existent directory
    # and recreates one
Heraut Louis's avatar
Heraut Louis committed
    } else {
        unlink(outdirTmp, recursive=TRUE)
        dir.create(outdirTmp)
Heraut Louis's avatar
Heraut Louis committed
    }

Heraut Louis's avatar
Heraut Louis committed
    # Number of variable studied
Heraut Louis's avatar
Heraut Louis committed
    nbp = length(df_data)

Heraut Louis's avatar
Heraut Louis committed
    # Convert data tibble to list of tibble if it is not the case
Heraut Louis's avatar
Heraut Louis committed
    if (all(class(df_data) != 'list')) {
        df_data = list(df_data)
    }

Heraut Louis's avatar
Heraut Louis committed
    if (all(class(df_trend) != 'list')) {
        df_trend = list(df_trend)
        if (length(df_trend) == 1) {
Heraut Louis's avatar
Heraut Louis committed
            df_trend = replicate(nbp, df_trend)
        }}

    if (all(class(p_threshold) != 'list')) {
        p_threshold = list(p_threshold)
Heraut Louis's avatar
Heraut Louis committed
        # If there is only one value
Heraut Louis's avatar
Heraut Louis committed
        if (length(p_threshold) == 1) {
Heraut Louis's avatar
Heraut Louis committed
            # Replicates the value the number of times that there
            # is of studied variables
Heraut Louis's avatar
Heraut Louis committed
            p_threshold = replicate(nbp, p_threshold)
        }}
Heraut Louis's avatar
Heraut Louis committed

    # Same
Heraut Louis's avatar
Heraut Louis committed
    if (all(class(unit2day) != 'list')) {
        unit2day = list(unit2day)
        if (length(unit2day) == 1) {
            unit2day = replicate(nbp, unit2day)
        }}

    if (all(class(type) != 'list')) {
        type = list(type)
        if (length(type) == 1) {
            type = replicate(nbp, type)
        }}

    if (all(class(missRect) != 'list')) {
        missRect = list(missRect)
        if (length(missRect) == 1) {
            missRect = replicate(nbp, missRect)
        }}

Heraut Louis's avatar
Heraut Louis committed
    # Creates a blank list to store all the data of each type of plot
Heraut Louis's avatar
Heraut Louis committed
    list_df2plot = vector(mode='list', length=nbp)

Heraut Louis's avatar
Heraut Louis committed
    # For all the type of graph / number of studied variables
Heraut Louis's avatar
Heraut Louis committed
    for (i in 1:nbp) {
Heraut Louis's avatar
Heraut Louis committed
        # Creates a list that gather all the info for one type of graph
Heraut Louis's avatar
Heraut Louis committed
        df2plot = list(data=df_data[[i]], 
                       trend=df_trend[[i]],
                       p_threshold=p_threshold[[i]],
                       unit2day=unit2day[[i]],
                       type=type[[i]],
                       missRect=missRect[[i]])
Heraut Louis's avatar
Heraut Louis committed
        # Stores it
Heraut Louis's avatar
Heraut Louis committed
        list_df2plot[[i]] = df2plot
    }

Heraut Louis's avatar
Heraut Louis committed
    # If datasheets needs to be plot
Heraut Louis's avatar
Heraut Louis committed
    if ('datasheet' %in% isplot) {
Heraut Louis's avatar
Heraut Louis committed
        datasheet_panel(list_df2plot, df_meta, trend_period, info_header=info_header, time_header=time_header, layout_matrix=layout_matrix, info_ratio=info_ratio, time_ratio=time_ratio, var_ratio=var_ratio, outdirTmp=outdirTmp)
Heraut Louis's avatar
Heraut Louis committed
    }
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
    # If summarize matrix needs to be plot
Heraut Louis's avatar
Heraut Louis committed
    if ('matrix' %in% isplot) {
Heraut Louis's avatar
Heraut Louis committed
        matrix_panel(list_df2plot, df_meta, trend_period, mean_period,
Heraut Louis's avatar
Heraut Louis committed
                      slice=12, outdirTmp=outdirTmp, A3=TRUE)
    }
Heraut Louis's avatar
Heraut Louis committed

    # If map needs to be plot
Heraut Louis's avatar
Heraut Louis committed
    if ('map' %in% isplot) {
        map_panel(list_df2plot, 
                  df_meta,
                  idPer=length(trend_period),
Heraut Louis's avatar
Heraut Louis committed
                  df_shapefile=df_shapefile,
Heraut Louis's avatar
Heraut Louis committed
                  outdirTmp=outdirTmp,
                  margin=margin(t=5, r=0, b=5, l=5, unit="mm"))
    }
Heraut Louis's avatar
Heraut Louis committed
    
Heraut Louis's avatar
Heraut Louis committed
    # Combine independant pages into one PDF
Heraut Louis's avatar
Heraut Louis committed
    pdf_combine(input=file.path(outdirTmp, list.files(outdirTmp)),
                output=file.path(outdir, outfile))
} 
Heraut Louis's avatar
Heraut Louis committed


Heraut Louis's avatar
Heraut Louis committed
## 4. COLOR MANAGEMENT
### 4.1. Color on colorbar
# Returns a color of a palette corresponding to a value included
# between the min and the max of the variable
Heraut Louis's avatar
Heraut Louis committed
get_color = function (value, min, max, ncolor=256, palette_name='perso', reverse=FALSE) {
Heraut Louis's avatar
Heraut Louis committed

    # If the value is a NA return NA color
    if (is.na(value)) {
        return (NA)
    }
Heraut Louis's avatar
Heraut Louis committed
    
Heraut Louis's avatar
Heraut Louis committed
    # If the palette chosen is the personal ones
Heraut Louis's avatar
Heraut Louis committed
    if (palette_name == 'perso') {
        colorList = palette_perso
Heraut Louis's avatar
Heraut Louis committed
    # Else takes the palette corresponding to the name given
Heraut Louis's avatar
Heraut Louis committed
    } else {
        colorList = brewer.pal(11, palette_name)
    }
    
Heraut Louis's avatar
Heraut Louis committed
    # Gets the number of discrete colors in the palette
Heraut Louis's avatar
Heraut Louis committed
    nSample = length(colorList)
Heraut Louis's avatar
Heraut Louis committed
    # Recreates a continuous color palette
Heraut Louis's avatar
Heraut Louis committed
    palette = colorRampPalette(colorList)(ncolor)
Heraut Louis's avatar
Heraut Louis committed
    # Separates it in the middle to have a cold and a hot palette
Heraut Louis's avatar
Heraut Louis committed
    Sample_hot = 1:(as.integer(nSample/2)+1)
    Sample_cold = (as.integer(nSample/2)+1):nSample
    palette_hot = colorRampPalette(colorList[Sample_hot])(ncolor)
    palette_cold = colorRampPalette(colorList[Sample_cold])(ncolor)

Heraut Louis's avatar
Heraut Louis committed
    # Reverses the palette if it needs to be
Heraut Louis's avatar
Heraut Louis committed
    if (reverse) {
        palette = rev(palette)
        palette_hot = rev(palette_hot)
        palette_cold = rev(palette_cold)
    }

Heraut Louis's avatar
Heraut Louis committed
    # Computes the absolute max
Heraut Louis's avatar
Heraut Louis committed
    maxAbs = max(abs(max), abs(min))
Heraut Louis's avatar
Heraut Louis committed

    # If the value is negative
Heraut Louis's avatar
Heraut Louis committed
    if (value < 0) {
Heraut Louis's avatar
Heraut Louis committed
        # Gets the relative position of the value in respect
        # to its span
Heraut Louis's avatar
Heraut Louis committed
        idNorm = (value + maxAbs) / maxAbs
Heraut Louis's avatar
Heraut Louis committed
        # The index corresponding
Heraut Louis's avatar
Heraut Louis committed
        id = round(idNorm*(ncolor - 1) + 1, 0)
Heraut Louis's avatar
Heraut Louis committed
        # The associated color
Heraut Louis's avatar
Heraut Louis committed
        color = palette_cold[id]
Heraut Louis's avatar
Heraut Louis committed
    # Same if it is a positive value
Heraut Louis's avatar
Heraut Louis committed
    } else {
        idNorm = value / maxAbs
        id = round(idNorm*(ncolor - 1) + 1, 0)
        color = palette_hot[id]
    }
    return(color)
}

Heraut Louis's avatar
Heraut Louis committed
### 4.2. Colorbar
# Returns the colorbar but also positions, labels and colors of some
# ticks along it 
Heraut Louis's avatar
Heraut Louis committed
get_palette = function (min, max, ncolor=256, palette_name='perso', reverse=FALSE, nbTick=10) {
    
Heraut Louis's avatar
Heraut Louis committed
    # If the palette chosen is the personal ones
Heraut Louis's avatar
Heraut Louis committed
    if (palette_name == 'perso') {
        colorList = palette_perso
Heraut Louis's avatar
Heraut Louis committed
    # Else takes the palette corresponding to the name given
Heraut Louis's avatar
Heraut Louis committed
    } else {
        colorList = brewer.pal(11, palette_name)
    }
    
Heraut Louis's avatar
Heraut Louis committed
    # Gets the number of discrete colors in the palette
Heraut Louis's avatar
Heraut Louis committed
    nSample = length(colorList)
Heraut Louis's avatar
Heraut Louis committed
    # Recreates a continuous color palette
Heraut Louis's avatar
Heraut Louis committed
    palette = colorRampPalette(colorList)(ncolor)
Heraut Louis's avatar
Heraut Louis committed
    # Separates it in the middle to have a cold and a hot palette
Heraut Louis's avatar
Heraut Louis committed
    Sample_hot = 1:(as.integer(nSample/2)+1)
    Sample_cold = (as.integer(nSample/2)+1):nSample
    palette_hot = colorRampPalette(colorList[Sample_hot])(ncolor)
    palette_cold = colorRampPalette(colorList[Sample_cold])(ncolor)

Heraut Louis's avatar
Heraut Louis committed
    # Reverses the palette if it needs to be
Heraut Louis's avatar
Heraut Louis committed
    if (reverse) {
        palette = rev(palette)
        palette_hot = rev(palette_hot)
        palette_cold = rev(palette_cold)
Heraut Louis's avatar
Heraut Louis committed
    }
Heraut Louis's avatar
Heraut Louis committed

Heraut Louis's avatar
Heraut Louis committed
    # If the min and the max are below zero
Heraut Louis's avatar
Heraut Louis committed
    if (min < 0 & max < 0) {
Heraut Louis's avatar
Heraut Louis committed
        # The palette show is only the cold one
Heraut Louis's avatar
Heraut Louis committed
        paletteShow = palette_cold
Heraut Louis's avatar
Heraut Louis committed
    # If the min and the max are above zero
Heraut Louis's avatar
Heraut Louis committed
    } else if (min > 0 & max > 0) {
Heraut Louis's avatar
Heraut Louis committed
        # The palette show is only the hot one
Heraut Louis's avatar
Heraut Louis committed
        paletteShow = palette_hot
Heraut Louis's avatar
Heraut Louis committed
    # Else it is the entire palette that is shown
Heraut Louis's avatar
Heraut Louis committed
    } else {
        paletteShow = palette
    }

Heraut Louis's avatar
Heraut Louis committed
    # The position of ticks is between 0 and 1
Heraut Louis's avatar
Heraut Louis committed
    posTick = seq(0, 1, length.out=nbTick)
Heraut Louis's avatar
Heraut Louis committed
    # Blank vector to store corresponding labels and colors
Heraut Louis's avatar
Heraut Louis committed
    labTick = c()
    colTick = c()
Heraut Louis's avatar
Heraut Louis committed
    # For each tick
Heraut Louis's avatar
Heraut Louis committed
    for (i in 1:nbTick) {
Heraut Louis's avatar
Heraut Louis committed
        # Computes the graduation between the min and max
Heraut Louis's avatar
Heraut Louis committed
        lab = (i-1)/(nbTick-1) * (max - min) + min
Heraut Louis's avatar
Heraut Louis committed
        # Gets the associated color
Heraut Louis's avatar
Heraut Louis committed
        col = get_color(lab, min=min, max=max,
                        ncolor=ncolor,
                        palette_name=palette_name,
                        reverse=reverse)
Heraut Louis's avatar
Heraut Louis committed
        # Stores them
        labTick = c(labTick, lab)
        colTick = c(colTick, col)
Heraut Louis's avatar
Heraut Louis committed
    }
Heraut Louis's avatar
Heraut Louis committed
    # List of results
    res = list(palette=paletteShow, posTick=posTick,
               labTick=labTick, colTick=colTick)
    return(res)
Heraut Louis's avatar
Heraut Louis committed
}

Heraut Louis's avatar
Heraut Louis committed
### 4.3. Palette tester
# Allows to display the current personal palette
Heraut Louis's avatar
Heraut Louis committed
palette_tester = function (n=256) {

Heraut Louis's avatar
Heraut Louis committed
    # An arbitrary x vector
Heraut Louis's avatar
Heraut Louis committed
    X = 1:n
Heraut Louis's avatar
Heraut Louis committed
    # All the same arbitrary y position to create a colorbar
Heraut Louis's avatar
Heraut Louis committed
    Y = rep(0, times=n)

Heraut Louis's avatar
Heraut Louis committed
    # Recreates a continuous color palette
Heraut Louis's avatar
Heraut Louis committed
    palette = colorRampPalette(palette_perso)(n)

Heraut Louis's avatar
Heraut Louis committed
    # Open a plot
Heraut Louis's avatar
Heraut Louis committed
    p = ggplot() + 
Heraut Louis's avatar
Heraut Louis committed
        # Make the theme blank
        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()
        ) +
        # Plot the palette
Heraut Louis's avatar
Heraut Louis committed
        geom_line(aes(x=X, y=Y), color=palette[X], size=60) +
        scale_y_continuous(expand=c(0, 0))
Heraut Louis's avatar
Heraut Louis committed

    # Saves the plot
Heraut Louis's avatar
Heraut Louis committed
    ggsave(plot=p,
           filename=paste('palette_test', '.pdf', sep=''),
           width=10, height=10, units='cm', dpi=100)
}


Heraut Louis's avatar
Heraut Louis committed
## 5. OTHER TOOLS
### 5.1. Number formatting
# Returns the power of ten of the scientific expression of a value
Heraut Louis's avatar
Heraut Louis committed
get_power = function (value) {
Heraut Louis's avatar
Heraut Louis committed

    # Do not care about the sign
    value = abs(value)
Heraut Louis's avatar
Heraut Louis committed
    
Heraut Louis's avatar
Heraut Louis committed
    # If the value is greater than one
    if (value >= 1) {
        # The magnitude is the number of character of integer part
        # of the value minus one
Heraut Louis's avatar
Heraut Louis committed
        power = nchar(as.character(as.integer(value))) - 1
Heraut Louis's avatar
Heraut Louis committed
    # If the value is less than one
Heraut Louis's avatar
Heraut Louis committed
    } else {
Heraut Louis's avatar
Heraut Louis committed
        # Extract the decimal part
Heraut Louis's avatar
Heraut Louis committed
        dec = gsub('0.', '', as.character(value), fixed=TRUE)
Heraut Louis's avatar
Heraut Louis committed
        # Number of decimal with zero
Heraut Louis's avatar
Heraut Louis committed
        ndec = nchar(dec)
Heraut Louis's avatar
Heraut Louis committed
        # Number of decimal without zero
Heraut Louis's avatar
Heraut Louis committed
        nnum = nchar(as.character(as.numeric(dec)))
Heraut Louis's avatar
Heraut Louis committed
        # Compute the power of ten associated
Heraut Louis's avatar
Heraut Louis committed
        power = -(ndec - nnum + 1)
    }
    return(power)
}

Heraut Louis's avatar
Heraut Louis committed
### 5.2. Pourcentage of variable
# Returns the value corresponding of a certain percentage of a
# data serie
Heraut Louis's avatar
Heraut Louis committed
gpct = function (pct, L, ref=NULL, shift=FALSE) {
Heraut Louis's avatar
Heraut Louis committed

    # If no reference for the serie is given
Heraut Louis's avatar
Heraut Louis committed
    if (is.null(ref)) {
Heraut Louis's avatar
Heraut Louis committed
        # The minimum of the serie is computed
Heraut Louis's avatar
Heraut Louis committed
        minL = min(L, na.rm=TRUE)
Heraut Louis's avatar
Heraut Louis committed
    # If a reference is specified
Heraut Louis's avatar
Heraut Louis committed
    } else {
Heraut Louis's avatar
Heraut Louis committed
        # The reference is the minimum
Heraut Louis's avatar
Heraut Louis committed
        minL = ref
    }
Heraut Louis's avatar
Heraut Louis committed

    # Gets the max
Heraut Louis's avatar
Heraut Louis committed
    maxL = max(L, na.rm=TRUE)
Heraut Louis's avatar
Heraut Louis committed
    # And the span
Heraut Louis's avatar
Heraut Louis committed
    spanL = maxL - minL
Heraut Louis's avatar
Heraut Louis committed
    # Computes the value corresponding to the percentage
Heraut Louis's avatar
Heraut Louis committed
    xL = pct/100 * as.numeric(spanL)
Heraut Louis's avatar
Heraut Louis committed

    # If the value needs to be shift by its reference
Heraut Louis's avatar
Heraut Louis committed
    if (shift) {
        xL = xL + minL
    }
    return (xL)
}