layout.R 18.82 KiB
# \\\
# Copyright 2021-2022 Louis Héraut*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
# 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.
# Usefull library
library(ggplot2)
library(scales)
library(qpdf)
library(gridExtra)
library(gridtext)
library(dplyr)
library(grid)
library(ggh4x)
library(RColorBrewer)
library(rgdal)
library(shadowtext)
library(png)
# Sourcing R file
source('plotting/datasheet.R', encoding='UTF-8')
source('plotting/map.R', encoding='UTF-8')
source('plotting/matrix.R', encoding='UTF-8')
source('plotting/break.R', encoding='UTF-8')
## 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),
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
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_blank(), # Axis title axis.title.x=element_blank(), axis.title.y=element_text(size=9, vjust=1.2, hjust=0.5, color='grey20'), # Axis line axis.line.x=element_blank(), axis.line.y=element_blank(), ) ### 1.2. Color palette palette_perso = c('#0f3b57', # cold '#1d7881', '#80c4a9', '#e2dac6', # mid '#fadfad', '#d08363', '#7e392f') # hot ## 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() ) # A plot completly blank with a contour contour = void + theme(plot.background=element_rect(fill=NA, color="#EC4899"), plot.margin=margin(t=0, r=0, b=0, l=0, unit="mm")) ### 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, toplot=c('datasheet', 'matrix', 'map'), figdir='', filedir_opt='', filename_opt='', variable='', df_trend=NULL, alpha=0.1, unit2day=365.25, var='',
141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210
type='', trend_period=NULL, mean_period=NULL, axis_xlim=NULL, missRect=FALSE, time_header=NULL, info_header=TRUE, foot_note=FALSE, info_ratio=1, time_ratio=2, var_ratio=3, foot_height=0.5, df_shapefile=NULL, resources_path=NULL, AEAGlogo_file=NULL, INRAElogo_file=NULL, FRlogo_file=NULL) { # Name of the document outfile = "Panels" # If there is an option to mention in the filename it adds it if (filename_opt != '') { outfile = paste(outfile, '_', filename_opt, sep='') } # Add the 'pdf' extensionto the name 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) } # Names of a temporary directory to store all the independent pages outdirTmp = file.path(outdir, 'tmp') # Creates it if it does not exist if (!(file.exists(outdirTmp))) { dir.create(outdirTmp) # If it already exists it deletes the pre-existent directory # and recreates one } else { unlink(outdirTmp, recursive=TRUE) dir.create(outdirTmp) } # Number of type/variable nbp = length(df_data) # Convert data tibble to list of tibble if it is not the case if (all(class(df_data) != 'list')) { df_data = list(df_data) } if (all(class(df_trend) != 'list')) { df_trend = list(df_trend) if (length(df_trend) == 1) { df_trend = replicate(nbp, df_trend) }} if (all(class(alpha) != 'list')) { alpha = list(alpha) # If there is only one value if (length(alpha) == 1) { # Replicates the value the number of times that there # is of studied variables alpha = replicate(nbp, alpha) }} # Same if (all(class(unit2day) != 'list')) { unit2day = list(unit2day) if (length(unit2day) == 1) { unit2day = replicate(nbp, unit2day) }}
211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280
if (all(class(var) != 'list')) { var = list(var) if (length(var) == 1) { var = replicate(nbp, var) }} 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) }} # Creates a blank list to store all the data of each type of plot list_df2plot = vector(mode='list', length=nbp) # For all the type of graph / number of studied variables for (i in 1:nbp) { # Creates a list that gather all the info for one type of graph df2plot = list(data=df_data[[i]], trend=df_trend[[i]], alpha=alpha[[i]], unit2day=unit2day[[i]], var=var[[i]], type=type[[i]], missRect=missRect[[i]]) # Stores it list_df2plot[[i]] = df2plot } # If datasheets needs to be plot if ('datasheet' %in% toplot) { datasheet_panel(list_df2plot, df_meta, trend_period, info_header=info_header, time_header=time_header, foot_note=foot_note, layout_matrix=layout_matrix, info_ratio=info_ratio, time_ratio=time_ratio, var_ratio=var_ratio, foot_height=foot_height, resources_path=resources_path, AEAGlogo_file=AEAGlogo_file, INRAElogo_file=INRAElogo_file, FRlogo_file=FRlogo_file, outdirTmp=outdirTmp) } # If summarize matrix needs to be plot if ('matrix' %in% toplot) { matrix_panel(list_df2plot, df_meta, trend_period, mean_period, slice=19, outdirTmp=outdirTmp, A3=TRUE, foot_note=foot_note, foot_height=foot_height, resources_path=resources_path, AEAGlogo_file=AEAGlogo_file, INRAElogo_file=INRAElogo_file, FRlogo_file=FRlogo_file,) } # If map needs to be plot if ('map' %in% toplot) { map_panel(list_df2plot, df_meta, idPer_trend=length(trend_period), mean_period=mean_period, df_shapefile=df_shapefile, foot_note=foot_note, foot_height=foot_height, resources_path=resources_path, AEAGlogo_file=AEAGlogo_file, INRAElogo_file=INRAElogo_file, FRlogo_file=FRlogo_file, outdirTmp=outdirTmp) } # Combine independant pages into one PDF details = file.info(list.files(outdirTmp, full.names=TRUE)) details = details[with(details, order(as.POSIXct(mtime))),] listfile_path = rownames(details) pdf_combine(input=listfile_path, output=file.path(outdir, outfile))
281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350
} ## 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 get_color = function (value, min, max, ncolor=256, palette_name='perso', reverse=FALSE) { # If the value is a NA return NA color if (is.na(value)) { return (NA) } # If the palette chosen is the personal ones if (palette_name == 'perso') { colorList = palette_perso # Else takes the palette corresponding to the name given } else { colorList = brewer.pal(11, palette_name) } # Gets the number of discrete colors in the palette nSample = length(colorList) # Recreates a continuous color palette palette = colorRampPalette(colorList)(ncolor) # Separates it in the middle to have a cold and a hot palette 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) # Reverses the palette if it needs to be if (reverse) { palette = rev(palette) palette_hot = rev(palette_hot) palette_cold = rev(palette_cold) } # Computes the absolute max maxAbs = max(abs(max), abs(min)) # If the value is negative if (value < 0) { # Gets the relative position of the value in respect # to its span idNorm = (value + maxAbs) / maxAbs # The index corresponding id = round(idNorm*(ncolor - 1) + 1, 0) # The associated color color = palette_cold[id] # Same if it is a positive value } else { idNorm = value / maxAbs id = round(idNorm*(ncolor - 1) + 1, 0) color = palette_hot[id] } return(color) } ### 4.2. Colorbar # Returns the colorbar but also positions, labels and colors of some # ticks along it get_palette = function (min, max, ncolor=256, palette_name='perso', reverse=FALSE, nbTick=10) { # If the palette chosen is the personal ones if (palette_name == 'perso') { colorList = palette_perso # Else takes the palette corresponding to the name given } else {
351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420
colorList = brewer.pal(11, palette_name) } # Gets the number of discrete colors in the palette nSample = length(colorList) # Recreates a continuous color palette palette = colorRampPalette(colorList)(ncolor) # Separates it in the middle to have a cold and a hot palette 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) # Reverses the palette if it needs to be if (reverse) { palette = rev(palette) palette_hot = rev(palette_hot) palette_cold = rev(palette_cold) } # If the min and the max are below zero if (min < 0 & max < 0) { # The palette show is only the cold one paletteShow = palette_cold # If the min and the max are above zero } else if (min > 0 & max > 0) { # The palette show is only the hot one paletteShow = palette_hot # Else it is the entire palette that is shown } else { paletteShow = palette } # The position of ticks is between 0 and 1 posTick = seq(0, 1, length.out=nbTick) # Blank vector to store corresponding labels and colors labTick = c() colTick = c() # For each tick for (i in 1:nbTick) { # Computes the graduation between the min and max lab = (i-1)/(nbTick-1) * (max - min) + min # Gets the associated color col = get_color(lab, min=min, max=max, ncolor=ncolor, palette_name=palette_name, reverse=reverse) # Stores them labTick = c(labTick, lab) colTick = c(colTick, col) } # List of results res = list(palette=paletteShow, posTick=posTick, labTick=labTick, colTick=colTick) return(res) } ### 4.3. Palette tester # Allows to display the current personal palette palette_tester = function (n=256) { # An arbitrary x vector X = 1:n # All the same arbitrary y position to create a colorbar Y = rep(0, times=n) # Recreates a continuous color palette palette = colorRampPalette(palette_perso)(n) # Open a plot
421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490
p = ggplot() + # 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 geom_line(aes(x=X, y=Y), color=palette[X], size=60) + scale_y_continuous(expand=c(0, 0)) # Saves the plot ggsave(plot=p, filename=paste('palette_test', '.pdf', sep=''), width=10, height=10, units='cm', dpi=100) } ### Foot note panel foot_panel = function (name, n_page, N_page, resources_path, AEAGlogo_file, INRAElogo_file, FRlogo_file, foot_height) { text_page = paste( name, " <b>p. ", n_page, "/", N_page, "</b>", sep='') text_date = paste ( format(Sys.Date(), "%B %Y"), sep='') # Converts all texts to graphical object in the right position gtext_page = richtext_grob(text_page, x=1, y=0, margin=unit(c(t=0, r=0, b=0, l=0), "mm"), hjust=1, vjust=0.5, gp=gpar(col="#00A3A8", fontsize=8)) gtext_date = richtext_grob(text_date, x=1, y=0.4, margin=unit(c(t=0, r=0, b=0, l=0), "mm"), hjust=1, vjust=0.5, gp=gpar(col="#00A3A8", fontsize=6)) AEAGlogo_path = file.path(resources_path, AEAGlogo_file) INRAElogo_path = file.path(resources_path, INRAElogo_file) FRlogo_path = file.path(resources_path, FRlogo_file) AEAGlogo_img = readPNG(AEAGlogo_path) AEAGlogo_grob = rasterGrob(AEAGlogo_img, width=unit(0.7*foot_height, "cm")) INRAElogo_img = readPNG(INRAElogo_path) INRAElogo_grob = rasterGrob(INRAElogo_img, y=0.57, vjust=0.5, width=unit(1.1*foot_height, "cm")) FRlogo_img = readPNG(FRlogo_path) FRlogo_grob = rasterGrob(FRlogo_img, x=0, hjust=0, width=unit(1*foot_height, "cm")) P = list(void,
491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560
FRlogo_grob, INRAElogo_grob, AEAGlogo_grob, gtext_page, gtext_date) # Creates the matrix layout LM = matrix(c(1, 2, 3, 4, 5, 1, 2, 3, 4, 6), nrow=2, byrow=TRUE) # And sets the relative width of each plot widths = rep(1, times=ncol(LM)) widths[2] = 0.18 widths[3] = 0.25 widths[4] = 0.2 # Arranges all the graphical objetcs plot = grid.arrange(grobs=P, layout_matrix=LM, widths=widths) # Return the plot object return (plot) } ## 5. OTHER TOOLS ### 5.1. Number formatting # Returns the power of ten of the scientific expression of a value get_power = function (value) { # Do not care about the sign value = abs(value) # 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 power = nchar(as.character(as.integer(value))) - 1 # If value is zero } else if (value == 0) { # The power is zero power = 0 # If the value is less than one } else { # Extract the decimal part dec = gsub('0.', '', as.character(value), fixed=TRUE) # Number of decimal with zero ndec = nchar(dec) # Number of decimal without zero nnum = nchar(as.character(as.numeric(dec))) # Compute the power of ten associated power = -(ndec - nnum + 1) } return(power) } ### 5.2. Pourcentage of variable # Returns the value corresponding of a certain percentage of a # data serie gpct = function (pct, L, min_lim=NULL, shift=FALSE) { # If no reference for the serie is given if (is.null(min_lim)) { # The minimum of the serie is computed minL = min(L, na.rm=TRUE) # If a reference is specified } else { # The reference is the minimum minL = min_lim }
561562563564565566567568569570571572573574575576577578579580581
# Gets the max maxL = max(L, na.rm=TRUE) # And the span spanL = maxL - minL # Computes the value corresponding to the percentage xL = pct/100 * as.numeric(spanL) # If the value needs to be shift by its reference if (shift) { xL = xL + minL } return (xL) } ### 5.3. Add months add_months = function (date, n) { new_date = seq(date, by = paste (n, "months"), length = 2)[2] return (new_date) }