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

Distrib map

parent 0b0101a5
No related merge requests found
Showing with 107 additions and 58 deletions
+107 -58
...@@ -210,7 +210,7 @@ panels_layout = function (df_data, df_meta, layout_matrix, isplot=c('datasheet', ...@@ -210,7 +210,7 @@ panels_layout = function (df_data, df_meta, layout_matrix, isplot=c('datasheet',
for (code in Code) { for (code in Code) {
# Print code of the station for the current plotting # Print code of the station for the current plotting
print(paste("Plotting for station :", code)) print(paste("Datasheet for station :", code))
nbh = as.numeric(info_header) + as.numeric(!is.null(time_header)) nbh = as.numeric(info_header) + as.numeric(!is.null(time_header))
nbg = nbp + nbh nbg = nbp + nbh
...@@ -237,7 +237,7 @@ panels_layout = function (df_data, df_meta, layout_matrix, isplot=c('datasheet', ...@@ -237,7 +237,7 @@ panels_layout = function (df_data, df_meta, layout_matrix, isplot=c('datasheet',
Htime = time_panel(time_header_code, df_trend_code=NULL, Htime = time_panel(time_header_code, df_trend_code=NULL,
trend_period=trend_period, missRect=TRUE, trend_period=trend_period, missRect=TRUE,
unit2day=365.25, type='Q', first=FALSE) unit2day=365.25, type='Q', grid=TRUE, first=FALSE)
P[[2]] = Htime P[[2]] = Htime
} }
...@@ -306,7 +306,7 @@ panels_layout = function (df_data, df_meta, layout_matrix, isplot=c('datasheet', ...@@ -306,7 +306,7 @@ panels_layout = function (df_data, df_meta, layout_matrix, isplot=c('datasheet',
p_threshold=p_threshold, missRect=missRect, p_threshold=p_threshold, missRect=missRect,
trend_period=trend_period, trend_period=trend_period,
mean_period=mean_period, axis_xlim=axis_xlim, mean_period=mean_period, axis_xlim=axis_xlim,
unit2day=unit2day, last=(i > nbp-nbcol), unit2day=unit2day, grid=FALSE, last=(i > nbp-nbcol),
color=color) color=color)
P[[i+nbh]] = p P[[i+nbh]] = p
......
...@@ -74,7 +74,7 @@ theme_ash = ...@@ -74,7 +74,7 @@ theme_ash =
) )
time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missRect=FALSE, unit2day=365.25, trend_period=NULL, mean_period=NULL, axis_xlim=NULL, last=FALSE, first=FALSE, color=NULL) { time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missRect=FALSE, unit2day=365.25, trend_period=NULL, mean_period=NULL, axis_xlim=NULL, grid=TRUE, last=FALSE, first=FALSE, color=NULL) {
# If 'type' is square root apply it to data # If 'type' is square root apply it to data
if (type == 'sqrt(Q)') { if (type == 'sqrt(Q)') {
...@@ -369,36 +369,38 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR ...@@ -369,36 +369,38 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
} }
### Grid ### ### Grid ###
# If there is no axis limit if (grid) {
if (is.null(axis_xlim)) { # If there is no axis limit
# The min and the max is set by if (is.null(axis_xlim)) {
# the min and the max of the date data # The min and the max is set by
xmin = min(df_data_code$Date) # the min and the max of the date data
xmax = max(df_data_code$Date) xmin = min(df_data_code$Date)
} else { xmax = max(df_data_code$Date)
# Min and max is set with the limit axis parameter } else {
xmin = axis_xlim[1] # Min and max is set with the limit axis parameter
xmax = axis_xlim[2] xmin = axis_xlim[1]
} xmax = axis_xlim[2]
# Create a vector for all the y grid position }
ygrid = seq(0, maxQ*10, dbrk) # Create a vector for all the y grid position
# Blank vector to store position ygrid = seq(0, maxQ*10, dbrk)
ord = c() # Blank vector to store position
abs = c() ord = c()
# For all the grid element abs = c()
for (i in 1:length(ygrid)) { # For all the grid element
# Store grid position for (i in 1:length(ygrid)) {
ord = c(ord, rep(ygrid[i], times=2)) # Store grid position
abs = c(abs, xmin, xmax) ord = c(ord, rep(ygrid[i], times=2))
abs = c(abs, xmin, xmax)
}
# Create a tibble to store all the position
plot_grid = tibble(abs=as.Date(abs), ord=ord)
# Plot the y grid
p = p +
geom_line(data=plot_grid,
aes(x=abs, y=ord, group=ord),
color='grey85',
size=0.15)
} }
# Create a tibble to store all the position
plot_grid = tibble(abs=as.Date(abs), ord=ord)
# Plot the y grid
p = p +
geom_line(data=plot_grid,
aes(x=abs, y=ord, group=ord),
color='grey85',
size=0.15)
### Data ### ### Data ###
# If it is a square root flow or flow # If it is a square root flow or flow
...@@ -620,7 +622,7 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR ...@@ -620,7 +622,7 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
aes(x=abs, y=ord), aes(x=abs, y=ord),
color='white', color='white',
linetype='solid', linetype='solid',
size=1, size=1.5,
lineend="round") lineend="round")
} }
...@@ -635,7 +637,7 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR ...@@ -635,7 +637,7 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
aes(x=abs, y=ord), aes(x=abs, y=ord),
color=color[i], color=color[i],
linetype='solid', linetype='solid',
size=0.5, size=0.75,
lineend="round") lineend="round")
} }
} }
...@@ -1013,7 +1015,7 @@ matrice_panel = function (list_df2plot, df_meta, trend_period, mean_period, slic ...@@ -1013,7 +1015,7 @@ matrice_panel = function (list_df2plot, df_meta, trend_period, mean_period, slic
for (fL in firstLetter) { for (fL in firstLetter) {
print(paste('matrix for region :', fL)) print(paste('Matrix for region :', fL))
# Get only station code with the same first letter # Get only station code with the same first letter
subCodefL = Code[substr(Code, 1, 1) == fL] subCodefL = Code[substr(Code, 1, 1) == fL]
...@@ -1393,8 +1395,6 @@ matrice_panel = function (list_df2plot, df_meta, trend_period, mean_period, slic ...@@ -1393,8 +1395,6 @@ matrice_panel = function (list_df2plot, df_meta, trend_period, mean_period, slic
} }
# print('fff')
### Environment ### ### Environment ###
mat = mat + mat = mat +
...@@ -1435,7 +1435,7 @@ matrice_panel = function (list_df2plot, df_meta, trend_period, mean_period, slic ...@@ -1435,7 +1435,7 @@ matrice_panel = function (list_df2plot, df_meta, trend_period, mean_period, slic
} }
map_panel = function (list_df2plot, df_meta, df_shapefile, idPer=1, outdirTmp='', codeLight=NULL, margin=NULL, showSea=TRUE) { map_panel = function (list_df2plot, df_meta, df_shapefile, idPer=1, outdirTmp='', codeLight=NULL, margin=NULL, showSea=TRUE, verbose=TRUE) {
df_france = df_shapefile$france df_france = df_shapefile$france
...@@ -1562,11 +1562,12 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer=1, outdirTmp='' ...@@ -1562,11 +1562,12 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer=1, outdirTmp=''
if (i > 1 & !is.null(codeLight)) { if (i > 1 & !is.null(codeLight)) {
break break
} }
outname = paste('map_', i, sep='')
print(paste('map :', outname))
type = list_df2plot[[i]]$type type = list_df2plot[[i]]$type
outname = paste('map_', type, sep='')
if (verbose) {
print(paste('Map for variable :', type))
}
if (is.null(codeLight)) { if (is.null(codeLight)) {
sizefr = 0.45 sizefr = 0.45
...@@ -1869,16 +1870,59 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer=1, outdirTmp='' ...@@ -1869,16 +1870,59 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer=1, outdirTmp=''
label=bquote(bold("Baisse significative 10%")), label=bquote(bold("Baisse significative 10%")),
hjust=0, vjust=0.5, hjust=0, vjust=0.5,
size=3, color='grey40') size=3, color='grey40')
# print(minTrendMean[idPer, i])
# print(maxTrendMean[idPer, i])
yTrend = (trend - minTrendMean[idPer, i]) / yTrend = (trend - minTrendMean[idPer, i]) /
(maxTrendMean[idPer, i] - minTrendMean[idPer, i]) * valNorm (maxTrendMean[idPer, i] - minTrendMean[idPer, i]) * valNorm
yTrend = yTrend[p_threshold_Ok] yTrend = yTrend[p_threshold_Ok]
## Random distribution ##
# xTrend = rnorm(length(yTrend), mean=1.75, sd=0.1)
## Histogram distribution ##
res_hist = hist(yTrend, breaks=ytick, plot=FALSE)
counts = res_hist$counts
breaks = res_hist$breaks
mids = res_hist$mids
xTrend = c()
yTrend = c()
start_hist = 1.25
hist_sep = 0.15
for (ii in 1:length(mids)) {
if (counts[ii] != 0) {
xTrend = c(xTrend,
seq(start_hist,
start_hist+(counts[ii]-1)*hist_sep,
by=hist_sep))
}
yTrend = c(yTrend, rep(mids[ii], times=counts[ii]))
}
## No touch distribution ##
# start_hist = 1.25
# min_xsep = 0.15
# min_ysep = 4
# xTrend = rep(start_hist, times=length(yTrend))
# for (ii in 1:length(yTrend)) {
# yTrendtmp = yTrend
# yTrendtmp[ii] = 1E99
# isinf_ysep = abs(yTrendtmp - yTrend[ii]) < min_ysep
# if (any(isinf_ysep) & !all(xTrend[which(isinf_ysep)] > start_hist)) {
# xTrend[ii] = max(xTrend[which(isinf_ysep)]) + min_xsep
# }
# }
xTrend = rnorm(length(yTrend), mean=1.75, sd=0.1)
plot_trend = tibble(xTrend=xTrend, yTrend=yTrend) plot_trend = tibble(xTrend=xTrend, yTrend=yTrend)
pal = pal + pal = pal +
...@@ -2008,7 +2052,8 @@ info_panel = function(list_df2plot, df_meta, df_shapefile, codeLight, df_data_co ...@@ -2008,7 +2052,8 @@ info_panel = function(list_df2plot, df_meta, df_shapefile, codeLight, df_data_co
df_shapefile=df_shapefile, df_shapefile=df_shapefile,
codeLight=codeLight, codeLight=codeLight,
margin=margin(t=5, r=2, b=0, l=0, unit="mm"), margin=margin(t=5, r=2, b=0, l=0, unit="mm"),
showSea=FALSE) showSea=FALSE,
verbose=FALSE)
df_meta_code = df_meta[df_meta$code == codeLight,] df_meta_code = df_meta[df_meta$code == codeLight,]
...@@ -2039,12 +2084,13 @@ info_panel = function(list_df2plot, df_meta, df_shapefile, codeLight, df_data_co ...@@ -2039,12 +2084,13 @@ info_panel = function(list_df2plot, df_meta, df_shapefile, codeLight, df_data_co
"Y = ", df_meta_code$L93Y_m_BH, " [m ; Lambert 93]", "Y = ", df_meta_code$L93Y_m_BH, " [m ; Lambert 93]",
"</b>", "</b>",
sep='') sep='')
text4 = paste( text4 = paste(
"<b>", "<b>",
"Date de dbut : ", debut, "<br>", "Date de dbut : ", debut, "<br>",
"Date de fin : ", fin, "<br>", "Date de fin : ", fin, "<br>",
"Nombre d'annes : ", duration, " [ans]", "Nombre d'annes : ", duration, " [ans]", "<br>",
"Taux de lacunes : ", signif(df_meta_code$tLac100, 2), " [%]",
"</b>", "</b>",
sep='') sep='')
......
...@@ -11,10 +11,10 @@ source('processing/format.R', encoding='latin1') ...@@ -11,10 +11,10 @@ source('processing/format.R', encoding='latin1')
# Compute the time gap by station # Compute the time gap by station
get_lacune = function (df_data, df_info) { get_lacune = function (df_data, df_meta) {
# Get all different stations code # Get all different stations code
Code = levels(factor(df_info$code)) Code = levels(factor(df_meta$code))
# Create new vector to stock results for cumulative time gap by station # Create new vector to stock results for cumulative time gap by station
tLac = c() tLac = c()
...@@ -58,11 +58,14 @@ get_lacune = function (df_data, df_info) { ...@@ -58,11 +58,14 @@ get_lacune = function (df_data, df_info) {
# Compute the cumulative gap rate in pourcent # Compute the cumulative gap rate in pourcent
tLac100 = tLac * 100 tLac100 = tLac * 100
# Create a tibble # Create tibble for lacune
df_lac = tibble(code=Code, tLac100=tLac100, meanLac=meanLac) df_lac = tibble(code=Code, tLac100=tLac100, meanLac=meanLac)
return (df_lac) # Join a tibble
df_meta = full_join(df_meta, df_lac)
return (df_meta)
} }
......
...@@ -194,7 +194,7 @@ df_meta = df_join$meta ...@@ -194,7 +194,7 @@ df_meta = df_join$meta
# ANALYSE # # ANALYSE #
# Compute gap parameters for stations # Compute gap parameters for stations
# df_lac = get_lacune(df_data, df_meta) df_meta = get_lacune(df_data, df_meta)
# QA TREND # # QA TREND #
...@@ -235,12 +235,12 @@ res_VCN10trend = get_VCN10trend(df_data, df_meta, ...@@ -235,12 +235,12 @@ res_VCN10trend = get_VCN10trend(df_data, df_meta,
# filename_opt='time') # filename_opt='time')
df_shapefile = ini_shapefile(computer_data_path, fr_shpdir, fr_shpname, bs_shpdir, bs_shpname, rv_shpdir, rv_shpname, riv=TRUE) df_shapefile = ini_shapefile(computer_data_path, fr_shpdir, fr_shpname, bs_shpdir, bs_shpname, rv_shpdir, rv_shpname, riv=FALSE)
panels_layout(isplot=c( panels_layout(isplot=c(
'datasheet', # 'datasheet',
'matrix', # 'matrix',
'map' 'map'
), ),
df_data=list(res_QAtrend$data, res_QMNAtrend$data, df_data=list(res_QAtrend$data, res_QMNAtrend$data,
......
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