diff --git a/plotting/layout.R b/plotting/layout.R
index 0b057de716d8ade293d713b5c26acd4eb4e727bc..03def19190ad08b4855b4c60079b2ff5955547df 100644
--- a/plotting/layout.R
+++ b/plotting/layout.R
@@ -210,7 +210,7 @@ panels_layout = function (df_data, df_meta, layout_matrix, isplot=c('datasheet',
for (code in Code) {
# 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))
nbg = nbp + nbh
@@ -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,
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
}
@@ -306,7 +306,7 @@ panels_layout = function (df_data, df_meta, layout_matrix, isplot=c('datasheet',
p_threshold=p_threshold, missRect=missRect,
trend_period=trend_period,
mean_period=mean_period, axis_xlim=axis_xlim,
- unit2day=unit2day, last=(i > nbp-nbcol),
+ unit2day=unit2day, grid=FALSE, last=(i > nbp-nbcol),
color=color)
P[[i+nbh]] = p
diff --git a/plotting/panel.R b/plotting/panel.R
index 76ed6a651d043736e3bfedd56059c1c5c4b1f2f1..058df6f30ecfb3f8924a043eff476f997e5d5d13 100644
--- a/plotting/panel.R
+++ b/plotting/panel.R
@@ -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 == 'sqrt(Q)') {
@@ -369,36 +369,38 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
}
### Grid ###
- # If there is no axis limit
- if (is.null(axis_xlim)) {
- # The min and the max is set by
- # the min and the max of the date data
- xmin = min(df_data_code$Date)
- xmax = max(df_data_code$Date)
- } else {
- # Min and max is set with the limit axis parameter
- xmin = axis_xlim[1]
- xmax = axis_xlim[2]
- }
- # Create a vector for all the y grid position
- ygrid = seq(0, maxQ*10, dbrk)
- # Blank vector to store position
- ord = c()
- abs = c()
- # For all the grid element
- for (i in 1:length(ygrid)) {
- # Store grid position
- ord = c(ord, rep(ygrid[i], times=2))
- abs = c(abs, xmin, xmax)
+ if (grid) {
+ # If there is no axis limit
+ if (is.null(axis_xlim)) {
+ # The min and the max is set by
+ # the min and the max of the date data
+ xmin = min(df_data_code$Date)
+ xmax = max(df_data_code$Date)
+ } else {
+ # Min and max is set with the limit axis parameter
+ xmin = axis_xlim[1]
+ xmax = axis_xlim[2]
+ }
+ # Create a vector for all the y grid position
+ ygrid = seq(0, maxQ*10, dbrk)
+ # Blank vector to store position
+ ord = c()
+ abs = c()
+ # For all the grid element
+ for (i in 1:length(ygrid)) {
+ # Store grid position
+ 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 ###
# 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
aes(x=abs, y=ord),
color='white',
linetype='solid',
- size=1,
+ size=1.5,
lineend="round")
}
@@ -635,7 +637,7 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
aes(x=abs, y=ord),
color=color[i],
linetype='solid',
- size=0.5,
+ size=0.75,
lineend="round")
}
}
@@ -1013,7 +1015,7 @@ matrice_panel = function (list_df2plot, df_meta, trend_period, mean_period, slic
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
subCodefL = Code[substr(Code, 1, 1) == fL]
@@ -1393,8 +1395,6 @@ matrice_panel = function (list_df2plot, df_meta, trend_period, mean_period, slic
}
- # print('fff')
-
### Environment ###
mat = mat +
@@ -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
@@ -1562,11 +1562,12 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer=1, outdirTmp=''
if (i > 1 & !is.null(codeLight)) {
break
}
-
- outname = paste('map_', i, sep='')
- print(paste('map :', outname))
type = list_df2plot[[i]]$type
+ outname = paste('map_', type, sep='')
+ if (verbose) {
+ print(paste('Map for variable :', type))
+ }
if (is.null(codeLight)) {
sizefr = 0.45
@@ -1869,16 +1870,59 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer=1, outdirTmp=''
label=bquote(bold("Baisse significative à 10%")),
hjust=0, vjust=0.5,
size=3, color='grey40')
-
- # print(minTrendMean[idPer, i])
- # print(maxTrendMean[idPer, i])
yTrend = (trend - minTrendMean[idPer, i]) /
(maxTrendMean[idPer, i] - minTrendMean[idPer, i]) * valNorm
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)
pal = pal +
@@ -2008,7 +2052,8 @@ info_panel = function(list_df2plot, df_meta, df_shapefile, codeLight, df_data_co
df_shapefile=df_shapefile,
codeLight=codeLight,
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,]
@@ -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]",
"</b>",
sep='')
-
+
text4 = paste(
"<b>",
"Date de début : ", debut, "<br>",
"Date de fin : ", fin, "<br>",
- "Nombre d'années : ", duration, " [ans]",
+ "Nombre d'années : ", duration, " [ans]", "<br>",
+ "Taux de lacunes : ", signif(df_meta_code$tLac100, 2), " [%]",
"</b>",
sep='')
diff --git a/processing/analyse.R b/processing/analyse.R
index 9eb4f554991533376b180301795f2317723832c7..2d5e0f603237236276c182730e2d959805daf224 100644
--- a/processing/analyse.R
+++ b/processing/analyse.R
@@ -11,10 +11,10 @@ source('processing/format.R', encoding='latin1')
# 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
- Code = levels(factor(df_info$code))
+ Code = levels(factor(df_meta$code))
# Create new vector to stock results for cumulative time gap by station
tLac = c()
@@ -58,11 +58,14 @@ get_lacune = function (df_data, df_info) {
# Compute the cumulative gap rate in pourcent
tLac100 = tLac * 100
-
- # Create a tibble
+
+ # Create tibble for lacune
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)
}
diff --git a/script.R b/script.R
index 8bfe70ffa69bcfd078fff6ce9e5b6b0e4c1e3294..90472d295fadc66711d9346c8892090becd9f472 100644
--- a/script.R
+++ b/script.R
@@ -194,7 +194,7 @@ df_meta = df_join$meta
# ANALYSE #
# Compute gap parameters for stations
-# df_lac = get_lacune(df_data, df_meta)
+df_meta = get_lacune(df_data, df_meta)
# QA TREND #
@@ -235,12 +235,12 @@ res_VCN10trend = get_VCN10trend(df_data, df_meta,
# 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(
- 'datasheet',
- 'matrix',
+ # 'datasheet',
+ # 'matrix',
'map'
),
df_data=list(res_QAtrend$data, res_QMNAtrend$data,