public
Authored by
Dorchies David
Script R d'extraction de chroniques de débit du site internet de la banque hydro
EDIT 2022: Le portail de la banque hydro ayant été entièrement refondu en janvier 2022, ce script est désormais obsolète et non fonctionnel
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
#' Routine d'interrogation de la banque hydro pour obtenir une chronique de données pour une station de mesure.
#' Cette routine interroge la banque hydro autant de fois que nécessaire pour compléter la chronique demandée.
#'
#' @param station Code de la station
#' @param DateHeureDeb Date de début d'événement au format string "JJ/MM/AAAA HH:MM:SS"
#' @param DateHeureFin Date de fin d'événement au format string "JJ/MM/AAAA HH:MM:SS"
#' @param procedure Variable à importer : "QTFIX", QTVAR", "H-TEMPS" (QTVAR par défaut)
#' @param url URL de la banque hydro (http://www.hydro.eaufrance.fr par défaut)
#'
#' @return dataframe contenant le tableau produit sur la page de visualisation de la chronique de la banque hydro
#'
#' @example df<-rbanqhydro.get("Y3204010","16/03/2017 00:00", "05/04/2017 23:59")
#'
#' @author David Dorchies david.dorchies@irstea.fr
#' @date 13/04/2017 - 15/03/2019
#' @license LGPL-3.0 https://opensource.org/licenses/LGPL-3.0
rbanqhydro.get <- function (station, DateHeureDeb, DateHeureFin, procedure = "QTVAR", url="http://www.hydro.eaufrance.fr") {
PackageRequire("httr")
PackageRequire("XML")
# Formulaire de sélection des stations
form0<- list(
cmd = "filtrer",
consulte = "rechercher",
code_station = "",
cours_d_eau = "Lez",
commune = "",
departement = "",
bassin_hydrographique = "",
station_en_service = "1",
station_hydrologique = "1",
btnValider = "Visualiser"
)
form0[["station[]"]] = station
url.selection = paste(url,"selection.php", sep = "/")
res <- POST(
url.selection,
body = form0, encode = "form", verbose()
)
# Formulaire de sélection de la variable
form1 <- list(
categorie = "rechercher",
procedure = procedure
)
form1[["station[]"]] = station
url.procedure = paste(url,"presentation/procedure.php", sep = "/")
res <- POST(
url.procedure,
body = form1, encode = "form", verbose()
)
# Extraction des chroniques (répétition des interrogations)
DateHeureDeb = as.POSIXct(DateHeureDeb, format = "%d/%m/%Y %H:%M", tz = "UTC")
DateHeureFin = as.POSIXct(DateHeureFin, format = "%d/%m/%Y %H:%M", tz = "UTC")
DateHeureDebOld = 0
df = data.frame(NULL)
while(DateHeureDeb < DateHeureFin & DateHeureDeb > DateHeureDebOld) {
DateHeureDebOld = DateHeureDeb
dfi = rbanquehydro.get.timeserie(url.procedure, procedure, DateHeureDeb, DateHeureFin)
if(nrow(dfi) > 0) {
df = rbind(df, dfi)
DateHeureDeb = tail(dfi,1)$Date + 60 # Last end time + 60 seconds
}
}
return (df)
}
#' Sous routine d'interrogation de la banque hydro pour obtenir une chronique de données pour une station de mesure et une période donnée.
#' Cette routine est appelée à partir de rbanqhydro.get
#'
#' @param url.procedure URL du formulaire d'interrogation de la chronique temporelle
#' @param procedure Variable à importer : "QTFIX", QTVAR", "H-TEMPS" (QTVAR par défaut)
#' @param DateHeureDeb Date de début d'événement au format POSIX
#' @param DateHeureFin Date de fin d'événement au format POSIX
#'
#' @return dataframe contenant le tableau produit sur la page de visualisation de la chronique de la banque hydro
#'
#' @example df<-rbanqhydro.get("Y3204010","16/03/2017 00:00", "05/04/2017 23:59")
#'
#' @author david.dorchies@irstea.fr, maxime.jay-allemand@irstea.fr
#' @date 13/04/2017 - 15/03/2019
#' @license LGPL-3.0 https://opensource.org/licenses/LGPL-3.0
rbanquehydro.get.timeserie <- function (url.procedure, procedure, DateHeureDeb, DateHeureFin) {
# Formulaire de sélection de la date
form2 <- list(
procedure = procedure,
affichage = 2,
echelle = 1,
date1 = format(DateHeureDeb, "%d/%m/%Y"),
heure1 = format(DateHeureDeb, "%H:%M"),
date2 = format(DateHeureFin, "%d/%m/%Y"),
heure2 = format(DateHeureFin, "%H:%M"),
precision = "00",
btnValider = "Valider"
)
res <- POST(
url.procedure,
body = form2, encode = "form", verbose()
)
#Check if no data
pageToRead=content(res, "text", encoding = "iso-8859-1")
#Ici on regarde sur la page si un message d'erreur est affiché :
urlLines=0
urlLines = c(urlLines,grep("Pas\\sde\\sdonnées\\sdisponibles", pageToRead))
urlLines = c(urlLines,grep("Aucune\\sdonnée\\sdisponible", pageToRead))
#message("urlLines=",urlLines)
df = data.frame(NULL)
if (sum(urlLines)==0){
# On récupère le dataframe du 3ème tableau de la page
df = readHTMLTable(
content(res, type="text/plain", encoding="cp1252"),
stringsAsFactors = FALSE,
which = 3
)
df[,"Date"] = as.POSIXct(df[,"Date"], format = "%d/%m/%Y %H:%M", tz = "UTC")
}
return(df)
}
#' Création d'un fichier de chronique de débit au format GRP 2018
#'
#' @param station Code de la station
#' @param DateHeureDeb Date de début d'événement au format string "JJ/MM/AAAA HH:MM"
#' @param DateHeureFin Date de fin d'événement au format string "JJ/MM/AAAA HH:MM"
#'
#' @example rbanquehydro.createGRP_Q_file("U2345030", "01/01/2002 00:00", "23/03/2009 23:00", "BDD/BDD_Q/U2345030_Q.txt")
#'
#' @author David Dorchies david.dorchies@irstea.fr
#' @date 15/03/2019
#' @license LGPL-3.0 https://opensource.org/licenses/LGPL-3.0
rbanquehydro.createGRP_Q_file <- function(station, DateHeureDeb, DateHeureFin, sFilePath) {
df = rbanqhydro.get(station, DateHeureDeb, DateHeureFin, procedure, url)
dfGRP = data.frame(
AAAAMMJJHHMM = as.numeric(format(df[,"Date"], "%Y%m%d%H%M")),
Q = as.numeric(df[,2])
)
write.table(dfGRP, sFilePath, sep = ";", row.names = FALSE)
}
################################################################################
#' Test la présence d'un package, le télécharge au besoin et le charge.
#' Le programme est stoppé en cas d'échec.
#' @param x Chaîne de caractère avec le nom du package à charger
#' @url http://stackoverflow.com/questions/9341635/how-can-i-check-for-installed-r-packages-before-running-install-packages
#' @date 31/07/2014
################################################################################
PackageRequire <- function(x)
{
if (!require(x,character.only = TRUE)) {
install.packages(x,dep=TRUE,repos="http://cran.r-project.org")
}
if(!require(x,character.only = TRUE)) {
stop("Package not found")
}
}
-
Merci pour ce code: deux petites suggestions:
- ligne 365, j'ai modifié pour
dfi = rbanquehydro.get.timeserie(url.procedure, procedure, DateHeureDeb, min(DateHeureFin,DateHeureDeb+3600*24*30*5))
car certaines requêtes ne peuvent pas extraire plus de 6 mois d'un coup - pour les procédures à pas de temps fixe, j'avais un problème de pas de temps illégal, j'ai donc ajouté
pastmps = "01"
dans form2. En espérant que ça puisse servir
- ligne 365, j'ai modifié pour
Please register or sign in to comment