diff --git a/plotting/map.R b/plotting/map.R index c918ea0e5123385faf2574399077a36fae28edc5..5ef6db7f5c5bccaddbb8359b895bd7cb41e549d6 100644 --- a/plotting/map.R +++ b/plotting/map.R @@ -23,7 +23,7 @@ # # plotting/map.R # -# +# Deals with the creation of a map for presenting the trend analysis of hydrological variables ## 1. MAP PANEL @@ -333,118 +333,145 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer=1, outdirTmp='' 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 = Start_code[Code_code == code][[1]][idPer] End = End_code[Code_code == code][[1]][idPer] - + + # 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,] } - + + # Computes the mean of the data on the period dataMean = mean(df_data_code_per$Qm3s, na.rm=TRUE) + # Normalises the trend value by the mean of the data trendMean = df_trend_code_per$trend / dataMean + # Computes the color associated to the mean trend color_res = get_color(trendMean, minTrendMean[idPer, i], maxTrendMean[idPer, i], palette_name='perso', reverse=TRUE, ncolor=256) - + # Computes the colorbar info palette_res = get_palette(minTrendMean[idPer, i], maxTrendMean[idPer, i], palette_name='perso', reverse=TRUE, ncolor=256, nbTick=nbTick) - + + # If it is significative if (df_trend_code_per$p <= p_threshold){ + # The computed color is stored filltmp = color_res - + # If the mean tend is positive if (trendMean >= 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 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) trend = c(trend, trendMean) + # If the trend analysis is significative a TRUE is stored p_threshold_Ok = c(p_threshold_Ok, df_trend_code_per$p <= p_threshold) - } - + # 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='grey70', fill='grey70') + - + # For the station to highlight geom_point(data=plot_map_code, aes(x=lon, y=lat), shape=21, size=1.5, stroke=0.5, color='grey40', fill='grey40') } - + + # 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 - - nbTickmod = length(posTick) - valNorm = nbTickmod * 10 + # Spreading of the colorbar + valNorm = nbTick * 10 + # Normalisation of the position of ticks ytick = posTick / max(posTick) * valNorm - + # Formatting of label in pourcent labTick = as.character(round(labTick*100, 2)) - - xtick = rep(0, times=nbTickmod) + # 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.3), y=c(0.05, 0.05)), size=0.6, color="#00A3A8") + - + # Writes title geom_shadowtext(data=tibble(x=-0.3, y=0.2, label=type), aes(x=x, y=y, label=label), @@ -452,39 +479,40 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer=1, outdirTmp='' color="#00A3A8", bg.colour="white", hjust=0, vjust=0, size=10) + - + # X axis scale_x_continuous(limits=c(-1, 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=5, r=5, 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) pal = pal + - + # Name of the colorbar annotate('text', x=-0.3, y= valNorm + 23, label="Tendance", hjust=0, vjust=0.5, size=6, color='grey40') + - + # Unit legend of the colorbar annotate('text', x=-0.2, y= valNorm + 13, label=bquote(bold("% par an")), hjust=0, vjust=0.5, size=4, color='grey40') - - for (j in 1:nbTickmod) { + # For all the ticks + for (j in 1:nbTick) { pal = pal + + # Adds the value annotate('text', x=xtick[j]+0.3, y=ytick[j], label=bquote(bold(.(labTick[j]))), @@ -493,11 +521,11 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer=1, outdirTmp='' } pal = pal + - + # Up triangle in the marker legend geom_point(aes(x=0, y=-20), shape=24, size=4, stroke=1, color='grey50', fill='grey97') + - + # Up triangle text legend annotate('text', x=0.3, y=-20, label=bquote(bold("Hausse significative à 10%")), @@ -505,11 +533,11 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer=1, outdirTmp='' size=3, color='grey40') pal = pal + - + # Circle in the marker legend geom_point(aes(x=0, y=-29), shape=21, size=4, stroke=1, color='grey50', fill='grey97') + - + # Circle text legend annotate('text', x=0.3, y=-29, label=bquote(bold("Non significatif à 10%")), @@ -517,45 +545,58 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer=1, outdirTmp='' size=3, color='grey40') pal = pal + - + # Down triangle in the marker legend geom_point(aes(x=0, y=-40), shape=25, size=4, stroke=1, color='grey50', fill='grey97') + - + # Down triangle text legend annotate('text', x=0.3, y=-40, label=bquote(bold("Baisse significative à 10%")), hjust=0, vjust=0.5, size=3, color='grey40') - + + # Normalises all the trend values for each station + # according to the colorbar yTrend = (trend - minTrendMean[idPer, i]) / (maxTrendMean[idPer, i] - minTrendMean[idPer, i]) * valNorm - + # Takes only the significative ones yTrend = yTrend[p_threshold_Ok] ## Random distribution ## # xTrend = rnorm(length(yTrend), mean=1.75, sd=0.1) - ## Histogram distribution ## + ## Histogram distribution ## + # Computes the histogram of the trend res_hist = hist(yTrend, 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 xTrend = c() yTrend = c() + # Start X position of the distribution start_hist = 1.25 + # X separation bewteen point hist_sep = 0.15 - + # 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 xTrend = c(xTrend, 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 yTrend = c(yTrend, rep(mids[ii], times=counts[ii])) }