An error occurred while loading the file. Please try again.
-
Heraut Louis authored69ee04e6
# \\\
# 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)
}