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
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
## Do this in a separate file to see the generated help:
#library(devtools)
#document()
#load_all(as.package("../../onlineforecast"))
#?"%**%"
#' Multiplication of each element in a list (x) with y
#'
#' Each element of x is multiplied with y using the usual elementwise '*' operator.
#'
#' Typical use is when a function, e.g. \code{\link{bspline}()}, returns a list of matrices (e.g. one for each base spline) and they should individually be multiplied with y (a vector, matrix, etc.).
#'
#' Since this is intended to be used for forecast models in the transformation stage
#' then there are some percularities:
#'
#' If the number of columns or the names of the columns are not equal for one element in x
#' and y, then only the columns with same names are used, hence the resulting matrices can be
#' of lower dimensions.
#'
#' See the ??(solar forecast vignette) for example of use
#'
#' @title Multiplication of list with y, elementwise
#' @param x a list of matrices, data.frames, etc.
#' @param y a vector, data.frame or matrix
#' @return A list of same length of x
#' @examples
#'
#' x <- list(matrix(1:9,3), matrix(9:1,3))
#' x
#'
#' y <- matrix(2,3,3)
#' y
#'
#' x %**% y
#'
#' y <- 1:3
#'
#' x %**% y
#'
#' # Naming percularity
#' nams(x[[1]]) <- c("k1","k2","k3")
#' nams(x[[2]]) <- c("k2","k3","k4")
#' y <- matrix(2,3,3)
#' nams(y) <- c("k1","k3","k7")
#'
#' # Now the only the horizons matching will be used
#' x %**% y
#'
#' @export
"%**%" <- function(x, y) {
if( is.null(dim(y)) ){
## y is not matrix like
lapply(x, function(xx) {
xx * y
})
}else{
## y is matrix like
lapply(x, function(xx) {
## Check if different horizon k columns
colmatch <- TRUE
if (ncol(xx) != ncol(y)) {
colmatch <- FALSE
}else if(any(nams(xx) != nams(y))){
colmatch <- FALSE
}
if(!colmatch){
## Not same columns, take only the k in both
nms <- nams(xx)[nams(xx) %in% nams(y)]
xx <- xx[, nms]
y <- y[, nms]
}
## Now multiply
val <- xx * y
## Must be data.frame
if( is.null(dim(val)) ){
val <- data.frame(val)
nams(val) <- nms
}
return(val)
})
}
}