Commit cfddf7f2 authored by Heraut Louis's avatar Heraut Louis
Browse files

Cleaned and commented

parent 461a5d38
No related merge requests found
Showing with 88 additions and 47 deletions
+88 -47
......@@ -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]))
}
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment