Newer
Older
#
# *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)
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),
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
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
## 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,
figdir='', filedir_opt='', filename_opt='',
variable='', df_trend=NULL,
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,
AEAGlogo_file=NULL,
INRAElogo_file=NULL,
FRlogo_file=NULL) {
# If there is an option to mention in the filename it adds it
if (filename_opt != '') {
outfile = paste(outfile, '_', filename_opt, sep='')
}
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
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)
# 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) {
if (all(class(alpha) != 'list')) {
alpha = list(alpha)
# Replicates the value the number of times that there
# is of studied variables
if (all(class(unit2day) != 'list')) {
unit2day = list(unit2day)
if (length(unit2day) == 1) {
unit2day = replicate(nbp, unit2day)
}}
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
# For all the type of graph / number of studied variables
# Creates a list that gather all the info for one type of graph
# If map needs to be plot
if ('map' %in% toplot) {
df_page = 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,
df_page=df_page)
df_page = 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,
df_page=df_page)
# If datasheets needs to be plot
if ('datasheet' %in% toplot) {
df_page = 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,
df_page=df_page)
summary_panel(df_page,
foot_note,
foot_height,
resources_path,
AEAGlogo_file,
INRAElogo_file,
FRlogo_file,
outdirTmp)
details = file.info(list.files(outdirTmp, full.names=TRUE))
details = details[with(details, order(as.POSIXct(mtime))),]
listfile_path = rownames(details)
summary_path = listfile_path[length(listfile_path)]
listfile_path = listfile_path[-length(listfile_path)]
listfile_path = c(summary_path, listfile_path)
## 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)
}
# 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
# 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)
if (reverse) {
palette = rev(palette)
palette_hot = rev(palette_hot)
palette_cold = rev(palette_cold)
}
# Gets the relative position of the value in respect
# to its span
} 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) {
# 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
# 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)
if (reverse) {
palette = rev(palette)
palette_hot = rev(palette_hot)
palette_cold = rev(palette_cold)
# Blank vector to store corresponding labels and colors
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
# All the same arbitrary y position to create a colorbar
# 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))
ggsave(plot=p,
filename=paste('palette_test', '.pdf', sep=''),
width=10, height=10, units='cm', dpi=100)
}
### Summary panel
summary_panel = function (df_page, foot_note, foot_height, resources_path, AEAGlogo_file, INRAElogo_file, FRlogo_file, outdirTmp) {
text_title = paste(
"<b>Analyse de Stationnarité Hydrologique</b>",
sep='')
text_subtitle = paste(
"Bassin Adour-Garonnne",
sep='')
Sec_name = rle(df_page$section)$values
nSec = length(Sec_name)
nlim = 50
text_sum1 = ''
text_page1 = ''
text_sum2 = ''
text_page2 = ''
nline = 0
nline_max = 25
for (idS in 1:nSec) {
sec_name = Sec_name[idS]
subSec_name = rle(df_page$subsection[df_page$section == sec_name])$values
n_page = df_page$n[df_page$section == sec_name][1]
line = paste("<b>", idS, ". ", sec_name, "</b>", "<br>", sep='')
page = paste("<b>p.", n_page, "</b><br>", sep='')
if (nline <= nline_max) {
text_sum1 = paste(text_sum1, line, sep='')
text_page1 = paste(text_page1, page, sep='')
} else {
text_sum2 = paste(text_sum2, line, sep='')
text_page2 = paste(text_page2, page, sep='')
}
nline = nline + 1
nSSec = length(subSec_name)
for (idSS in 1:nSSec) {
subsec_name = subSec_name[idSS]
if (!is.na(subsec_name)) {
n_page = df_page$n[df_page$section == sec_name &
df_page$subsection == subsec_name][1]
line = paste(" ", idS, ".", idSS, ". ",
subsec_name, "<br>", sep='')
page = paste("p.", n_page, "<br>", sep='')
if (nline <= nline_max) {
text_sum1 = paste(text_sum1, line, sep='')
text_page1 = paste(text_page1, page, sep='')
} else {
text_sum2 = paste(text_sum2, line, sep='')
text_page2 = paste(text_page2, page, sep='')
}
nline = nline + 1
# text_sum1 = gsub("é", "é", text_sum1)
text_sum1 = gsub(" ", "<span style='color:white'>_</span>",
text_sum1)
text_sum1 = gsub('[.]', '.', text_sum1)
text_page1 = gsub('[.]', '.', text_page1)
# text_sum2 = gsub("é", "é", text_sum2)
text_sum2 = gsub(" ", "<span style='color:white'>_</span>",
text_sum2)
text_sum2 = gsub('[.]', '.', text_sum2)
text_page2 = gsub('[.]', '.', text_page2)
# Converts all texts to graphical object in the right position
gtitle = richtext_grob(text_title,
x=0, y=1,
margin=unit(c(t=0, r=0, b=0, l=0), "mm"),
hjust=0, vjust=1,
gp=gpar(col="#00A3A8", fontsize=20))
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
gsubtitle = richtext_grob(text_subtitle,
x=0, y=1,
margin=unit(c(t=0, r=0, b=0, l=0), "mm"),
hjust=0, vjust=1,
gp=gpar(col="#00A3A8", fontsize=15))
gsum1 = richtext_grob(text_sum1,
x=0, y=1,
margin=unit(c(t=0, r=0, b=0, l=0), "mm"),
hjust=0, vjust=1,
gp=gpar(col="#00A3A8", fontsize=10))
gpage1 = richtext_grob(text_page1,
x=0, y=1,
margin=unit(c(t=0, r=0, b=0, l=0), "mm"),
hjust=0, vjust=1,
gp=gpar(col="#00A3A8", fontsize=10))
gsum2 = richtext_grob(text_sum2,
x=0, y=1,
margin=unit(c(t=0, r=0, b=0, l=0), "mm"),
hjust=0, vjust=1,
gp=gpar(col="#00A3A8", fontsize=10))
gpage2 = richtext_grob(text_page2,
x=0, y=1,
margin=unit(c(t=0, r=0, b=0, l=0), "mm"),
hjust=0, vjust=1,
gp=gpar(col="#00A3A8", fontsize=10))
# If there is a foot note
if (foot_note) {
footName = 'sommaire'
foot = foot_panel(footName,
1, resources_path,
AEAGlogo_file, INRAElogo_file,
FRlogo_file, foot_height)
P = list(gtitle, gsubtitle, gsum1, gpage1, gsum2, gpage2, foot)
LM = matrix(c(1, 1, 1, 1,
2, 2, 2, 2,
3, 4, 5, 6,
7, 7, 7, 7),
nrow=4, byrow=TRUE)
P = list(gtitle, gsubtitle, gsum1, gpage1, gsum2, gpage2)
LM = matrix(c(1, 1, 1, 1,
2, 2, 2, 2,
3, 4, 5, 6),
nrow=3, byrow=TRUE)
id_title = 1
id_subtitle = 2
id_page1 = 4
id_page2 = 6
id_foot = 7
LMcol = ncol(LM)
LMrow = nrow(LM)
LM = rbind(rep(99, times=LMcol), LM, rep(99, times=LMcol))
LMrow = nrow(LM)
LM = cbind(rep(99, times=LMrow), LM, rep(99, times=LMrow))
LMcol = ncol(LM)
title_height = 0.75
subtitle_height = 1.25
margin_size = 0.5
page_width = 0.5
row_height = (height - 2*margin_size - foot_height - title_height - subtitle_height) / (LMrow - 5)
heightLM[Hcut == id_title] = title_height
heightLM[Hcut == id_subtitle] = subtitle_height
widthLM[Wcut == id_page1 | Wcut == id_page2] = page_width
widthLM[Wcut == 99] = margin_size
# Arranges the graphical object
plot = grid.arrange(grobs=P, layout_matrix=LM,
heights=heightLM, widths=widthLM)
# Saves the plot
ggsave(plot=plot,
path=outdirTmp,
filename=paste('sommaire', '.pdf', sep=''),
width=width, height=height, units='cm', dpi=100)
}
foot_panel = function (name, n_page, resources_path, AEAGlogo_file, INRAElogo_file, FRlogo_file, foot_height) {
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
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,
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
# 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
# If value is zero
} else if (value == 0) {
# The power is zero
power = 0
### 5.2. Pourcentage of variable
# Returns the value corresponding of a certain percentage of a
# data serie
# Computes the value corresponding to the percentage
# If the value needs to be shift by its reference
### 5.3. Add months
add_months = function (date, n) {
new_date = seq(date, by = paste (n, "months"), length = 2)[2]
return (new_date)
}