multiplier issue fixed

R/depth.R

+#' Depth of a list
+#'
+#' Returns the depth of a list
+#' @title Depth of a list
+#' @param this list
+#' @return integer
+depth <- function(this) ifelse(is.list(this), 1L + max(sapply(this, depth)), 0L)

R/flattenlist.R

+#' Flattens list in a single list of data.frames
+#'
+#' Flattens list. Can maybe be made better. It might end up copying data in
+#' memory!? It might change the order of the elements.
+#' @title Flattens list
+#' @param x List to flatten.
+#' @return A flatten list
+flattenlist <- function(x){
+    (n <- depth(x))
+    if(n == 2){
+        # Its fine
+        return(x)
+    }else if(n ==3){
+        unlist(x, recursive=FALSE)
+    }else{
+        morelists <- sapply(x, function(xprime) class(xprime)[1]=="list")
+        out <- c(x[!morelists], unlist(x[morelists], recursive=FALSE))
+        if(sum(morelists)){ 
+            Recall(out)
+        }else{
+            return(out)
+        }
+    }
+}

R/forecastmodel.R

@@ -212,11 +212,11 @@ forecastmodel <- R6::R6Class("forecastmodel", public = list(
             if(class(L)[1]=="data.frame"){ return(list(L)) }
             if(class(L)[1]!="list"){ stop(pst("The value returned from evaluating: ",input$expr,", was not a matrix, data.frame or a list of them."))}
             if(class(L[[1]])[1]=="matrix"){ return(lapply(L, function(mat){ return(as.data.frame(mat)) })) }
-            return(L)
+            return(flattenlist(L))
         })
-        # Put together in one data.list
-        L <- structure(do.call(c, L), class="data.list")
-        #
+        # Make it a data.list with no subsubelements (it's maybe not a data.list, since it miss "t", however to take subsets etc., it must be a data.list)
+        L <- flattenlist(L)
+        class(L) <- "data.list"
         return(L)
     },
     #----------------------------------------------------------------

R/operator_multiply.R

@@ -49,35 +49,39 @@
 #' @export
 
 "%**%" <- function(x, y) {
-    if( is.null(dim(y)) ){
-        ## y is not matrix like
-        lapply(x, function(xx) {
-            xx * y
-        })
+    # If any of them is a list: do recursive calls 
+    if( class(x)[1] == "list" ){
+        return(flattenlist(lapply(x, "%**%", y=y)))
+    }else if(class(y)[1] == "list"){
+        return(flattenlist(lapply(y, "%**%", y=x)))
+    }
+
+    # Do the multiplication
+    # If either is just a vector
+    if(is.null(dim(x)) | is.null(dim(y))){
+        return(x * 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)
-        })
+        # Both are matrices
+        # Check if they have different horizon k columns
+        colmatch <- TRUE
+        if (ncol(x) != ncol(y)) {
+            colmatch <- FALSE
+        }else if(any(nams(x) != nams(y))){
+            colmatch <- FALSE
+        }
+        if(!colmatch){
+            # Not same columns, take only the k in both
+            nms <- nams(x)[nams(x) %in% nams(y)]
+            x <- x[, nms]
+            y <- y[, nms]
+        }
+        # Now multiply
+        val <- x * y
+        # Must be data.frame
+        if( is.null(dim(val)) ){
+            val <- data.frame(val)
+            nams(val) <- nms
+        }
+        return(val)
     }
 }