SeriesAggreg2.default.R 3.24 KB
Newer Older
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
SeriesAggreg2.default <- function(TabSeries,
                                  Format,
                                  TimeFormat,
                                  NewTimeFormat,
                                  YearFirstMonth = 1, TimeLag = 0,
                                  verbose = TRUE, ..., simplify = FALSE) {
  
  if (!inherits(TabSeries, c("InputsModel", "OutputsModel"))) {
    stop("to be used with InputsModel', or 'OutputsModel' object")
  }
  
  if (!inherits(TabSeries, "GR") & inherits(TabSeries, "CemaNeige")) {
    ClassTabSeries <- class(TabSeries) 
    zzz <- list(zzz = rep(NaN, length(TabSeries$DatesR)))
    TabSeries <- append(TabSeries, values = zzz, after = 1)
    class(TabSeries) <- ClassTabSeries
    lastCol <- "zzz"
  }
  if (inherits(TabSeries, "GR")) {
    if (inherits(TabSeries, "InputsModel")) {
      lastCol <- "PotEvap"
    }
    if (inherits(TabSeries, "OutputsModel")) {
      lastCol <- "Qsim"
    }
  }
  
  if (inherits(TabSeries, "CemaNeige")) {
    if (inherits(TabSeries, "InputsModel")) {
      CemaNeigeLayers <- TabSeries[grep("^Layer", names(TabSeries))]
31
32
33
34
35
      CemaNeigeLayers <- lapply(seq_along(CemaNeigeLayers), function(iLayer) {
        tmp <- CemaNeigeLayers[[iLayer]]
        names(tmp) <- paste(names(CemaNeigeLayers)[iLayer], names(tmp), sep = ".")
        tmp
      })
36
37
38
39
40
41
42
43
    }
    if (inherits(TabSeries, "OutputsModel") ){
      CemaNeigeLayers <- TabSeries$CemaNeigeLayers
    }
    CemaNeigeLayersAggreg <- lapply(CemaNeigeLayers, function(iLayer) {
      tmp <- cbind(TabSeries$DatesR, as.data.frame(iLayer))
      res <- SeriesAggreg2(tmp, Format = Format,
                           TimeFormat = TimeFormat, NewTimeFormat = NewTimeFormat,
44
                           ConvertFun = .AggregConvertFun(gsub("[.].*", "", colnames(tmp)[-1L])),
45
46
47
48
49
50
51
                           YearFirstMonth = YearFirstMonth, TimeLag = TimeLag,
                           verbose = verbose)
      res <- res[, -1L]
      res <- as.list(res)
    })
  }
  
52
  
53
54
55
56
57
  TabSeries2 <- TabSeries[1:which(names(TabSeries) %in% lastCol)]
  TabSeries2 <- as.data.frame.list(TabSeries2)
  NewTabSeries <- SeriesAggreg2(TabSeries = TabSeries2,
                                Format = Format,
                                TimeFormat = TimeFormat, NewTimeFormat = NewTimeFormat,
58
                                ConvertFun = .AggregConvertFun(colnames(TabSeries2)[-1L]),
59
60
                                YearFirstMonth = YearFirstMonth, TimeLag = TimeLag,
                                verbose = verbose)
61
  NewTabSeries$zzz <- NULL
62
63
64
65
66
67
68
69
  
  
  if (simplify) {
    
    return(NewTabSeries)
    
  } else {
    
70
    res <- list()
71
72
73
74
75
76
77
78
79
80
81
82
83
    ClassFormat <- switch(substr(Format, start = nchar(Format), stop = nchar(Format)),
                          h = "hourly",
                          d = "daily",
                          m = "monthly",
                          Y = "yearly")
    
    ## to be consistent with InputsModel class and because plot.OutputsModel use the POSIXlt class
    NewTabSeries$DatesR <- as.POSIXlt(NewTabSeries$DatesR)
    res <- as.list(NewTabSeries)
    
    if (inherits(TabSeries, "CemaNeige")) {
      res$CemaNeigeLayers <- CemaNeigeLayersAggreg
    }
84
    
85
86
87
88
89
90
    class(res) <- gsub("hourly|daily|monthly|yearly", ClassFormat, class(TabSeries))
    return(res)
    
  }
  
}