An error occurred while loading the file. Please try again.
-
Heraut Louis authored4e58b039
# \\\
# 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/map.R
#
# Deals with the creation of a map for presenting the trend analysis of hydrological variables
## 1. MAP PANEL ______________________________________________________
# Generates a map plot of the tendancy of a hydrological variable
map_panel = function (list_df2plot, df_meta, df_shapefile, idPer_trend=1,
trend_period, mean_period, colorForce=FALSE,
outdirTmp='', codeLight=NULL,
margin=NULL, showSea=TRUE,
foot_note=FALSE,
foot_height=0, resources_path=NULL,
logo_dir=NULL,
AEAGlogo_file=NULL, INRAElogo_file=NULL,
FRlogo_file=NULL, df_page=NULL,
verbose=TRUE) {
# Extract shapefiles
df_france = df_shapefile$france
df_bassin = df_shapefile$bassin
df_subbassin = df_shapefile$subbassin
df_river = df_shapefile$river
# Number of variable/plot
nbp = length(list_df2plot)
# Get all different stations code
Code = levels(factor(df_meta$code))
nCode = length(Code)
if (!is.null(trend_period)) {
# Convert 'trend_period' to list
trend_period = as.list(trend_period)
# Number of trend period
nPeriod_trend = length(trend_period)
# Extracts the min and the max of the mean trend for all the station
res = short_trendExtremes(list_df2plot, Code, nPeriod_trend, nbp, nCode, colorForce)
minTrendValue = res$min
maxTrendValue = res$max
}
# If there is a 'mean_period'
if (!is.null(mean_period)) {
# Convert 'mean_period' to list
mean_period = as.list(mean_period)
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
# Number of mean period
nPeriod_mean = length(mean_period)
res = short_meanExtremes(list_df2plot, Code, nPeriod_mean, nbp, nCode)
minBreakValue = res$min
maxBreakValue = res$max
breakValue_code = res$value
} else {
nPeriod_mean = 1
}
# Number of ticks for the colorbar
nbTick = 10
for (j in 1:nPeriod_mean) {
# For all variable
for (i in 1:nbp) {
# If there is a specified station code to highlight (mini map)
# and there has already been one loop
if ((i > 1 | j > 1) & !is.null(codeLight)) {
# Stop the for loop over the variable
break
}
# Extracts the variable of the plot
var = list_df2plot[[i]]$var
# Extracts the type of variable of the plot
type = list_df2plot[[i]]$type
# Explanations about the variable
glose = list_df2plot[[i]]$glose
# Createsa name for the map
if (j > 1) {
outname = paste('map_d', var, sep='')
} else {
outname = paste('map_', var, sep='')
}
n_loop = i + nbp*(j-1)
N_loop = nbp*nPeriod_mean
# If there is the verbose option
if (verbose) {
if (j > 1) {
mapName = 'difference'
} else {
mapName = 'tendence'
}
# Prints the name of the map
print(paste('Map of ', mapName, ' for : ', var,
" (",
round(n_loop/N_loop*100, 0),
" %)",
sep=''))
}
# If there is no specified station code to highlight
# (mini map)
if (is.null(codeLight)) {
# Sets the size of the countour
sizefr = 0.45
sizebs = 0.4
sizerv = 0.3
} else {
sizefr = 0.35
sizebs = 0.3
sizerv = 0.2
}
# Stores the coordonate system
cf = coord_fixed()
# Makes it the default one to remove useless warning
141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210
cf$default = TRUE
# Open a new plot with the personalise theme
map = ggplot() + theme_void() +
# theme(
# # 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')) +
# Fixed coordinate system (remove useless warning)
cf +
# Plot the background of France
geom_polygon(data=df_france,
aes(x=long, y=lat, group=group),
color=NA, fill="grey97")
# If the river shapefile exists
if (!is.null(df_river)) {
# Plot the river
map = map +
geom_path(data=df_river,
aes(x=long, y=lat, group=group),
color="grey85", size=sizerv)
}
map = map +
# Plot the hydrological basin
geom_polygon(data=df_bassin,
aes(x=long, y=lat, group=group),
color="grey70", fill=NA, size=sizebs) +
# Plot the hydrological sub-basin
geom_polygon(data=df_subbassin,
aes(x=long, y=lat, group=group),
color="grey70", fill=NA, size=sizebs) +
# Plot the countour of France
geom_polygon(data=df_france,
aes(x=long, y=lat, group=group),
color="grey40", fill=NA, size=sizefr)
if (is.null(codeLight)) {
xBasin = c(410000, 520000, 630000,
620000, 510000, 450000,
390000)
yBasin = c(6280000, 6290000, 6320000,
6385000, 6450000, 6530000,
6361000)
nameBasin = c('Adour', 'Garonne', 'Tarn-Aveyron',
'Lot', 'Dordogne', 'Charente',
'Fleuves-\nCôtiers')
nBasin = length(xBasin)
plot_basin = tibble(x=xBasin, y=yBasin, label=nameBasin)
map = map +
geom_shadowtext(data=plot_basin,
aes(x=x, y=y, label=label),
fontface="bold",
color="grey85",
bg.colour="grey97",
hjust=0.5, vjust=0.5, size=5)
}
# If the sea needs to be shown
if (showSea) {
# Leaves space around the France
xlim = c(295000, 790000)
ylim = c(6125000, 6600000)
211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280
# Otherwise
} else {
# Leaves minimal space around France
xlim = c(305000, 790000)
ylim = c(6135000, 6600000)
}
# If there is no specified station code to highlight (mini map)
if (is.null(codeLight)) {
# Sets a legend scale start
xmin = gpct(4, xlim, shift=TRUE)
# Sets graduations
xint = c(0, 10*1E3, 50*1E3, 100*1E3)
# Sets the y postion
ymin = gpct(5, ylim, shift=TRUE)
# Sets the height of graduations
ymax = ymin + gpct(1, ylim)
# Size of the value
size = 3
# Size of the 'km' unit
sizekm = 2.5
# If there is a specified station code
} else {
# Same but with less graduation and smaller size
xmin = gpct(2, xlim, shift=TRUE)
xint = c(0, 100*1E3)
ymin = gpct(1, ylim, shift=TRUE)
ymax = ymin + gpct(3, ylim)
size = 2
sizekm = 1.5
}
map = map +
# Adds the base line of the scale
geom_line(aes(x=c(xmin, max(xint)+xmin),
y=c(ymin, ymin)),
color="grey40", size=0.2) +
# Adds the 'km' unit
annotate("text",
x=max(xint)+xmin+gpct(1, xlim), y=ymin,
vjust=0, hjust=0, label="km",
color="grey40", size=sizekm)
# For all graduations
for (x in xint) {
map = map +
# Draws the tick
annotate("segment",
x=x+xmin, xend=x+xmin, y=ymin, yend=ymax,
color="grey40", size=0.2) +
# Adds the value
annotate("text",
x=x+xmin, y=ymax+gpct(0.5, ylim),
vjust=0, hjust=0.5, label=x/1E3,
color="grey40", size=size)
}
map = map +
# Allows to crop shapefile without graphical problem
coord_sf(xlim=xlim, ylim=ylim,
expand=FALSE)
# If there is no margins specified
if (is.null(margin)) {
# Sets all margins to 0
map = map +
theme(plot.margin=margin(t=0, r=0, b=0, l=0,
unit="mm"))
# Otherwise
} else {
# Sets margins to the given ones
281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350
map = map +
theme(plot.margin=margin)
}
# Blank vector to store data about station
lon = c()
lat = c()
fill = c()
shape = c()
Value = c()
OkVal = c()
# For all code
for (k in 1:nCode) {
# Gets the code
code = Code[k]
if (j > 1) {
value = breakValue_code[j, i, k]
minValue = minBreakValue[j, i]
maxValue = maxBreakValue[j, i]
pVal = 0
} else if (is.null(trend_period)) {
value = NA
minValue = NULL
maxValue = NULL
pVal = 0
} else {
# Extracts the data corresponding to the
# current variable
df_data = list_df2plot[[i]]$data
# Extracts the trend corresponding to the
# current variable
df_trend = list_df2plot[[i]]$trend
# Gets the risk of the test
alpha = list_df2plot[[i]]$alpha
# Extracts the data corresponding to the code
df_data_code = df_data[df_data$code == code,]
# Extracts the trend corresponding to the code
df_trend_code = df_trend[df_trend$code == code,]
# Extract start and end of trend periods
Start = df_trend_code$period_start[idPer_trend]
End = df_trend_code$period_end[idPer_trend]
# Extracts the corresponding data for the period
df_data_code_per =
df_data_code[df_data_code$Date >= Start
& df_data_code$Date <= End,]
# Same for trend
df_trend_code_per =
df_trend_code[df_trend_code$period_start == Start
& df_trend_code$period_end == End,]
# Computes the number of trend analysis selected
Ntrend = nrow(df_trend_code_per)
# If there is more than one trend on the same period
if (Ntrend > 1) {
# Takes only the first because they are similar
df_trend_code_per = df_trend_code_per[1,]
}
# If it is a flow variable
if (type == 'sévérité') {
# Computes the mean of the data on the period
dataMean = mean(df_data_code_per$Value,
na.rm=TRUE)
351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420
# Normalises the trend value by the mean
# of the data
value = df_trend_code_per$trend / dataMean
# If it is a date variable
} else if (type == 'saisonnalité') {
value = df_trend_code_per$trend
}
minValue = minTrendValue[idPer_trend, i]
maxValue = maxTrendValue[idPer_trend, i]
pVal = df_trend_code_per$p
}
# Computes the color associated to the mean trend
color_res = get_color(value,
minValue,
maxValue,
palette_name='perso',
reverse=TRUE,
ncolor=256)
# Computes the colorbar info
palette_res = get_palette(minValue,
maxValue,
palette_name='perso',
reverse=TRUE,
ncolor=256,
nbTick=nbTick)
if (j > 1 | is.null(trend_period)) {
# The computed color is stored
filltmp = color_res
# The marker is a circle
shapetmp = 21
} else {
# If it is significative
if (pVal <= alpha){
# The computed color is stored
filltmp = color_res
# If the mean tend is positive
if (value >= 0) {
# Uses a triangle up for the shape
# of the marker
shapetmp = 24
# If negative
} else {
# Uses a triangle down for the shape
# of the marker
shapetmp = 25
}
} else if (pVal > alpha & colorForce) {
# The computed color is stored
filltmp = color_res
# The marker is a circle
shapetmp = 21
# If it is not significative
} else {
# The fill color is grey
filltmp = 'grey97'
# The marker is a circle
shapetmp = 21
}
}
# Extracts the localisation of the current station
lontmp =
df_meta[df_meta$code == code,]$L93X_m_BH
lattmp =
df_meta[df_meta$code == code,]$L93Y_m_BH
421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490
# Stores all the parameters
lon = c(lon, lontmp)
lat = c(lat, lattmp)
fill = c(fill, filltmp)
shape = c(shape, shapetmp)
Value = c(Value, value)
# If the trend analysis is significative a TRUE is stored
OkVal = c(OkVal, pVal <= alpha)
}
# Creates a tibble to stores all the data to plot
plot_map = tibble(lon=lon, lat=lat, fill=fill,
shape=shape, code=Code, OkVal=OkVal)
# If there is no specified station code to highlight
# (mini map)
if (is.null(codeLight)) {
plot_map_NOk = plot_map[!plot_map$OkVal,]
plot_map_Ok = plot_map[plot_map$OkVal,]
if (nrow(plot_map_NOk) > 0) {
map = map +
# Plots the point that are not
# significant first
geom_point(data=plot_map_NOk,
aes(x=lon, y=lat),
shape=shape[!OkVal],
size=5, stroke=1,
color='grey50', fill=fill[!OkVal])
}
if (nrow(plot_map_Ok) > 0) {
map = map +
# Plots the point that are significant last
geom_point(data=plot_map_Ok,
aes(x=lon, y=lat),
shape=shape[OkVal], size=5, stroke=1,
color='grey50', fill=fill[OkVal])
}
# If there is a specified station code
} else {
# Extract data of all stations not to highlight
plot_map_codeNo = plot_map[plot_map$code != codeLight,]
# Extract data of the station to highlight
plot_map_code = plot_map[plot_map$code == codeLight,]
# Plots only the localisation
map = map +
# For all stations not to highlight
geom_point(data=plot_map_codeNo,
aes(x=lon, y=lat),
shape=21, size=0.5, stroke=0.5,
color='grey50', fill='grey50') +
# For the station to highlight
geom_point(data=plot_map_code,
aes(x=lon, y=lat),
shape=21, size=2, stroke=0.5,
color='grey97', fill='#00A3A8')
}
if (is.null(codeLight)) {
# Extracts the position of the tick of the colorbar
posTick = palette_res$posTick
# Extracts the label of the tick of the colorbar
labTick = palette_res$labTick
# Extracts the color corresponding to the tick of the colorbar
colTick = palette_res$colTick
491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560
# Spreading of the colorbar
valNorm = nbTick * 10
# Normalisation of the position of ticks
ytick = posTick / max(posTick) * valNorm
# If it is a flow variable
if (type == 'sévérité') {
# Formatting of label in pourcent
labTick = as.character(signif(labTick*100, 2))
# If it is a date variable
} else if (type == 'saisonnalité') {
# Formatting of label
labTick = as.character(signif(labTick, 2))
}
# X position of ticks all similar
xtick = rep(0, times=nbTick)
# Creates a tibble to store all parameters of colorbar
plot_palette = tibble(xtick=xtick, ytick=ytick,
colTick=colTick, labTick=labTick)
nbLine = as.integer(nchar(glose)/40) + 1
nbNewline = 0
nbLim = 43
gloseName = glose
nbChar = nchar(gloseName)
while (nbChar > nbLim) {
nbNewline = nbNewline + 1
posSpace = which(strsplit(gloseName, "")[[1]] == " ")
idNewline = which.min(abs(posSpace - nbLim * nbNewline))
posNewline = posSpace[idNewline]
gloseName = paste(substring(gloseName,
c(1, posNewline + 1),
c(posNewline,
nchar(gloseName))),
collapse="\n")
Newline = substr(gloseName,
posNewline + 2,
nchar(gloseName))
nbChar = nchar(Newline)
}
Yline = 0.6 + 0.47*nbNewline
Ytitle = Yline + 0.15
# New plot with void theme
title = ggplot() + theme_void() +
# Plots separation lines
geom_line(aes(x=c(-0.3, 3.9), y=c(0.05, 0.05)),
size=0.6, color="#00A3A8") +
geom_line(aes(x=c(-0.3, 3.9), y=c(Yline, Yline)),
size=0.6, color="#00A3A8") +
# Writes title
geom_shadowtext(data=tibble(x=-0.3, y=Ytitle,
label=var),
aes(x=x, y=y, label=label),
fontface="bold",
color="#00A3A8",
bg.colour="white",
hjust=0, vjust=0, size=10) +
# Writes title
geom_shadowtext(data=tibble(x=-0.3, y=0.2,
label=gloseName),
aes(x=x, y=y, label=label),
561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630
fontface="bold",
color="#00A3A8",
bg.colour="white",
hjust=0, vjust=0, size=3) +
# X axis
scale_x_continuous(limits=c(-0.3, 1 + 3),
expand=c(0, 0)) +
# Y axis
scale_y_continuous(limits=c(0, 10),
expand=c(0, 0)) +
# Margin
theme(plot.margin=margin(t=0, r=0, b=0, l=0, unit="mm"))
# New plot with void theme
pal = ggplot() + theme_void() +
# Plots the point of the colorbar
geom_point(data=plot_palette,
aes(x=xtick, y=ytick),
shape=21, size=5, stroke=1,
color='white', fill=colTick)
periodName_trend = paste(
format(as.Date(trend_period[[idPer_trend]][1]),
'%Y'),
format(as.Date(trend_period[[idPer_trend]][2]),
'%Y'),
sep='-')
periodName1_mean = paste(
format(as.Date(mean_period[[1]][1]),
'%Y'),
format(as.Date(mean_period[[1]][2]),
'%Y'),
sep='-')
periodName2_mean = paste(
format(as.Date(mean_period[[2]][1]),
'%Y'),
format(as.Date(mean_period[[2]][2]),
'%Y'),
sep='-')
if (j > 1) {
ValueName1 = "Écarts observés entre"
ValueName2 = paste(periodName1_mean,
" et ",
periodName2_mean,
sep='')
# If it is a flow variable
if (type == 'sévérité') {
unit = bquote(bold("(%)"))
# If it is a date variable
} else if (type == 'saisonnalité') {
unit = bquote(bold("(jour)"))
}
} else {
ValueName1 = "Tendances observées"
ValueName2 = paste("sur la période ",
periodName_trend, sep='')
# If it is a flow variable
if (type == 'sévérité') {
unit = bquote(bold("(% par an)"))
# If it is a date variable
} else if (type == 'saisonnalité') {
unit = bquote(bold("(jour par an)"))
}
}
pal = pal +
631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700
# Name of the colorbar
annotate('text',
x=-0.3, y= valNorm + 37,
label=ValueName1,
hjust=0, vjust=0.5,
size=6, color='grey40') +
# Second line
annotate('text',
x=-0.3, y= valNorm + 26,
label=ValueName2,
hjust=0, vjust=0.5,
size=6, color='grey40') +
# Unit legend of the colorbar
annotate('text',
x=-0.3, y= valNorm + 14,
label=unit,
hjust=0, vjust=0.5,
size=4, color='grey40')
# For all the ticks
for (id in 1:nbTick) {
pal = pal +
# Adds the value
annotate('text', x=xtick[id]+0.3,
y=ytick[id],
label=bquote(bold(.(labTick[id]))),
hjust=0, vjust=0.7,
size=3, color='grey40')
}
if (j == 1) {
upLabel = bquote(bold("Hausse significative à 10%"))
noneLabel = bquote(bold("Non significatif à 10%"))
downLabel = bquote(bold("Baisse significative à 10%"))
yUp = -20
yNone = -29
yDown = -40
pal = pal +
# Up triangle in the marker legend
geom_point(aes(x=0, y=yUp),
shape=24, size=4, stroke=1,
color='grey50', fill='grey97') +
# Up triangle text legend
annotate('text',
x=0.3, y=yUp,
label=upLabel,
hjust=0, vjust=0.5,
size=3, color='grey40')
pal = pal +
# Circle in the marker legend
geom_point(aes(x=0, y=yNone),
shape=21, size=4, stroke=1,
color='grey50', fill='grey97') +
# Circle text legend
annotate('text',
x=0.3, y=yNone,
label=noneLabel,
hjust=0, vjust=0.7,
size=3, color='grey40')
pal = pal +
# Down triangle in the marker legend
geom_point(aes(x=0, y=yDown),
shape=25, size=4, stroke=1,
color='grey50', fill='grey97') +
# Down triangle text legend
annotate('text',
701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770
x=0.3, y=yDown,
label=downLabel,
hjust=0, vjust=0.5,
size=3, color='grey40')
}
# Normalises all the trend values for each station
# according to the colorbar
if (j > 1) {
yValue = (Value - minBreakValue[j, i]) / (maxBreakValue[j, i] - minBreakValue[j, i]) * valNorm
} else {
yValue = (Value - minTrendValue[idPer_trend, i]) / (maxTrendValue[idPer_trend, i] - minTrendValue[idPer_trend, i]) * valNorm
}
# Takes only the significative ones
yValueOk = yValue[OkVal]
yValueNOk = yValue[!OkVal]
# Histogram distribution
# Computes the histogram of values
res_hist = hist(yValueOk, breaks=ytick, plot=FALSE)
# Extracts the number of counts per cells
countsOk = res_hist$counts
# Extracts middle of cells
midsOk = res_hist$mids
# Histogram distribution
# Computes the histogram of values
res_hist = hist(yValueNOk, breaks=ytick, plot=FALSE)
# Extracts the number of counts per cells
countsNOk = res_hist$counts
counts = countsOk + countsNOk
# Blank vectors to store position of points of
# the distribution to plot
xValue = c()
yValue = c()
color = c()
shape = c()
# Start X position of the distribution
start_hist = 1
# X separation bewteen point
hist_sep = 0.15
# Gets the maximun number of point of the distribution
maxCount = max(counts, na.rm=TRUE)
# Limit of the histogram
lim_hist = 2
# If the number of point will exceed the limit
if (maxCount * hist_sep > lim_hist) {
# Computes the right amount of space between points
hist_sep = lim_hist / maxCount
}
# For all cells of the histogram
for (ii in 1:length(midsOk)) {
# If the count in the current cell is not zero
if (counts[ii] != 0) {
# Stores the X positions of points of the
# distribution for the current cell
xValue = c(
xValue,
seq(start_hist,
start_hist+(counts[ii]-1)*hist_sep,
by=hist_sep))
}
# Stores the Y position which is the middle of the
771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840
# current cell the number of times it has been counted
yValue = c(yValue, rep(midsOk[ii],
times=counts[ii]))
color = c(color, rep('grey50',
times=countsOk[ii]))
color = c(color, rep('grey85',
times=countsNOk[ii]))
if (j > 1) {
shape = 21
} else {
if (midsOk[ii] > 0) {
shapetmp = 25
} else {
shapetmp = 24
}
shape = c(shape, rep(shapetmp,
times=countsOk[ii]))
shape = c(shape, rep(21,
times=countsNOk[ii]))
}
}
# Makes a tibble to plot the distribution
plot_value = tibble(xValue=xValue, yValue=yValue)
pal = pal +
# Plots the point of the distribution
geom_point(data=plot_value,
aes(x=xValue, y=yValue),
shape=shape,
color=color,
fill=color, stroke=0.4,
alpha=1)
if (type == 'sévérité') {
labelArrow = 'Plus sévère'
} else if (type == 'saisonnalité') {
labelArrow = 'Plus tôt'
}
# Position of the arrow
xArrow = 3.3
pal = pal +
# Arrow to show a worsening of the situation
geom_segment(aes(x=xArrow, y=valNorm*0.75,
xend=xArrow, yend=valNorm*0.25),
color='grey50', size=0.3,
arrow=arrow(length=unit(2, "mm"))) +
# Text associated to the arrow
annotate('text',
x=xArrow+0.1, y=valNorm*0.5,
label=labelArrow,
angle=90,
hjust=0.5, vjust=1,
size=3, color='grey50')
pal = pal +
# X axis of the colorbar
scale_x_continuous(limits=c(-0.3, 4),
expand=c(0, 0)) +
# Y axis of the colorbar
scale_y_continuous(limits=c(-47, valNorm + 48),
expand=c(0, 0)) +
# Margin of the colorbar
theme(plot.margin=margin(t=0, r=0, b=0, l=0, unit="mm"))
} else {
841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910
pal = void
title = void
}
if (!is.null(df_page)) {
if (j > 1) {
section = 'Carte des écarts observés'
} else {
section = 'Carte des tendances observées'
}
subsection = var
n_page = df_page$n[nrow(df_page)] + 1
df_page = bind_rows(
df_page,
tibble(section=section,
subsection=subsection,
n=n_page))
}
# If there is a foot note
if (foot_note) {
if (j > 1) {
footName = 'carte des écarts observés'
} else {
footName = 'carte des tendances observées'
}
if (is.null(df_page)) {
n_page = n_loop
}
foot = foot_panel(footName,
n_page, resources_path,
logo_dir,
AEAGlogo_file, INRAElogo_file,
FRlogo_file, foot_height)
# Stores the map, the title and the colorbar in a list
P = list(map, title, pal, foot)
LM = matrix(c(1, 1, 1, 2,
1, 1, 1, 3,
4, 4, 4, 4),
nrow=3, byrow=TRUE)
} else {
foot_height = 0
# Stores the map, the title and the colorbar in a list
P = list(map, title, pal)
LM = matrix(c(1, 1, 1, 2,
1, 1, 1, 3),
nrow=2, byrow=TRUE)
}
id_foot = 4
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)
margin_size = 0.5
height = 21
width = 29.7
row_height = (height - 2*margin_size - foot_height) / (LMrow - 3)
Hcut = LM[, 2]
heightLM = rep(row_height, times=LMrow)
heightLM[Hcut == id_foot] = foot_height
911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945
heightLM[Hcut == 99] = margin_size
col_width = (width - 2*margin_size) / (LMcol - 2)
Wcut = LM[(nrow(LM)-1),]
widthLM = rep(col_width, times=LMcol)
widthLM[Wcut == 99] = margin_size
# Arranges the graphical object
plot = grid.arrange(grobs=P, layout_matrix=LM,
heights=heightLM, widths=widthLM)
# If there is no specified station code to highlight
# (mini map)
if (is.null(codeLight)) {
# Saving matrix plot
ggsave(plot=plot,
path=outdirTmp,
filename=paste(outname, '.pdf', sep=''),
width=width, height=height, units='cm', dpi=100)
}
}
}
# If there is no specified station code to highlight
# (mini map)
if (is.null(codeLight)) {
return (df_page)
# Returns the map object
} else {
return (map)
}
}