An error occurred while loading the file. Please try again.
-
Heraut Louis authoredb27389a6
# Usefull librarylibrary(ggplot2)library(scales)library(qpdf)library(gridExtra)library(gridtext)library(dplyr)library(grid)library(ggh4x)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, first=FALSE, color=NULL) { if (type == 'sqrt(Q)') { df_data_code$Qm3s = sqrt(df_data_code$Qm3s) } maxQ = max(df_data_code$Qm3s, na.rm=TRUE) power = get_power(maxQ) maxQtmp = maxQ/10^power if (maxQtmp >= 5) { dbrk = 1.0 } else if (maxQtmp < 5 & maxQtmp >= 3) { dbrk = 0.5 } else if (maxQtmp < 3 & maxQtmp >= 2) { dbrk = 0.4 } else if (maxQtmp < 2 & maxQtmp >= 1) { dbrk = 0.2 } else if (maxQtmp < 1) { dbrk = 0.1 } dbrk = dbrk * 10^power accuracy = NULL dDate = as.numeric(df_data_code$Date[length(df_data_code$Date)] - df_data_code$Date[1]) / unit2day if (dDate >= 100) { datebreak = 25 dateminbreak = 5 } else if (dDate < 100 & dDate >= 50) { datebreak = 10 dateminbreak = 1 } else if (dDate < 50) { datebreak = 5 dateminbreak = 1 } p = ggplot() + # theme_bw() + theme(panel.background=element_rect(fill='white'), text=element_text(family='sans'), # panel.border=element_blank(), panel.border = element_rect(color="grey85", fill=NA, size=0.7), # panel.grid.major.y=element_line(color='grey85', size=0.3), panel.grid.major.y=element_line(color='grey85', size=0.15), panel.grid.major.x=element_blank(), # axis.ticks.y=element_blank(), axis.ticks.y=element_line(color='grey75', size=0.3), axis.ticks.x=element_line(color='grey75', size=0.3),7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
axis.text.x=element_text(color='grey40'),
axis.text.y=element_text(color='grey40'),
ggh4x.axis.ticks.length.minor=rel(0.5),
axis.ticks.length=unit(1.5, 'mm'),
plot.title=element_text(size=9, vjust=-2,
hjust=-1E-3, color='grey20'),
axis.title.x=element_blank(),
axis.title.y=element_blank(),
# axis.title.y=element_text(size=8, color='grey20'),
axis.line.x=element_blank(),
axis.line.y=element_blank(),
)
if (last) {
if (first) {
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 {
if (first) {
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"))
}
}
if (type == 'sqrt(Q)' | type == 'Q') {
p = p +
geom_line(aes(x=df_data_code$Date, y=df_data_code$Qm3s),
color='grey20',
size=0.3)
} else {
p = p +
geom_point(aes(x=df_data_code$Date, y=df_data_code$Qm3s),
shape=1, color='grey20', size=1)
}
if (missRect) {
NAdate = df_data_code$Date[is.na(df_data_code$Qm3s)]
dNAdate = diff(NAdate)
NAdate_Down = NAdate[append(Inf, dNAdate) != 1]
NAdate_Up = NAdate[append(dNAdate, Inf) != 1]
p = p +
geom_rect(aes(xmin=NAdate_Down,
ymin=0,
xmax=NAdate_Up,
ymax=maxQ*1.1),
linetype=0, fill='Wheat', alpha=0.4)
}
if ((type == 'sqrt(Q)' | type == 'Q') & !is.null(period)) {
period = as.list(period)
Imin = 10^99
for (per in period) {
I = interval(per[1], per[2])
if (I < Imin) {
Imin = I
period_min = as.Date(per)
141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210
}
}
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)) {
# print(df_trend_code)
Start = df_trend_code$period_start
UStart = levels(factor(Start))
End = df_trend_code$period_end
UEnd = levels(factor(End))
nPeriod = max(length(UStart), length(UEnd))
Periods = vector(mode='list', length=nPeriod)
# for (i in 1:nPeriod) {
# Periods[[i]] = as.Date(c(Period_start[i], Period_end[i]))
# }
ltype = c('solid', 'dashed', 'dotted', 'twodash')
lty = c('solid', '22', 'dotted', 'twodash')
ii = 0
for (i in 1:nPeriod) {
df_trend_code_per =
df_trend_code[df_trend_code$period_start == Start[i]
& df_trend_code$period_end == End[i],]
if (df_trend_code_per$p <= p_threshold) {
ii = ii + 1
iStart = which.min(abs(df_data_code$Date - Start[i]))
iEnd = which.min(abs(df_data_code$Date - End[i]))
abs = c(df_data_code$Date[iStart],
df_data_code$Date[iEnd])
abs_num = as.numeric(abs) / unit2day
ord = abs_num * df_trend_code_per$trend +
df_trend_code_per$intercept
plot = tibble(abs=abs, ord=ord)
if (!is.na(color[i])) {
p = p +
geom_line(data=plot, aes(x=abs, y=ord),
color=color[i],
linetype=ltype[i], size=0.7)
} else {
p = p +
geom_line(aes(x=abs, y=ord),
211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280
color='cornflowerblue')
}
codeDate = df_data_code$Date
codeQ = df_data_code$Qm3s
x = gpct(2, codeDate, shift=TRUE)
xend = x + gpct(3, codeDate)
dy = gpct(6, codeQ, ref=0)
y = gpct(100, codeQ, ref=0) - (ii-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])
}
}
}
p = p +
ggtitle(bquote(bold(.(type))~~'['*m^{3}*'.'*s^{-1}*']')) +
scale_x_date(date_breaks=paste(as.character(datebreak),
'year', sep=' '),
date_minor_breaks=paste(as.character(dateminbreak),
'year', sep=' '),
guide='axis_minor',
date_labels="%Y",
limits=c(min(df_data_code$Date),
max(df_data_code$Date)),
expand=c(0, 0))
p = p +
scale_y_continuous(breaks=seq(0, maxQ*10, dbrk),
limits=c(0, maxQ*1.1),
expand=c(0, 0),
labels=label_number(accuracy=accuracy))
return(p)
}
text_panel = function(code, df_meta) {
df_meta_code = df_meta[df_meta$code == code,]
text1 = paste(
"<b>", code, '</b> - ', df_meta_code$nom, ' (',
df_meta_code$region_hydro, ')',
sep='')
text2 = paste(
"<b>",
"Gestionnaire : ", df_meta_code$gestionnaire, "<br>",
"</b>",
sep='')
text3 = paste(
"<b>",
281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350
"Superficie : ", df_meta_code$surface_km2_IN,
' (', 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>",
sep='')
text4 = paste(
"<b>",
"Altitude : ", df_meta_code$altitude_m_IN,
' (', 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>",
sep='')
text5 = paste(
"<b>",
"INRAE (Banque Hydro)<br>",
"INRAE (Banque Hydro)",
"</b>",
sep='')
gtext1 = richtext_grob(text1,
x=0, y=1,
margin=unit(c(t=5, r=5, b=0, l=5), "mm"),
hjust=0, vjust=1,
gp=gpar(col="#00A3A8", fontsize=14))
gtext2 = richtext_grob(text2,
x=0, y=0.55,
margin=unit(c(t=0, r=5, b=0, l=5), "mm"),
hjust=0, vjust=1,
gp=gpar(col="grey20", fontsize=8))
gtext3 = richtext_grob(text3,
x=0, y=1,
margin=unit(c(t=0, r=5, b=5, l=5), "mm"),
hjust=0, vjust=1,
gp=gpar(col="grey20", fontsize=9))
gtext4 = richtext_grob(text4,
x=0, y=1,
margin=unit(c(t=0, r=5, b=5, l=5), "mm"),
hjust=0, vjust=1,
gp=gpar(col="grey20", fontsize=9))
gtext5 = richtext_grob(text5,
x=0, y=1,
margin=unit(c(t=0, r=5, b=5, l=5), "mm"),
hjust=0, vjust=1,
gp=gpar(col="grey20", fontsize=9))
gtext_merge = grid.arrange(grobs=list(gtext1, gtext2, gtext3,
gtext4, gtext5),
layout_matrix=matrix(c(1, 1, 1,
2, 2, 2,
3, 4, 5),
nrow=3,
byrow=TRUE))
return(gtext_merge)
}
matrice_panel = function (list_df2plot, df_meta) {
nbp = length(list_df2plot)
minTrend = c()
351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420
maxTrend = c()
for (i in 1:nbp) {
df_trend = list_df2plot[[i]]$trend
p_threshold = list_df2plot[[i]]$p_threshold
okTrend = df_trend$trend[df_trend$p <= p_threshold]
minTrend[i] = min(okTrend, na.rm=TRUE)
maxTrend[i] = max(okTrend, na.rm=TRUE)
}
# Get all different stations code
Code = levels(factor(df_meta$code))
nCode = length(Code)
nPeriod_max = 0
Start_code = vector(mode='list', length=nCode)
End_code = vector(mode='list', length=nCode)
Code_code = vector(mode='list', length=nCode)
Periods_code = vector(mode='list', length=nCode)
df_trend = list_df2plot[[1]]$trend
for (j in 1:nCode) {
code = Code[j]
df_trend_code = df_trend[df_trend$code == code,]
Start = df_trend_code$period_start
UStart = levels(factor(Start))
End = df_trend_code$period_end
UEnd = levels(factor(End))
nPeriod = max(length(UStart), length(UEnd))
Periods = c()#vector(mode='list', length=nPeriod)
for (i in 1:nPeriod) {
Periods = append(Periods,
paste(Start[i], End[i], sep=' / '))
}
Start_code[[j]] = Start
End_code[[j]] = End
Code_code[[j]] = code
Periods_code[[j]] = Periods
if (nPeriod > nPeriod_max) {
nPeriod_max = nPeriod
}
}
# print(Code_code)
# print(Periods_code)
Periods_mat = c()
NPeriod_mat = c()
Type_mat = list()
Code_mat = c()
Trend_mat = c()
Fill_mat = c()
Color_mat = c()
for (j in 1:nPeriod_max) {
for (code in Code) {
421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490
for (i in 1:nbp) {
df_trend = list_df2plot[[i]]$trend
p_threshold = list_df2plot[[i]]$p_threshold
type = list_df2plot[[i]]$type
# print(code)
df_trend_code = df_trend[df_trend$code == code,]
# print(df_trend_code)
# print(Code_code == code )
# print(Start_code)
Start = Start_code[Code_code == code][[1]][j]
End = End_code[Code_code == code][[1]][j]
Periods = Periods_code[Code_code == code][[1]][j]
# print(Periods)
df_trend_code_per =
df_trend_code[df_trend_code$period_start == Start
& df_trend_code$period_end == End,]
if (df_trend_code_per$p <= p_threshold){
color_res = get_color(df_trend_code_per$trend,
minTrend[i],
maxTrend[i],
palette_name='perso',
reverse=FALSE)
fill = color_res$color
color = 'white'
} else {
fill = 'white'
color = 'grey85'
}
# print(fill)
trend = df_trend_code_per$trend
Periods_mat = append(Periods_mat, Periods)
NPeriod_mat = append(NPeriod_mat, j)
Type_mat = append(Type_mat, type)
Code_mat = append(Code_mat, code)
Trend_mat = append(Trend_mat, trend)
Fill_mat = append(Fill_mat, fill)
Color_mat = append(Color_mat, color)
}
}
}
height = length(Code)
width = nbp * 2 * nPeriod_max
# print(height)
# print(width)
options(repr.plot.width=width, repr.plot.height=height)
mat = ggplot() +
theme(
panel.background=element_rect(fill='white'),
text=element_text(family='sans'),
panel.border=element_blank(),
panel.grid.major.y=element_blank(),
panel.grid.major.x=element_blank(),
491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560
# axis.text.x=element_blank(),
# axis.text.y=element_blank(),
# axis.ticks.y=element_blank(),
# axis.ticks.x=element_blank(),
ggh4x.axis.ticks.length.minor=rel(0.5),
axis.ticks.length=unit(1.5, 'mm'),
plot.title=element_text(size=9, vjust=-3,
hjust=-1E-3, color='grey20'),
axis.title.x=element_blank(),
axis.title.y=element_blank(),
axis.line.x=element_blank(),
axis.line.y=element_blank(),
plot.margin=margin(5, 5, 5, 5, unit="mm"),
)
X = c(0)
for (j in 1:nPeriod_max) {
print(j)
Type_mat_per = Type_mat[NPeriod_mat == j]
Code_mat_per = Code_mat[NPeriod_mat == j]
Trend_mat_per = Trend_mat[NPeriod_mat == j]
Fill_mat_per = Fill_mat[NPeriod_mat == j]
Color_mat_per = Color_mat[NPeriod_mat == j]
Xtmp = as.integer(factor(as.character(Type_mat_per)))
X = Xtmp + X[length(X)]
# print(X)
Y = as.integer(factor(Code_mat_per))
# print(Y)
for (i in 1:length(X)) {
mat = mat +
gg_circle(r=0.45, xc=X[i], yc=Y[i],
fill=Fill_mat_per[i], color=Color_mat_per[i])
}
for (i in 1:nbp) {
type = list_df2plot[[i]]$type
mat = mat +
annotate('text', x=i, y=max(Y) + 0.6,
label=bquote(.(type)),
hjust=0.5, vjust=0,
size=3.5, color='grey40')
}
for (i in 1:length(Trend_mat_per)) {
trend = Trend_mat_per[i]
if (!is.na(trend)) {
power = get_power(trend)
dbrk = 10^power
trendN = round(trend / dbrk, 2)
trendC1 = as.character(trendN)
trendC2 = bquote('x '*10^{.(as.character(power))})
} else {
trendC1 = ''
trendC2 = ''
}
mat = mat +
561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630
annotate('text', x=X[i], y=Y[i],
label=trendC1,
hjust=0.5, vjust=0,
size=3, color='white') +
annotate('text', x=X[i], y=Y[i],
label=trendC2,
hjust=0.5, vjust=1.3,
size=2, color='white')
}
}
for (i in 1:length(Code)) {
code = Code[i]
name = df_meta[df_meta$code == code,]$name
print(name)
mat = mat +
annotate('text', x=-1, y=i,
label=code,
hjust=0, vjust=0,
size=3.5, color='grey40') +
annotate('text', x=-1, y=i,
label=name,
hjust=0, vjust=1,
size=3.5, color='grey40')
}
# print(Y)
mat = mat +
annotate("segment",
x = width/2 + 0.5, xend = width/2 + 0.5,
y = 1 - 0.5, yend = height + 0.5,
color="grey85")
mat = mat +
coord_fixed() +
scale_x_continuous(limits=c(1 - rel(2),
width + rel(0.5)),
expand=c(0, 0)) +
scale_y_continuous(limits=c(1 - rel(0.5),
height + rel(1)),
expand=c(0, 0))
return (mat)
}
get_color = function (value, min, max, ncolor=256, palette_name='perso', reverse=FALSE) {
if (palette_name == 'perso') {
palette = colorRampPalette(c(
'#1a4157',
'#00af9d',
'#fbdd7e',
'#fdb147',
'#fd4659'
))(ncolor)
} else {
631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700
palette = colorRampPalette(brewer.pal(11, palette_name))(ncolor)
}
if (reverse) {
palette = rev(palette)
}
palette_cold = palette[1:as.integer(ncolor/2)]
palette_hot = palette[(as.integer(ncolor/2)+1):ncolor]
ncolor_cold = length(palette_cold)
ncolor_hot = length(palette_hot)
if (value < 0) {
idNorm = (value - min) / (0 - min)
id = round(idNorm*(ncolor_cold - 1) + 1, 0)
color = palette_cold[id]
} else {
idNorm = (value - 0) / (max - 0)
id = round(idNorm*(ncolor_hot - 1) + 1, 0)
color = palette_hot[id]
}
return(list(color=color, palette=palette))
}
void = ggplot() + geom_blank(aes(1,1)) +
theme(
plot.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.background = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks = element_blank(),
axis.line = element_blank()
)
palette_tester = function () {
n = 300
X = 1:n
Y = rep(0, times=n)
palette = colorRampPalette(c(
'#1a4157',
'#00af9d',
'#fbdd7e',
'#fdb147',
'#fd4659'
))(n)
p = ggplot() +
geom_line(aes(x=X, y=Y), color=palette[X], size=10) +
scale_y_continuous(expand=c(0, 0))
ggsave(plot=p,
path='/figures',
filename=paste('palette_test', '.pdf', sep=''),
width=10, height=10, units='cm', dpi=100)
}
# palette_teste()
701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743
get_power = function (value) {
if (value > 1) {
power = nchar(as.character(as.integer(value))) - 1
} else {
dec = gsub('0.', '', as.character(value), fixed=TRUE)
ndec = nchar(dec)
nnum = nchar(as.character(as.numeric(dec)))
power = -(ndec - nnum + 1)
}
return(power)
}
gg_circle = function(r, xc, yc, color="black", fill=NA, ...) {
x = xc + r*cos(seq(0, pi, length.out=100))
ymax = 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, ...)
}
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)
}