An error occurred while loading the file. Please try again.
-
Pierre-Antoine Rouby authored4c927eb7
# \\\# Copyright 2021-2022 Louis Héraut*1,# Éric Sauquet*2,# Valentin Mansanarez## *1 INRAE, France# louis.heraut@inrae.fr# *2 INRAE, France# eric.sauquet@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/>.# ///### Rcode/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 variablemap_panel = function (list_df2plot, df_meta, df_shapefile, idPer_trend=1, trend_period, mean_period, colorForce=FALSE, codeLight=NULL, mapType='trend', margin=NULL, showSea=TRUE, foot_note=FALSE, foot_height=0, resources_path=NULL, logo_dir=NULL, PRlogo_file=NULL, AEAGlogo_file=NULL, INRAElogo_file=NULL, FRlogo_file=NULL, df_page=NULL, outdirTmp_pdf='', outdirTmp_png='', verbose=TRUE) { # Extract shapefiles df_france = df_shapefile$france df_basin = df_shapefile$basin df_subBasin = df_shapefile$subBasin df_codeBasin = df_shapefile$codeBasin df_river = df_shapefile$river # Number of variable/plot nbVar = length(list_df2plot) # Get all different stations code Code = levels(factor(df_meta$code)) nCode = length(Code) if (mapType == 'trend' & !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, nbVar, nCode, colorForce)7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
minTrendValue = res$min
maxTrendValue = res$max
}
# If there is a 'mean_period'
if (mapType == 'mean' & !is.null(mean_period)) {
# Convert 'mean_period' to list
mean_period = as.list(mean_period)
# Number of mean period
nPeriod_mean = length(mean_period)
res = short_meanExtremes(list_df2plot, Code,
nPeriod_mean, nbVar, nCode)
minBreakValue = res$min
maxBreakValue = res$max
breakValue_code = res$value
nMap = nPeriod_mean - 1
} else {
nMap = 1
}
if (mapType == 'regime') {
regimeColorSample = c('#005249',
'#3e8baa',
'#a9c0cb')
names(regimeColorSample) = c('Pluvial',
'Transition',
'Nival Glaciaire')
nRegime = length(regimeColorSample)
regimeColor = c()
for (code in Code) {
regime = df_meta$regime_hydro[df_meta$code == code]
color = regimeColorSample[regime]
regimeColor = c(regimeColor, color)
}
}
# Number of ticks for the colorbar
nbTick = 10
for (j in 1:nMap) {
# For all variable
for (i in 1:nbVar) {
# If there is a specified station code to highlight (mini map)
# and there has already been one loop
condition = (i > 1 | j > 1) & (mapType == 'mini' | mapType == 'regime')
if (condition) {
# 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
# Creates a name for the map
if (mapType == 'trend') {
outname = paste('map_', var, sep='')
} else if (mapType == 'mean') {
outname = paste('map_d', var, sep='')
} else if (mapType == 'regime') {
outname = paste('map_regime', sep='')
}
# If there is the verbose option
if (verbose) {
141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210
if (mapType == 'trend') {
mapName = 'tendence'
} else if (mapType == 'mean') {
mapName = 'difference'
} else if (mapType == 'regime') {
mapName = 'regime'
}
# Prints the name of the map
print(paste('Map of ', mapName, ' for : ', var,
" (",
round(i/nbVar*100, 0),
" %)",
sep=''))
}
# If there is no specified station code to highlight
# (mini map)
if (mapType != 'mini') {
# Sets the size of the countour
sizefr = 0.45
sizebs = 0.4
sizecbs = 0.5
sizerv = 0.3
} else {
sizefr = 0.35
sizebs = 0.3
sizecbs = 0.4
sizerv = 0.2
}
# Stores the coordonate system
cf = coord_fixed()
# Makes it the default one to remove useless warning
cf$default = TRUE
# Open a new plot with the personalise theme
map = ggplot() + theme_void() +
# 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_basin,
aes(x=long, y=lat, group=group),
color="grey70", fill=NA, size=sizebs) +
# Plot the hydrological sub-basin
geom_polygon(data=df_subBasin,
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 (mapType == 'regime') {
211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280
# color = regimeColor[match(df_codeBasin$code, Code)]
color = 'grey20'
map = map +
# Plot the hydrological code basins
geom_polygon(data=df_codeBasin,
aes(x=long, y=lat, group=code),
color=color, fill=NA, size=sizecbs)
}
if (mapType != 'mini') {
xBasin = c(410000, 520000, 630000,
620000, 510000, 450000,
390000, 390000)
yBasin = c(6280000, 6290000, 6320000,
6385000, 6450000, 6530000,
6365000, 6353000)
nameBasin = c('Adour', 'Garonne', 'Tarn-Aveyron',
'Lot', 'Dordogne', 'Charente',
'Fleuves-', 'Cô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)
# 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 (mapType != 'mini') {
# 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
}
281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350
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
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 (mapType == 'mean') {
value = breakValue_code[j+1, i, k]
minValue = minBreakValue[j+1, i]
maxValue = maxBreakValue[j+1, i]
pVal = 0
} else if (mapType == 'trend') {
# 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
351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420
# 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)
# 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
} else {
value = NA
minValue = NULL
maxValue = NULL
pVal = 0
}
# 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 (mapType == 'trend') {
# If it is significative
if (pVal <= alpha){
# The computed color is stored
421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490
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
}
} else {
# The computed color is stored
filltmp = color_res
# The marker is a circle
shapetmp = 21
}
# Extracts the localisation of the current station
lontmp =
df_meta$L93X_m_BH[df_meta$code == code]
lattmp =
df_meta$L93Y_m_BH[df_meta$code == code]
# 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 (mapType == 'trend' | mapType == 'mean') {
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
491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560
geom_point(data=plot_map_Ok,
aes(x=lon, y=lat),
shape=shape[OkVal], size=5, stroke=1,
color='grey50', fill=fill[OkVal])
}
# 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
# 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") +
561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630
# 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),
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 (mapType == 'trend') {
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)"))
}
} else if (mapType == 'mean') {
ValueName1 = "Écarts observés entre"
ValueName2 = paste(periodName1_mean,
631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700
" 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)"))
}
}
pal = pal +
# 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 (mapType == 'trend') {
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
701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770
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',
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 (mapType == 'trend') {
yValue = (Value - minTrendValue[idPer_trend, i]) / (maxTrendValue[idPer_trend, i] - minTrendValue[idPer_trend, i]) * valNorm
} else if (mapType == 'mean') {
yValue = (Value - minBreakValue[j+1, i]) / (maxBreakValue[j+1, i] - minBreakValue[j+1, 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
771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840
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
# 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 (mapType == 'trend') {
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]))
} else if (mapType == 'mean') {
shape = 21
}
}
# 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')
841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910
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"))
# If there is a specified station code
} else if (mapType == 'mini') {
# 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')
pal = void
title = void
} else if (mapType == 'regime') {
nudge_y = rnorm(nCode, mean=0, sd=1000)
# Plots only the localisation
map = map +
# For all stations not to highlight
geom_point(data=plot_map,
aes(x=lon, y=lat),
shape=21, size=3, stroke=0.5,
color='grey97', fill=regimeColor) +
geom_text_repel(data=plot_map,
aes(x=lon, y=lat, label=code),
segment.colour="grey35",
segment.size=0.25,
min.segment.length=0.25,
force=0.4,
force_pull=1,
size=2.5,
color=regimeColor,
bg.color="grey97",
bg.r=.15)
yLine1 = 1.4
yLine2 = 0.26
titleLine1 = "Régimes"
titleLine2 = "hydrologiques"
plot_title = tibble(x=c(-0.3, -0.3),
y=c(yLine1, yLine2),
label=c(titleLine1, titleLine2))
# New plot with void theme
title = ggplot() + theme_void() +
# Plots separation lines
geom_line(aes(x=c(-0.3, 3.9), y=c(0.15, 0.15)),
911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980
size=0.6, color="#00A3A8") +
# Writes title
geom_shadowtext(data=plot_title,
aes(x=x, y=y, label=label),
fontface="bold",
color="#00A3A8",
bg.colour="white",
hjust=0, vjust=0, size=10) +
# 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"))
regimeColorSample
xtick = rep(0, times=nRegime)
ytick = c(74, 83, 92)
labTick = names(regimeColorSample)
colTick = regimeColorSample
plot_palette = tibble(xtick=xtick,
ytick=ytick,
color=colTick,
label=labTick)
# New plot with void theme
pal = ggplot() + theme_void()
pal = pal +
# 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)
# For all the ticks
for (id in 1:nRegime) {
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=4, color='grey40')
}
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(0, 100),
expand=c(0, 0)) +
# Margin of the colorbar
theme(plot.margin=margin(t=0, r=0, b=0, l=0,
unit="mm"))
}
if (!is.null(df_page)) {
if (mapType == 'trend') {
section = 'Carte des tendances observées'
subsection = var
981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050
} else if (mapType == 'mean') {
section = 'Carte des écarts observés'
subsection = var
} else if (mapType == 'regime') {
section = 'Carte des régimes hydrologiques'
subsection = NA
}
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 (mapType == 'trend') {
footName = 'carte des tendances observées'
} else if (mapType == 'mean') {
footName = 'carte des écarts observés'
} else if (mapType == 'regime') {
footName = 'carte des régimes hydrologiques'
}
if (is.null(df_page)) {
n_page = i
}
foot = foot_panel(footName,
n_page, resources_path,
logo_dir, PRlogo_file,
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
heightLM[Hcut == 99] = margin_size
10511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088
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 (mapType != 'mini') {
# Saving matrix plot
ggsave(plot=plot,
path=outdirTmp_pdf,
filename=paste(outname, '.pdf', sep=''),
width=width, height=height, units='cm', dpi=100)
ggsave(plot=plot,
path=outdirTmp_png,
filename=paste(outname, '.png', sep=''),
width=width, height=height, units='cm', dpi=400)
}
}
}
# If there is no specified station code to highlight
# (mini map)
if (mapType != 'mini') {
return (df_page)
# Returns the map object
} else {
return (map)
}
}