R/vigicrue.R

Defines functions getVigicrue.q

Documented in getVigicrue.q

## Author  : Thomas Esclaffer
## Date    : 2012-10-25
## File    : vigicrue.R
## Licence : GPL (>=2)
## Package : DtgRecup
## Public  : getVigicrue.q
## --

##' Aspire les debits \sQuote{Vigicrues}
##'
##' Fonctions pour aspirer les données hydrométriques
##' du portail Web institutionnel : Vigicrues
##' (\url{http://www.vigicrues.ecologie.gouv.fr/})
##' 
##' \code{getVigicrue.q} extrait le contenu des tableaux de débits
##' bruts, mesurés en temps réels, sur un profondeur d'une dizaine de jours.
##' Les données sont récupérées au pas de temps de publication,
##' en heure locale française,  puis agrégées aux pas de temps horaires
##' et journaliers selon les convention horaires DTG (UTC+1).
##' 
##' @param id le numéro identifiant la station limnimétrique dans
##' la banque de donnée du portail. La valeur par défaut est fixée 
##' à \var{572} et correspond à la station limnimétrique de la Loire 
##' au pont de Gien.    
##' @param n la profondeur de données désirée, en heures.
##' La valeur par défaut est fixée à \var{240}.
##' @return La fonction retourne un objet de classe \sQuote{\code{vigicrue}}
##' composé d'une liste de 4 éléments :
##' \describe{
##' \item{name}{le nom de la station (libellé court)}
##' \item{brut}{la série brute de débits observés (date, val) en UTC}
##' \item{horaire}{la série horaire à pas de temps fixe (date, val) en UTC}
##' \item{jour}{la synthèse journalière agrégée selon les convention 
##' DTG Castor (UTC+1).
##' Cette synthèse retourne la date, la moyenne castor, le min et le max,
##' la population de la plage d'agrégation et l'estimation moyenne brute
##' (resp. nommés : date, mean, nmin, max, count, est.m).}
##' }
##' @examples
##' \dontrun{
##' x <- getVigicrue.q()
##' print(x)
##' plot(x)
##' }
##' @author Thomas Esclaffer \email{[email protected]@edf.fr}
##' @export
getVigicrue.q <- 
  function(id=572, n=240) 
  {
    ## Construction de la requete web
    url <- paste("http://www.vigicrues.gouv.fr/niveau3.php?",
                 "idstation=",id,"&typegraphe=q&ong=2&",
                 "AffProfondeur=",n,sep="")
    ## Récupération de l'URL
    con <-url(url)
    tmp <- readLines(con)
    close(con)
    
    ## Extraction du tableau
    ## ---------------------
    ## Récuperation de la ligne contenant le paragraphe du tableau
    tmp <- grep("<p class='titre_cadre'>", tmp, value=TRUE)
    ## Extraction des indices de chaine de caractère englobant le tableau
    ind <- regexpr("<table.*</table>", tmp)
    ## Extraction du tableau
    ## tmp <- regmatches(tmp, ind) ## regmatches dipso pour R > 2.14
    tmp <- substr(tmp, ind, ind+attr(ind,"match.length")-1)
    ## Remise en forme du tableu de valeurs
    ## ------------------------------------
    ## Suppression de toutes les balises
    tmp <- gsub("</[^>]*>",";",tmp)
    tmp <- gsub("<[^>]*>","",tmp)
    tmp <- gsub(";*;",";", tmp)
    ## Mise en forme tabulaire
    x <- unlist(strsplit(tmp,";"))
    x <- t(matrix(x, 2, length(x)/2))
    noms <- x[1,]
    x <- data.frame(x[-1,], stringsAsFactors=FALSE)
    names(x) <- c("date","val")
    ## Traitement des colonnes
    x$date <- as.POSIXct(x$date, tz="CET", format="%d/%m/%Y %H:%M")
    x$val <- as.numeric(x$val)
    
    ## Post-traitements
    ## ----------------
    ## Serie horaire 
    d <- range(as.integer(format(x$date,"%Y%m%d%H", tz="UTC")))
    dd <- as.POSIXct(as.character(d), format="%Y%m%d%H", tz="UTC")
    dd <- seq(from=dd[1], to=dd[2], by="1 hour")
    hh <- data.frame(date=dd, val=x$val[match(dd, x$date)])
    ## Stats journalières
    ## Prise en compte des conventions castor
    date.castor <- hh$date + as.difftime(1, units="hours")
    ## Agrégation
    jj <-tapply(hh$val, as.Date(date.castor), 
                function(x) c(mean=mean(x), 
                              min=min(x), max=max(x), 
                              count=sum(!is.na(x)), 
                              est.m=mean(x, na.rm=TRUE,)))
    jj <- t(sapply(jj,c))
    jj <- data.frame(date=as.Date(rownames(jj)),jj) 
    rownames(jj) <- NULL
    
    ## Mise en forme du resultat
    res <- list(name=noms[2], brut=x, horaire=hh, jour=jj, id=id)
    class(res) <- "vigicrue"
    return(res)
  }
coolTot/DtgRecup documentation built on May 12, 2017, 9:45 a.m.