Skip to content

Commit

Permalink
small change
Browse files Browse the repository at this point in the history
  • Loading branch information
@super-lou
super-lou committed Jul 19, 2022
1 parent d05b4e3 commit 14ea152
Show file tree
Hide file tree
Showing 5 changed files with 124 additions and 46 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: ashes
Version: 0.2
Date: 2022-07-18
Version: 0.2.1
Date: 2022-07-19
Title: Analyse de Stationnarité Hydrologique des Écoulements de Surface
Description: Ashes is a toolbox of R code that perfoms a stationarity analysis of the low water regime which in french is analyse de stationnarité du régime des étiages. In this configuration, this analysis is centered on the Adour-Garonne hydrological basin which is located in the south-west part of France.
Author: Louis Héraut <louis.heraut@inrae.fr>
Expand Down
154 changes: 113 additions & 41 deletions R/analyse.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -51,8 +51,13 @@ get_Xtrend = function (var, df_data, df_meta, period,
verbose=TRUE) {

if (verbose) {
print(paste0('. Computes ', var, ' trend for hydrological period ',
paste0(hydroPeriod, collapse=' / ')))
if (!is.tbl(hydroPeriod)) {
print(paste0('. Computes ', var,
' trend for hydrological period ',
paste0(hydroPeriod, collapse=' / ')))
} else {
print(paste0('. Computes ', var, ' trend'))
}
}

# Get all different stations code
Expand Down Expand Up @@ -109,19 +114,44 @@ get_Xtrend = function (var, df_data, df_meta, period,
if (verbose) {
print(paste0('.. For period : ', paste0(per, collapse=' / ')))
}

# Monthly extraction
if (!is.null(functM)) {
df_XEx = do.call(
what=extract_Var_WRAP,
args=c(list(df_data=df_data,
funct=functM,
period=per,
hydroPeriod=hydroPeriod,
timestep='year-month',
isDate=isDateM,
verbose=verbose),
functM_args))

if (is.tbl(hydroPeriod)) {
df_XEx = tibble()
# For all the code
for (code in Code) {
# Get the averaged data associated to the code
df_data_code = df_data[df_data$code == code,]
hydroPeriod_code =
hydroPeriod$Value[hydroPeriod$code == code]

df_XEx_code = do.call(
what=extract_Var_WRAP,
args=c(list(df_data=df_data_code,
funct=functY,
period=per,
hydroPeriod=hydroPeriod_code,
timestep='year',
isDate=isDateY,
verbose=verbose),
functY_args))
# Store the results
df_XEx = bind_rows(df_XEx, df_XEx_code)
}
} else {
df_XEx = do.call(
what=extract_Var_WRAP,
args=c(list(df_data=df_data,
funct=functM,
period=per,
hydroPeriod=hydroPeriod,
timestep='year-month',
isDate=isDateM,
verbose=verbose),
functM_args))
}

if (!is.null(dayNA_lim)) {
# NA filtering
Expand All @@ -132,46 +162,83 @@ get_Xtrend = function (var, df_data, df_meta, period,
verbose=verbose)
df_XEx = res$data
df_mod = res$mod
}

}
df_data = df_XEx
}

# Yearly extraction
if (!is.null(functYT_ext) & !is.null(functYT_sum)) {
df_YTEx = do.call(
what=extract_Var_WRAP,
args=c(list(df_data=df_data,
funct=functYT_ext,
period=per,
hydroPeriod=hydroPeriod,
timestep='year',
isDate=isDateYT_ext,
verbose=verbose),
functYT_ext_args))

df_YT = summarise(group_by(df_YTEx, code),
threshold=functYT_sum(Value,
!!!functYT_sum_args),
.groups="drop")
if (!is.null(functYT_ext) & !is.null(functYT_sum) | is.tbl(hydroPeriod)) {

idT = which(functY_args == '*threshold*')
if (!is.null(functYT_ext) & !is.null(functYT_sum)) {

if (is.tbl(hydroPeriod)) {
df_YTEx = tibble()
# For all the code
for (code in Code) {
# Get the averaged data associated to the code
df_data_code = df_data[df_data$code == code,]
hydroPeriod_code =
hydroPeriod$Value[hydroPeriod$code == code]

df_YTEx_code = do.call(
what=extract_Var_WRAP,
args=c(list(df_data=df_data_code,
funct=functYT_ext,
period=per,
hydroPeriod=hydroPeriod_code,
timestep='year',
isDate=isDateYT_ext,
verbose=verbose),
functYT_ext_args))
# Store the results
df_YTEx = bind_rows(df_YTEx, df_YTEx_code)
}
} else {
df_YTEx = do.call(
what=extract_Var_WRAP,
args=c(list(df_data=df_data,
funct=functYT_ext,
period=per,
hydroPeriod=hydroPeriod,
timestep='year',
isDate=isDateYT_ext,
verbose=verbose),
functYT_ext_args))
}

df_YT = summarise(
group_by(df_YTEx, code),
threshold=functYT_sum(Value,
!!!functYT_sum_args),
.groups="drop")

idT = which(functY_args == '*threshold*')
}

df_XEx = tibble()
# For all the code
for (code in Code) {
# Get the averaged data associated to the code
df_data_code = df_data[df_data$code == code,]
YT_code = df_YT$threshold[df_YT$code == code]

if (!is.null(functYT_ext) & !is.null(functYT_sum)) {
YT_code = df_YT$threshold[df_YT$code == code]
functY_args[idT] = YT_code
}

functY_args[idT] = YT_code
if (is.tbl(hydroPeriod)) {
hydroPeriod_code =
hydroPeriod$Value[hydroPeriod$code == code]
} else {
hydroPeriod_code = hydroPeriod
}

df_XEx_code = do.call(
what=extract_Var_WRAP,
args=c(list(df_data=df_data_code,
funct=functY,
period=per,
hydroPeriod=hydroPeriod,
hydroPeriod=hydroPeriod_code,
timestep='year',
isDate=isDateY,
verbose=verbose),
Expand Down Expand Up @@ -435,8 +502,9 @@ get_hydrograph = function (df_data, period=NULL, df_meta=NULL) {
# New column in metadata for hydrological regime
df_meta$regime_hydro = NA
# New column in metadata for the start of the hydrological year
df_meta$start_year = NA

df_meta$maxQM = NA
df_meta$minQM = NA

# Get all different stations code
Code = levels(factor(df_meta$code))
# Number of stations
Expand Down Expand Up @@ -501,11 +569,15 @@ get_hydrograph = function (df_data, period=NULL, df_meta=NULL) {
df_QM = bind_rows(df_QM, df_QMtmp)
# Stores result of the hydrological regime
df_meta$regime_hydro[df_meta$code == code] = classRegime
# Computes the month of the max QM
maxMonth = which.max(QM_code)

# Computes the month of the max QM
maxQM = which.max(QM_code)
# Computes the month of the max QM
minQM = which.min(QM_code)
# Stores it as the start of the hydrological year
df_meta$start_year[df_meta$code == code] = maxMonth
df_meta$maxQM[df_meta$code == code] = maxQM
df_meta$minQM[df_meta$code == code] = minQM

# Otherwise
} else {
# No tibble needed
Expand Down
8 changes: 6 additions & 2 deletions R/correction.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -348,10 +348,14 @@ sampling_data = function (df_data, df_meta,
sampleEnd = sampleStart - 1
}

if (abs(sampleStart - sampleEnd) == 1) {
if (abs(sampleStart - sampleEnd) == 1 | is.tbl(hydroPeriod)) {

if (verbose) {
print('.. No sampling of the data needed')
if (abs(sampleStart - sampleEnd) == 1) {
print('.. No sampling of the data needed')
} else if (is.tbl(hydroPeriod)) {
print('.. Sampling of the data not possible')
}
}

if (!is.null(df_mod)) {
Expand Down
2 changes: 2 additions & 0 deletions R/datasheet.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1565,6 +1565,8 @@ event_panel = function(event, colorEvent, colorTextEvent) {

scale_y_continuous(limits=c(0, 5),
expand=c(0, 0))

print(toupper(event))
} else {
plot = void()
}
Expand Down
2 changes: 1 addition & 1 deletion R/layout.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -103,7 +103,7 @@ get_colorEvent = function () {
#' @title Text color event
#' @export
get_colorTextEvent = function () {
colorTextEvent = c("#423089", "#9ed6e3", "#9dc544", "#ed6e6c")
colorTextEvent = c("#9687d5", "#d8eff4", "#cee2a2", "#f6b6b5")
names(colorTextEvent) = c("Crue", "Crue Nivale", "Moyennes Eaux", "Étiage")
return(colorTextEvent)
}
Expand Down

0 comments on commit 14ea152

Please sign in to comment.