Skip to content
GitLab
Select Git revision
  • master default
Find file BlameHistoryPermalink
map.R 38.49 KiB
1 
# \\\
2 
# Copyright 2021-2022 Louis Héraut*1
3 
#
4 
# *1   INRAE, France
5 
#      louis.heraut@inrae.fr
6 
#
7 
# This file is part of ash R toolbox.
8 
#
9 
# ash R toolbox is free software: you can redistribute it and/or modify
10 
# it under the terms of the GNU General Public License as published by
11 
# the Free Software Foundation, either version 3 of the License, or (at
12 
# your option) any later version.
13 
#
14 
# ash R toolbox is distributed in the hope that it will be useful, but
15 
# WITHOUT ANY WARRANTY; without even the implied warranty of
16 
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17 
# General Public License for more details.
18 
#
19 
# You should have received a copy of the GNU General Public License
20 
# along with ash R toolbox.  If not, see <https://www.gnu.org/licenses/>.
21 
# ///
22 
#
23 
#
24 
# plotting/map.R
25 
#
26 
# Deals with the creation of a map for presenting the trend analysis of hydrological variables
27
28
29 
## 1. MAP PANEL
30 
# Generates a map plot of the tendancy of a hydrological variable
31 
map_panel = function (list_df2plot, df_meta, df_shapefile, idPer_trend=1,
32 
                      mean_period=NULL, outdirTmp='', codeLight=NULL,
33 
                      margin=NULL, showSea=TRUE,
34 
                      foot_note=FALSE,
35 
                      foot_height=0, resources_path=NULL,
36 
                      AEAGlogo_file=NULL, INRAElogo_file=NULL,
37 
                      FRlogo_file=NULL, df_page=NULL,
38 
                      verbose=TRUE) {
39
40 
    # Extract shapefiles
41 
    df_france = df_shapefile$france
42 
    df_bassin = df_shapefile$bassin
43 
    df_subbassin = df_shapefile$subbassin
44 
    df_river = df_shapefile$river
45
46 
    # Number of variable/plot
47 
    nbp = length(list_df2plot)
48
49 
    # Get all different stations code
50 
    Code = levels(factor(df_meta$code))
51 
    nCode = length(Code)
52
53 
    # Gets a trend example
54 
    df_trend = list_df2plot[[1]]$trend
55
56 
    nPeriod_max = 0
57 
    for (code in Code) {
58 
        # Extracts the trend corresponding to the code
59 
        df_trend_code = df_trend[df_trend$code == code,]
60
61 
        # Extract start and end of trend periods
62 
        Start = df_trend_code$period_start
63 
        End = df_trend_code$period_end
64 
        # Get the name of the different period
65 
        UStart = levels(factor(Start))
66 
        UEnd = levels(factor(End))
67
68 
        # Compute the max of different start and end
69 
        # so the number of different period
70 
        nPeriod = max(length(UStart), length(UEnd))
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
# If the number of period for the trend is greater # than the current max period, stocks it if (nPeriod > nPeriod_max) { nPeriod_max = nPeriod } } # Blank array to store time info tab_Start = array(rep('', nCode*nbp*nPeriod_max), dim=c(nCode, nbp, nPeriod_max)) tab_End = array(rep('', nCode*nbp*nPeriod_max), dim=c(nCode, nbp, nPeriod_max)) tab_Code = array(rep('', nCode*nbp*nPeriod_max), dim=c(nCode, nbp, nPeriod_max)) tab_Periods = array(rep('', nCode*nbp*nPeriod_max), dim=c(nCode, nbp, nPeriod_max)) # For all code for (k in 1:nCode) { # Gets the code code = Code[k] # For all the variable for (i in 1:nbp) { df_trend = list_df2plot[[i]]$trend # 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 End = df_trend_code$period_end # Get the name of the different period UStart = levels(factor(Start)) UEnd = levels(factor(End)) # Compute the max of different start and end # so the number of different period nPeriod = max(length(UStart), length(UEnd)) # For all the period for (j in 1:nPeriod_max) { # Stocks period Periods = paste(Start[j], End[j], sep=' / ') # Saves the time info tab_Start[k, i, j] = as.character(Start[j]) tab_End[k, i, j] = as.character(End[j]) tab_Code[k, i, j] = code tab_Periods[k, i, j] = Periods } } } # Blank array to store mean of the trend for each # station, perdiod and variable TrendValue_code = array(rep(1, nPeriod_max*nbp*nCode), dim=c(nPeriod_max, nbp, nCode)) # For all the period for (j in 1:nPeriod_max) { # For all the code for (k in 1:nCode) { # Gets the code code = Code[k] # For all variable for (i in 1:nbp) { # Extracts the data corresponding to the
141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210
# current variable df_data = list_df2plot[[i]]$data # Extracts the trend corresponding to the # current variable df_trend = list_df2plot[[i]]$trend # Extracts the type of the variable type = list_df2plot[[i]]$type 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,] # Gets the associated time info Start = tab_Start[k, i, j] End = tab_End[k, i, j] Periods = tab_Periods[k, i, j] # 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 trendValue = df_trend_code_per$trend / dataMean # If it is a date variable } else if (type == 'saisonnalité') { trendValue = df_trend_code_per$trend } # If the p value is under the threshold if (df_trend_code_per$p <= alpha){ # Stores the mean trend TrendValue_code[j, i, k] = trendValue # Otherwise } else { # Do not stocks it TrendValue_code[j, i, k] = NA } } } } # Compute the min and the max of the mean trend for all the station minTrendValue = apply(TrendValue_code, c(1, 2), min, na.rm=TRUE) maxTrendValue = apply(TrendValue_code, c(1, 2), max, na.rm=TRUE) # If there is a 'mean_period' if (!is.null(mean_period)) { # Blank vectors to store info about breaking analysis Var_mean = c()
211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280
Type_mean = c() Code_mean = c() DataMean_mean = c() breakValue_mean = c() # Convert 'mean_period' to list mean_period = as.list(mean_period) # Number of mean period nPeriod_mean = length(mean_period) # Blank array to store difference of mean between two periods breakValue_code = array(rep(1, nPeriod_mean*nbp*nCode), dim=c(nPeriod_mean, nbp, nCode)) # Blank array to store mean for a temporary period in order # to compute the difference of mean with a second period dataMeantmp = array(rep(NA, nbp*nCode), dim=c(nbp, nCode)) # For all period of breaking analysis for (j in 1:nPeriod_mean) { # For all the code for (k in 1:nCode) { # Gets the code code = Code[k] # For all variable for (i in 1:nbp) { # Extracts the data corresponding to # the current variable df_data = list_df2plot[[i]]$data # Extract the variable of the plot var = list_df2plot[[i]]$var # Extract the type of the variable to plot type = list_df2plot[[i]]$type # Extracts the data corresponding to the code df_data_code = df_data[df_data$code == code,] # Get the current start and end of the sub period Start_mean = mean_period[[j]][1] End_mean = mean_period[[j]][2] # Extract the data corresponding to this sub period df_data_code_per = df_data_code[df_data_code$Date >= Start_mean & df_data_code$Date <= End_mean,] # Min max for the sub period Datemin = min(df_data_code_per$Date) Datemax = max(df_data_code_per$Date) # Mean of the flow over the sub period dataMean = mean(df_data_code_per$Value, na.rm=TRUE) # If this in not the first period if (j > 1) { # Compute the difference of mean Break = dataMean - dataMeantmp[i, k] # Otherwise for the first period } else { # Stocks NA Break = NA } # If it is a flow variable if (type == 'sévérité') { # Normalises the break by the mean of the # initial period breakValue = Break / dataMeantmp[i, k] # If it is a date variable } else if (type == 'saisonnalité') {
281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350
# Just stocks the break value breakValue = Break } # Stores the result breakValue_code[j, i, k] = breakValue # Stores temporarily the mean of the current period dataMeantmp[i, k] = dataMean } } } # Computes the min and the max of the averaged trend for # all the station minBreakValue = apply(breakValue_code, c(1, 2), min, na.rm=TRUE) maxBreakValue = apply(breakValue_code, c(1, 2), max, na.rm=TRUE) } if (is.null(mean_period)) { 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 # 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
351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420
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 cf$default = TRUE # Open a new plot with the personalise theme map = ggplot() + theme_void() + # theme(plot.background=element_rect(fill=NA, # color="#EC4899")) + # 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 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 (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
421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490
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 map = map + theme(plot.margin=margin) } # Blank vector to store data about station lon = c() lat = c() fill = c() shape = c() Value = c() alpha_Ok = 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]
491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560
pvalue = 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,] # Gets the associated time info Start = tab_Start[k, i, idPer_trend] End = tab_End[k, i, idPer_trend] Periods = tab_Periods[k, i, 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] pvalue = 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,
561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630
nbTick=nbTick) # If it is significative if (pvalue <= 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 } # 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 # 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 alpha_Ok = c(alpha_Ok, pvalue <= alpha) } # Creates a tibble to stores all the data to plot plot_map = tibble(lon=lon, lat=lat, fill=fill, shape=shape, code=Code) # If there is no specified station code to highlight # (mini map) if (is.null(codeLight)) { map = map + # Plots the trend point geom_point(data=plot_map, aes(x=lon, y=lat), shape=shape, size=5, stroke=1, color='grey50', fill=fill) # 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,
631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700
aes(x=lon, y=lat), shape=21, size=1.5, stroke=0.5, color='#00A3A8', fill='#00A3A8') } # 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) # New plot with void theme title = ggplot() + theme_void() + # Plots separation line geom_line(aes(x=c(-0.3, 3.7), y=c(0.05, 0.05)), size=0.6, color="#00A3A8") + # Writes title geom_shadowtext(data=tibble(x=-0.3, y=0.2, label=var), 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")) # 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) if (j > 1) { ValueName = "Écarts observés" # If it is a flow variable if (type == 'sévérité') { unit = bquote(bold("(%)")) # If it is a date variable
701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770
} else if (type == 'saisonnalité') { unit = bquote(bold("(jour)")) } } else { ValueName = "Tendances observées" # 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 + # Name of the colorbar annotate('text', x=-0.3, y= valNorm + 23, label=ValueName, hjust=0, vjust=0.5, size=6, color='grey40') + # Unit legend of the colorbar annotate('text', x=-0.2, y= valNorm + 13, 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') } yUp = -20 yNone = -29 if (j > 1) { upLabel = bquote(bold("Hausse")) noneLabel = NULL downLabel = bquote(bold("Baisse")) yDown = -29 } else { upLabel = bquote(bold("Hausse significative à 10%")) noneLabel = bquote(bold("Non significatif à 10%")) downLabel = bquote(bold("Baisse significative à 10%")) 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') if (!is.null(noneLabel)) { pal = pal + # Circle in the marker legend geom_point(aes(x=0, y=yNone), shape=21, size=4, stroke=1,
771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840
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', 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 yValue = yValue[alpha_Ok] # Histogram distribution # Computes the histogram of values res_hist = hist(yValue, breaks=ytick, plot=FALSE) # Extracts the number of counts per cells counts = res_hist$counts # Extracts limits of cells breaks = res_hist$breaks # Extracts middle of cells mids = res_hist$mids # Blank vectors to store position of points of # the distribution to plot xValue = c() yValue = 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(mids)) { # 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,
841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910
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(mids[ii], times=counts[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=21, color='white', fill='grey50', 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.2 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, 1 + 3), expand=c(0, 0)) + # Y axis of the colorbar scale_y_continuous(limits=c(-60, valNorm + 35), 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 (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) {
911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980
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, 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 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) } }
981982983984985986987988989990991992
} # 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) } }