Commit 46dc7437 authored by Heraut Louis's avatar Heraut Louis
Browse files

Aes for trend name

parent 3e1edf46
No related merge requests found
Showing with 149 additions and 114 deletions
+149 -114
...@@ -116,7 +116,7 @@ panels_layout = function (df_data, df_meta, layout_matrix, figdir='', filedir_op ...@@ -116,7 +116,7 @@ panels_layout = function (df_data, df_meta, layout_matrix, figdir='', filedir_op
Htime = time_panel(time_header_code, df_trend_code=NULL, Htime = time_panel(time_header_code, df_trend_code=NULL,
period=period, missRect=TRUE, period=period, missRect=TRUE,
unit2day=365.25, type='Q') unit2day=365.25, type='Q', first=FALSE)
P[[2]] = Htime P[[2]] = Htime
} }
...@@ -134,21 +134,22 @@ panels_layout = function (df_data, df_meta, layout_matrix, figdir='', filedir_op ...@@ -134,21 +134,22 @@ panels_layout = function (df_data, df_meta, layout_matrix, figdir='', filedir_op
df_data_code = df_data[df_data$code == code,] df_data_code = df_data[df_data$code == code,]
df_trend_code = df_trend[df_trend$code == code,] df_trend_code = df_trend[df_trend$code == code,]
if (df_trend_code$p <= p_threshold){ color = c()
color_res = get_color(df_trend_code$trend, for (j in 1:nrow(df_trend_code)) {
minTrend[i], if (df_trend_code$p[j] <= p_threshold){
maxTrend[i], color_res = get_color(df_trend_code$trend[j],
palette_name='perso', minTrend[i],
reverse=FALSE) maxTrend[i],
palette_name='perso',
color = color_res$color reverse=FALSE)
palette = color_res$palette colortmp = color_res$color
} else {
} else { colortmp = NA
color = NULL }
palette = NULL
color = append(color, colortmp)
} }
p = time_panel(df_data_code, df_trend_code, type=type, p = time_panel(df_data_code, df_trend_code, type=type,
p_threshold=p_threshold, missRect=missRect, p_threshold=p_threshold, missRect=missRect,
unit2day=unit2day, last=(i > nbp-nbcol), unit2day=unit2day, last=(i > nbp-nbcol),
......
...@@ -10,7 +10,7 @@ library(ggh4x) ...@@ -10,7 +10,7 @@ library(ggh4x)
library(RColorBrewer) library(RColorBrewer)
time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missRect=FALSE, unit2day=365.25, period=NULL, last=FALSE, color=NULL) { time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missRect=FALSE, unit2day=365.25, period=NULL, last=FALSE, first=FALSE, color=NULL) {
if (type == 'sqrt(Q)') { if (type == 'sqrt(Q)') {
df_data_code$Qm3s = sqrt(df_data_code$Qm3s) df_data_code$Qm3s = sqrt(df_data_code$Qm3s)
...@@ -85,11 +85,22 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR ...@@ -85,11 +85,22 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
) )
if (last) { if (last) {
p = p + if (first) {
theme(plot.margin=margin(1, 5, 5, 5, unit="mm")) p = p +
theme(plot.margin=margin(5, 5, 5, 5, unit="mm"))
} else {
p = p +
theme(plot.margin=margin(0, 5, 5, 5, unit="mm"))
}
} else { } else {
p = p + if (first) {
theme(plot.margin=margin(1, 5, 1, 5, unit="mm")) p = p +
theme(plot.margin=margin(5, 5, 0, 5, unit="mm"))
} else {
p = p +
theme(plot.margin=margin(0, 5, 0, 5, unit="mm"))
}
} }
...@@ -119,21 +130,31 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR ...@@ -119,21 +130,31 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
} }
if ((type == 'sqrt(Q)' | type == 'Q') & !is.null(period)) { if ((type == 'sqrt(Q)' | type == 'Q') & !is.null(period)) {
period = as.Date(period)
p = p + period = as.list(period)
geom_rect(aes(xmin=min(df_data_code$Date), Imin = 10^99
ymin=0, for (per in period) {
xmax=period[1], I = interval(per[1], per[2])
ymax= maxQ*1.1), if (I < Imin) {
linetype=0, fill='grey85', alpha=0.3) + Imin = I
period_min = as.Date(per)
geom_rect(aes(xmin=period[2], }
ymin=0,
xmax=max(df_data_code$Date),
ymax= maxQ*1.1),
linetype=0, fill='grey85', alpha=0.3)
} }
p = p +
geom_rect(aes(xmin=min(df_data_code$Date),
ymin=0,
xmax=period_min[1],
ymax= maxQ*1.1),
linetype=0, fill='grey85', alpha=0.3) +
geom_rect(aes(xmin=period_min[2],
ymin=0,
xmax=max(df_data_code$Date),
ymax= maxQ*1.1),
linetype=0, fill='grey85', alpha=0.3)
}
if (!is.null(df_trend_code)) { if (!is.null(df_trend_code)) {
...@@ -152,14 +173,13 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR ...@@ -152,14 +173,13 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
# } # }
ltype = c('solid', 'dashed', 'dotted', 'twodash') ltype = c('solid', 'dashed', 'dotted', 'twodash')
lty = c('solid', '22')
for (i in 1:nPeriod) { for (i in 1:nPeriod) {
df_trend_code_per = df_trend_code_per =
df_trend_code[df_trend_code$period_start == Start[i] df_trend_code[df_trend_code$period_start == Start[i]
& df_trend_code$period_end == End[i],] & df_trend_code$period_end == End[i],]
# print(df_trend_code_per)
if (df_trend_code_per$p <= p_threshold) { if (df_trend_code_per$p <= p_threshold) {
iStart = which.min(abs(df_data_code$Date - Start[i])) iStart = which.min(abs(df_data_code$Date - Start[i]))
...@@ -167,19 +187,6 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR ...@@ -167,19 +187,6 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
abs = c(df_data_code$Date[iStart], abs = c(df_data_code$Date[iStart],
df_data_code$Date[iEnd]) df_data_code$Date[iEnd])
# abs = seq(df_data_code$Date[1],
# df_data_code$Date[length(df_data_code$Date)],
# length.out=10)
# abs[abs <= df_data_code$Date[iStart]] = NA
# abs[abs >= df_data_code$Date[iEnd]] = NA
# print(abs)
# print(df_trend_code_per$trend)
# print(df_trend_code_per$intercept)
abs_num = as.numeric(abs) / unit2day abs_num = as.numeric(abs) / unit2day
...@@ -189,61 +196,54 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR ...@@ -189,61 +196,54 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
plot = tibble(abs=abs, ord=ord) plot = tibble(abs=abs, ord=ord)
if (!is.null(color)) { if (!is.na(color[i])) {
p = p + p = p +
geom_line(data=plot, aes(x=abs, y=ord), geom_line(data=plot, aes(x=abs, y=ord),
color=color[i], color=color[i],
linetype=ltype[i], size=0.7) linetype=ltype[i], size=0.7)
} else { } else {
p = p + p = p +
geom_line(aes(x=abs, y=ord), geom_line(aes(x=abs, y=ord),
color='cornflowerblue') color='cornflowerblue')
} }
}
}
}
codeDate = df_data_code$Date
codeQ = df_data_code$Qm3s
x = gpct(3, codeDate, shift=TRUE)
xend = x + gpct(3, codeDate)
dy = gpct(5, codeQ, ref=0)
y = gpct(108, codeQ, ref=0) - (i-1)*dy
xt = xend + gpct(1, codeDate)
label = bquote(bold(.(format(df_trend_code$trend, scientific=TRUE, digits=3)))~'['*m^{3}*'.'*s^{-1}*'.'*an^{-1}*']')
p = p +
annotate("segment",
x=x, xend=xend,
y=y, yend=y,
color=color[i],
lty=lty[i], lwd=1) +
annotate("text",
label=label, size=3,
x=xt, y=y,
hjust=0, vjust=0.4,
color=color[i])
# bquote(bold('tendance')~.(format(df_trend_code$trend, scientific=TRUE, digits=3))~'['*m^{3}*'.'*s^{-1}*'.'*an^{-1}*']')
}
# if (norm) { }
# p = p + }
# ggtitle(bquote(bold(.(type))~~'['*m^{3}*'.'*s^{-1}*'] x'~10^{.(as.character(power))}~~~bold('tendance')~.(format(df_trend_code$trend, scientific=TRUE, digits=3))~'['*m^{3}*'.'*s^{-1}*'.'*an^{-1}*']'))
# } else {
# p = p +
# ggtitle(bquote(bold(.(type))~~'['*m^{3}*'.'*s^{-1}*']'~~~bold('tendance')~.(format(df_trend_code$trend, scientific=TRUE, digits=3))~'['*m^{3}*'.'*s^{-1}*'.'*an^{-1}*']'))
# }
# } else {
# if (norm) {
# p = p +
# ggtitle(bquote(bold(.(type))~~'['*m^{3}*'.'*s^{-1}*'] x'~10^{.(as.character(power))}~~~bold('tendance')~.(format(df_trend_code$trend, scientific=TRUE, digits=3))~'['*m^{3}*'.'*s^{-1}*'.'*an^{-1}*']'))
# } else {
# p = p +
# ggtitle(bquote(bold(.(type))~~'['*m^{3}*'.'*s^{-1}*']'~~~bold('tendance')~.(format(df_trend_code$trend, scientific=TRUE, digits=3))~'['*m^{3}*'.'*s^{-1}*'.'*an^{-1}*']'))
# }
# }
# } else {
# if (norm) {
# p = p +
# ggtitle(bquote(bold(.(type))~' ['*m^{3}*'.'*s^{-1}*'] x'~10^{.(as.character(power))}))
# } else {
# p = p +
# ggtitle(bquote(bold(.(type))~' ['*m^{3}*'.'*s^{-1}*']'))
# }
# }
# if (norm) { p = p +
# p = p + ggtitle(bquote(bold(.(type))~~'['*m^{3}*'.'*s^{-1}*']')) +
# ylab(bquote('dbit ['*m^{3}*'.'*s^{-1}*'] x'~10^{.(as.character(power))}))
# } else {
# p = p +
# ylab(expression(paste('dbit [', m^{3}, '.',
# s^{-1}, ']', sep='')))
# }
p = p +
# xlab('date') + # xlab('date') +
scale_x_date(date_breaks=paste(as.character(datebreak), scale_x_date(date_breaks=paste(as.character(datebreak),
'year', sep=' '), 'year', sep=' '),
...@@ -269,33 +269,38 @@ text_panel = function(code, df_meta) { ...@@ -269,33 +269,38 @@ text_panel = function(code, df_meta) {
df_meta_code = df_meta[df_meta$code == code,] df_meta_code = df_meta[df_meta$code == code,]
text1 = paste( text1 = paste(
"<b>", code, '</b> - ', df_meta_code$nom, "<br>", "<b>", code, '</b> - ', df_meta_code$nom, ' &#40;',
df_meta_code$region_hydro, '&#41;',
sep='') sep='')
text2 = paste( text2 = paste(
"<b>", "<b>",
"Rgion hydro : ", df_meta_code$region_hydro, "<br>", "Gestionnaire : ", df_meta_code$gestionnaire, "<br>",
"</b>", "</b>",
sep='') sep='')
text3 = paste( text3 = paste(
"<b>", "<b>",
"Superficie : ", df_meta_code$surface_km2, " [km<sup>2</sup>] <br>", "Superficie : ", df_meta_code$surface_km2_IN,
"X = ", df_meta_code$L93X, " [m ; Lambert 93]", ' (', df_meta_code$surface_km2_BH, ')', " [km<sup>2</sup>] <br>",
"X = ", df_meta_code$L93X_m_IN,
' (', df_meta_code$L93X_m_BH, ')', " [m ; Lambert 93]",
"</b>", "</b>",
sep='') sep='')
text4 = paste( text4 = paste(
"<b>", "<b>",
"Altitude : ", df_meta_code$altitude_m, " [m]<br>", "Altitude : ", df_meta_code$altitude_m_IN,
"Y = ", df_meta_code$L93Y, " [m ; Lambert 93]", ' (', df_meta_code$altitude_m_BH, ')', " [m]<br>",
"Y = ", df_meta_code$L93Y_m_IN,
' (', df_meta_code$L93Y_m_BH, ')', " [m ; Lambert 93]",
"</b>", "</b>",
sep='') sep='')
text5 = paste( text5 = paste(
"<b>", "<b>",
"(Banque Hydro)<br>", "INRAE (Banque Hydro)<br>",
"(Banque Hydro)", "INRAE (Banque Hydro)",
"</b>", "</b>",
sep='') sep='')
...@@ -306,10 +311,10 @@ text_panel = function(code, df_meta) { ...@@ -306,10 +311,10 @@ text_panel = function(code, df_meta) {
gp=gpar(col="#00A3A8", fontsize=14)) gp=gpar(col="#00A3A8", fontsize=14))
gtext2 = richtext_grob(text2, gtext2 = richtext_grob(text2,
x=0, y=0.6, x=0, y=0.55,
margin=unit(c(t=0, r=5, b=0, l=5), "mm"), margin=unit(c(t=0, r=5, b=0, l=5), "mm"),
hjust=0, vjust=1, hjust=0, vjust=1,
gp=gpar(col="grey20", fontsize=9)) gp=gpar(col="grey20", fontsize=8))
gtext3 = richtext_grob(text3, gtext3 = richtext_grob(text3,
x=0, y=1, x=0, y=1,
...@@ -363,11 +368,6 @@ matrice_panel = function (list_df2plot, df_meta) { ...@@ -363,11 +368,6 @@ matrice_panel = function (list_df2plot, df_meta) {
# Get all different stations code # Get all different stations code
Code = levels(factor(df_meta$code)) Code = levels(factor(df_meta$code))
# Type = vector(mode='list', length=nbp)
# for (i in 1:nbp) {
# Type[[i]] =
# }
Type_mat = list() Type_mat = list()
Code_mat = c() Code_mat = c()
Trend_mat = c() Trend_mat = c()
...@@ -616,3 +616,24 @@ gg_circle = function(r, xc, yc, color="black", fill=NA, ...) { ...@@ -616,3 +616,24 @@ gg_circle = function(r, xc, yc, color="black", fill=NA, ...) {
ymin = yc + r*sin(seq(0, -pi, length.out=100)) ymin = yc + r*sin(seq(0, -pi, length.out=100))
annotate("ribbon", x=x, ymin=ymin, ymax=ymax, color=color, fill=fill, ...) annotate("ribbon", x=x, ymin=ymin, ymax=ymax, color=color, fill=fill, ...)
} }
gpct = function (pct, L, ref=NULL, shift=FALSE) {
if (is.null(ref)) {
minL = min(L, na.rm=TRUE)
} else {
minL = ref
}
maxL = max(L, na.rm=TRUE)
spanL = maxL - minL
xL = pct/100 * as.numeric(spanL)
if (shift) {
xL = xL + minL
}
return (xL)
}
...@@ -263,9 +263,21 @@ extract_meta = function (computer_data_path, filedir, filename, verbose=TRUE) { ...@@ -263,9 +263,21 @@ extract_meta = function (computer_data_path, filedir, filename, verbose=TRUE) {
tibble(code=trimws(substr(metatxt[11], 38, nchar(metatxt[11]))), tibble(code=trimws(substr(metatxt[11], 38, nchar(metatxt[11]))),
nom=trimws(substr(metatxt[12], 39, nchar(metatxt[12]))), nom=trimws(substr(metatxt[12], 39, nchar(metatxt[12]))),
territoire=trimws(substr(metatxt[13], 39, nchar(metatxt[13]))), territoire=trimws(substr(metatxt[13], 39, nchar(metatxt[13]))),
L93X=as.numeric(substr(metatxt[16], 38, 50)),
L93Y=as.numeric(substr(metatxt[16], 52, 63)), gestionnaire=trimws(substr(metatxt[7], 60, nchar(metatxt[7]))),
surface_km2=as.numeric(substr(metatxt[19], 38, 50)),
L93X_m_IN=as.numeric(substr(metatxt[16], 65, 77)),
L93X_m_BH=as.numeric(substr(metatxt[16], 38, 50)),
L93Y_m_IN=as.numeric(substr(metatxt[16], 79, 90)),
L93Y_m_BH=as.numeric(substr(metatxt[16], 52, 63)),
surface_km2_IN=as.numeric(substr(metatxt[19], 52, 63)),
surface_km2_BH=as.numeric(substr(metatxt[19], 38, 50)),
altitude_m_IN=as.numeric(substr(metatxt[20], 52, 63)),
altitude_m_BH=as.numeric(substr(metatxt[20], 38, 50)),
statut=iStatut[trimws(substr(metatxt[26], 38, 50))], statut=iStatut[trimws(substr(metatxt[26], 38, 50))],
finalite=iFinalite[trimws(substr(metatxt[26], 52, 56))], finalite=iFinalite[trimws(substr(metatxt[26], 52, 56))],
type=iType[trimws(substr(metatxt[26], 58, 58))], type=iType[trimws(substr(metatxt[26], 58, 58))],
...@@ -289,9 +301,9 @@ extract_meta = function (computer_data_path, filedir, filename, verbose=TRUE) { ...@@ -289,9 +301,9 @@ extract_meta = function (computer_data_path, filedir, filename, verbose=TRUE) {
# Example # Example
# df_meta = extract_meta( # df_meta = extract_meta(
# "/home/louis/Documents/bouleau/INRAE/CDD_stationnarite/data", # "/home/louis/Documents/bouleau/INRAE/CDD_stationnarite/data",
# '', # "BanqueHydro_Export2021",
# c('H5920011_HYDRO_QJM.txt', 'K4470010_HYDRO_QJM.txt')) # c('H5920011_HYDRO_QJM.txt', 'K4470010_HYDRO_QJM.txt'))
# Extraction of data # Extraction of data
......
...@@ -38,6 +38,7 @@ filename = ...@@ -38,6 +38,7 @@ filename =
"O1442910_HYDRO_QJM.txt") "O1442910_HYDRO_QJM.txt")
### AGENCE ADOUR GARONNE SELECTION ### ### AGENCE ADOUR GARONNE SELECTION ###
# Path to the list file of AG data that will be analysed # Path to the list file of AG data that will be analysed
AGlistdir = AGlistdir =
...@@ -199,7 +200,7 @@ res_VCN10trend = get_VCN10trend(df_data, df_meta, ...@@ -199,7 +200,7 @@ res_VCN10trend = get_VCN10trend(df_data, df_meta,
# res_VCN10trend$trend), # res_VCN10trend$trend),
# type=list(bquote(Q[A]), bquote(Q[MNA]), bquote(V[CN10])), # type=list(bquote(Q[A]), bquote(Q[MNA]), bquote(V[CN10])),
# missRect=list(TRUE, TRUE, TRUE), # missRect=list(TRUE, TRUE, TRUE),
# period=period_all, # period=list(period_all, period2),
# info_header=TRUE, # info_header=TRUE,
# time_header=df_data, # time_header=df_data,
# time_ratio=2, # time_ratio=2,
...@@ -215,7 +216,7 @@ panels_layout(list(res_QAtrend$data, res_VCN10trend$data), ...@@ -215,7 +216,7 @@ panels_layout(list(res_QAtrend$data, res_VCN10trend$data),
res_VCN10trend$trend), res_VCN10trend$trend),
type=list(bquote(Q[A]), bquote(V[CN10])), type=list(bquote(Q[A]), bquote(V[CN10])),
missRect=list(TRUE, TRUE), missRect=list(TRUE, TRUE),
period=period_all, period=list(period_all, period2),
info_header=TRUE, info_header=TRUE,
time_header=df_data, time_header=df_data,
time_ratio=2, time_ratio=2,
...@@ -231,7 +232,7 @@ panels_layout(list(res_QAtrend$data, res_VCN10trend$data), ...@@ -231,7 +232,7 @@ panels_layout(list(res_QAtrend$data, res_VCN10trend$data),
# df_trend=list(res_QAtrend$trend), # df_trend=list(res_QAtrend$trend),
# type=list(bquote(Q[A])), # type=list(bquote(Q[A])),
# missRect=list(TRUE), # missRect=list(TRUE),
# period=period_all, # period=list(period_all, period2),
# info_header=TRUE, # info_header=TRUE,
# time_header=df_data, # time_header=df_data,
# time_ratio=2, # time_ratio=2,
......
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