R/forecast.R

Defines functions forecast

Documented in forecast

##' Classe pour les grilles de previsions climatologique
##' 
##' \command{forecast} crée un objet de classe \samp{forecast},
##' à partir d'une grille de prévisions.
##'  
##' @param data le jeu de données sous forme \samp{RasterBrick}.
##' ou liste de \var{RasterBrick}.
##' @param model le mot-clef désignant le modèle météorologique
##' à l'origine de la simulation. 
##' @param run la date de la simulation au format 
##' \sQuote{\var{POSIXc}}.
##' @param variable le mot-clef désigant la variable contenue 
##' dans la simulation.
##' @param echeances le vecteur des échéances de prévisions en 
##' heures. 
##' 
##' @return \command{forecast} retourne un objet de classe 
##' \samp{Forecast}.
##' 
##' @export
forecast <- 
  function(data, model, run, variable, echeances, units) 
  {
    if (missing(variable)) variable="unknown"
    if (missing(units)) units="unknown"
<<<<<<< HEAD
    ## 
    ## Mise à jour des étiquettes des carac. de varaibles
    variable <- fcst.var(variable)  
    units <- switch(tolower(substr(variable,1,2)), 
                    pr="mm", te="°C", sn="mm", 
                    gu="m/s", ff="m/s", units)

=======

    units <- switch(tolower(substr(variable,1,2)), 
                    pr="mm", te="°C", sn="mm", 
                    gu="m/s", ff="m/s", units)
    variable <- switch(tolower(variable), 
                       precip="Precip", temp="Tempe", snow="Snow", 
                       ff250="FF250m", ff500="FF500m",
                       gust="FFRaf", variable)
>>>>>>> 53ae716ce8775c9fd36538db2ce00c6b918e4778
    names(data) <- sprintf("H%d",echeances)
    structure(
      list( model=model, run=run, variable=variable, units=units, 
            echeances=echeances, dates=run + 3600 * echeances, 
<<<<<<< HEAD
            data=recentre(data)), 
=======
            data=data), 
>>>>>>> 53ae716ce8775c9fd36538db2ce00c6b918e4778
      class="Forecast")
  }

##' @rdname forecast
##' @method print Forecast
##' @export 
print.Forecast <- 
  function(x,...) 
  {
    # cat("Jeu de prévisions météorologique :\n")
    cat("\nModèle      :", x$model)
<<<<<<< HEAD
    cat("\nRéseau      :", format(as.Date(x$run, tz="UTC"),"%A %d %B %Y %Hh %Z"))
=======
    cat("\nRéseau      :", format(x$run,"%A %d %B %Y %Hh %Z"))
>>>>>>> 53ae716ce8775c9fd36538db2ce00c6b918e4778
    cat("\nParamètre   :", x$variable)
    cat("\nUnités      :", x$units)
    dech <- sort(unique(diff(x$echeances)))
    cat(sprintf("\nEcheances   : %d (%d -> %d [%d])", 
                length(x$echeances), min(x$echeances), max(x$echeances),
                dech))
    cat("\n-- Raster --\n")
    print(x$data)
  }

<<<<<<< HEAD
##' @rdname forecast
##' @method plot Forecast
##' @export 
plot.Forecast <- 
  function(x, layer=1, ...) 
  {
    
  }

## ___________________________________________________________________________
## Fonctions internes 
## 
## fcst.var cherche pour un chaine de cractère la variable Forecast 
## correspodnante
## table de correspondance entre paramètres des GRIB GFS/ARO/ARP et 
## la codification des paramètres 
fcst.var <- 
  function(x)
  { 
    var <- tolower(x)
    ## Précipitation par pas de temps
    if (any(grepl(var, c("precip","rain", "apcp")))) 
      return("Precip")
    ## Précipitation cumulés depuis le début du run
    if (any(grepl(var, c("precip.tot","tprate"))))
      return("Precip.tot")
    ## Températures au sol (~2m)
    if (any(grepl(var, c("temp","tmp"))))
      return("Tempe")
    ## Précipitations solides, neige
    if (any(grepl(var, c("snow"))))
      return("Snow")
    ## Rafales de vents 
    if (any(grepl(var, c("gust","ffrf","raf")))) 
      return("FFRaf")
    ## Vent moyen à 250 m
    if (any(grepl(var, c("ff250"))))
      return("FF250m")
    ## Vent moyen à 500 m 
    if (any(grepl(var, c("ff500"))))
      return("FF500m")
    return(x)
  }

recentre <- function(r) {
  if (!grepl('+proj=longlat', sp::proj4string(r))) return(r)
  ## On récupère l'extension du rasters
  x <- raster::extent(r)
  ## si l'étendue en longitude est supérieure 180° recentre en 0° 
  if (x@xmin>180) x@xmin <- x@xmin - 360
  if (x@xmax>180) x@xmax <- x@xmax - 360
  raster::extent(r) <- x
  return(r)
}
=======
# ##' @rdname forecast
# ##' @method plot Forecast
# ##' @export 
# plot.Forecast <- 
#   function(x, layer=1, ...) 
#   {
#     
#   }
>>>>>>> 53ae716ce8775c9fd36538db2ce00c6b918e4778
coolTot/DtgRecup documentation built on May 12, 2017, 9:45 a.m.