reverse order in R interface

R/as_rvine_structure.R

@@ -39,21 +39,21 @@
 #' `rvine_matrix` (see [rvine_structure()] or [rvine_matrix()]).
 #' @examples
 #' # R-vine structures can be constructed from the order vector and struct_array
-#' rvine_structure(order = 4:1, struct_array = list(
-#'   c(1, 1, 1),
-#'   c(2, 2),
-#'   3
+#' rvine_structure(order = 1:4, struct_array = list(
+#'   c(4, 4, 4),
+#'   c(3, 3),
+#'   2
 #' ))
 #' 
 #' # ... or a similar list can be coerced into an R-vine structure
-#' as_rvine_structure(list(order = 4:1, struct_array = list(
-#'   c(1, 1, 1),
-#'   c(2, 2),
-#'   3
+#' as_rvine_structure(list(order = 1:4, struct_array = list(
+#'   c(4, 4, 4),
+#'   c(3, 3),
+#'   2
 #' )))
 #' 
 #' # similarly, standard matrices can be coerced into R-vine structures
-#' mat <- matrix(c(1, 2, 3, 4, 1, 2, 3, 0, 1, 2, 0, 0, 1, 0, 0, 0), 4, 4)
+#' mat <- matrix(c(4, 3, 2, 1, 4, 3, 2, 0, 4, 3, 0, 0, 4, 0, 0, 0), 4, 4)
 #' as_rvine_structure(mat)
 #' 
 #' # or truncate and construct the structure
@@ -113,7 +113,7 @@ as_rvine_matrix.rvine_structure <- function(x, ..., validate = FALSE) {
   matrix <- matrix(0, d, d)
 
   # fill output
-  diag(matrix[, d:1]) <- order
+  diag(matrix[d:1, ]) <- order
   for (i in 1:(d - 1)) {
     newcol <- order[x[["struct_array"]][[i]]]
     matrix[1:length(newcol), i] <- newcol
@@ -126,8 +126,9 @@ as_rvine_matrix.rvine_structure <- function(x, ..., validate = FALSE) {
 }
 
 #' @param is_natural_order A flag indicating whether the `struct_array` element
-#' of `x` is assumed to be provided in natural order already (see
-#' *Details*).
+#' of `x` is assumed to be provided in natural order already (a structure is in 
+#' natural order if the anti-diagonal is 1, .., d from bottom left to top 
+#' right).
 #' @param byrow whether the element of the list named `struct_array` 
 #' is assumed to be provided by column or by row.
 #' @export
@@ -181,12 +182,12 @@ as_rvine_structure.rvine_matrix <- function(x, ..., validate = FALSE) {
 
   # compute structure array in natural order
   d <- dim(x)[1]
-  order <- order(diag(x[, d:1]))
+  order <- order(diag(x[d:1, ]))
   struct_array <- lapply(1:(d - 1), function(i) order[x[1:(d - i), i]])
 
   # create and return x
   structure(list(
-    order = diag(x[, d:1]),
+    order = diag(x[d:1, ]),
     struct_array = struct_array,
     d = d,
     trunc_lvl = dim(x)[2]

R/rvine_structure.R

@@ -8,32 +8,32 @@
 #' with a notation that differs from the one in the VineCopula package.
 #' An example array is
 #' ```
-#' 1 1 1 1
-#' 2 2 2
-#' 3 3
-#' 4
+#' 4 4 4 4
+#' 3 3 3
+#' 2 2
+#' 1
 #' ```
 #' which encodes the following pair-copulas:
 #'
 #' \tabular{lll}{
 #' tree \tab  edge \tab pair-copulas   \cr
-#' 0    \tab  0    \tab `(4, 1)`       \cr
-#'      \tab  1    \tab `(3, 1)`       \cr
-#'      \tab  2    \tab `(2, 1)`       \cr
-#' 1    \tab  0    \tab `(4, 2; 1)`    \cr
-#'      \tab  1    \tab `(3, 2; 1)`    \cr
-#' 2    \tab  0    \tab `(4, 3; 2, 1)`
+#' 0    \tab  0    \tab `(1, 4)`       \cr
+#'      \tab  1    \tab `(2, 4)`       \cr
+#'      \tab  2    \tab `(3, 4)`       \cr
+#' 1    \tab  0    \tab `(1, 3; 2)`    \cr
+#'      \tab  1    \tab `(2, 3; 4)`    \cr
+#' 2    \tab  0    \tab `(1, 2; 3, 4)`
 #' }
 #'
 #' An R-vine structure can be converted to an R-vine matrix using
 #' [as_rvine_matrix()], which encodes the same model with a square matrix
 #' filled with zeros. For instance, the matrix corresponding to the structure
 #' above is:
 #' ```
-#' 1 1 1 1
-#' 2 2 2 0
-#' 3 3 0 0
-#' 4 0 0 0
+#' 4 4 4 4
+#' 3 3 3 0
+#' 2 2 0 0
+#' 1 0 0 0
 #' ```
 #' Similarly, an R-vine matrix can be converted to an R-vine structure using
 #' [as_rvine_structure()].
@@ -50,17 +50,17 @@
 #' which are stored as a triangular array. For instance, the off-diagonal elements
 #' off the structure above are stored as
 #' ```
-#' 1 1 1
-#' 2 2
-#' 3
+#' 4 4 4
+#' 3 3
+#' 2
 #' ```
 #' for the structure above. The reason is that it allows for parsimonious
 #' representations of truncated models. For instance, the 2-truncated model
 #' is represented by the same diagonal and the following truncated triangular
 #' array:
 #' ```
-#' 1 1 1
-#' 2 2
+#' 4 4 4
+#' 3 3
 #' ```
 #'
 #' A valid R-vine structure or matrix must satisfy several conditions which
@@ -86,7 +86,8 @@
 #' represent rows of the r-rvine structure and the number of elements have to
 #' be compatible with the `order` vector.
 #' @param is_natural_order whether `struct_array` is assumed to be provided
-#' in natural order already.
+#' in natural order already (a structure is in natural order if the anti-
+#' diagonal is 1, .., d from bottom left to top right).
 #' @param byrow whether `struct_array` is assumed to be provided
 #' by column or by row.
 #'
@@ -96,14 +97,14 @@
 #' @examples
 #' 
 #' # R-vine structures can be constructed from the order vector and struct_array
-#' rvine_structure(order = 4:1, struct_array = list(
-#'   c(1, 1, 1),
-#'   c(2, 2),
-#'   3
+#' rvine_structure(order = 1:4, struct_array = list(
+#'   c(4, 4, 4),
+#'   c(3, 3),
+#'   2
 #' ))
 #' 
 #' # R-vine matrices can be constructed from standard matrices
-#' mat <- matrix(c(1, 2, 3, 4, 1, 2, 3, 0, 1, 2, 0, 0, 1, 0, 0, 0), 4, 4)
+#' mat <- matrix(c(4, 3, 2, 1, 4, 3, 2, 0, 4, 3, 0, 0, 4, 0, 0, 0), 4, 4)
 #' rvine_matrix(mat)
 #' 
 #' # coerce to R-vine structure
@@ -114,9 +115,9 @@
 #' rvine_matrix(mat)
 #' 
 #' # or use directly the R-vine structure constructor
-#' rvine_structure(order = 4:1, struct_array = list(
-#'   c(1, 1, 1),
-#'   c(2, 2)
+#' rvine_structure(order = 1:4, struct_array = list(
+#'   c(4, 4, 4),
+#'   c(3, 3)
 #' ))
 #' 
 #' # throws an error

inst/include/wrappers.hpp

@@ -96,7 +96,7 @@ Rcpp::List pair_copulas_wrap(std::vector<std::vector<Bicop>> pair_copulas,
                              size_t d,
                              bool is_fitted);
 
-Vinecop vinecop_wrap(const Rcpp::List& vinecop_r);
+Vinecop vinecop_wrap(const Rcpp::List& vinecop_r, bool check = FALSE);
 
 
 Rcpp::List vinecop_wrap(const Vinecop& vinecop_cpp, bool is_fitted = FALSE);

src/wrappers.cpp

@@ -336,10 +336,10 @@ Rcpp::List pair_copulas_wrap(std::vector<std::vector<Bicop>> pair_copulas,
     return pair_copulas_r;
 }
 
-Vinecop vinecop_wrap(const Rcpp::List& vinecop_r)
+Vinecop vinecop_wrap(const Rcpp::List& vinecop_r, bool check)
 {
     // omit R-vine matrix check, already done in R
-    auto structure = rvine_structure_wrap(vinecop_r["structure"], false);
+    auto structure = rvine_structure_wrap(vinecop_r["structure"], check);
 
     // extract pair-copulas
     auto pair_copulas = pair_copulas_wrap(vinecop_r["pair_copulas"],
@@ -373,8 +373,9 @@ Rcpp::List vinecop_wrap(const Vinecop& vinecop_cpp,
 // vinecop exports
 
 // [[Rcpp::export()]]
-void vinecop_check_cpp(Rcpp::List vinecop_r) {
-    vinecop_wrap(vinecop_r);
+void vinecop_check_cpp(Rcpp::List vinecop_r) 
+{
+    vinecop_wrap(vinecop_r, true);
 }
 
 // [[Rcpp::export()]]

tests/testthat/test_rvine_structure.R

@@ -1,7 +1,7 @@
 context("Class 'rvine_structure'")
 
-mat <- matrix(c(1, 2, 3, 4, 1, 2, 3, 0, 1, 2, 0, 0, 1, 0, 0, 0), 4, 4)
-mylist <- list(order = 1:4, struct_array = list(c(1, 1, 1), c(2, 2), 3))
+mat <- matrix(c(4, 3, 2, 1, 4, 3, 2, 0, 4, 3, 0, 0, 4, 0, 0, 0), 4, 4)
+mylist <- list(order = 1:4, struct_array = list(c(4, 4, 4), c(3, 3), 2))
 
 test_that("constructor and as/is generics work", {
     expect_silent(rvs <- as_rvine_structure(mylist)) ## calls the constructor

tests/testthat/test_truncate_model.R

@@ -1,6 +1,6 @@
 context("Truncation generic")
 
-mat <- matrix(c(1, 2, 3, 1, 2, 0, 1, 0, 0), 3, 3)
+mat <- matrix(c(3, 2, 1, 3, 2, 0, 3, 0, 0), 3, 3)
 
 test_that("works with rvine_structure", {
     struct <- truncate_model(as_rvine_structure(mat), 1)
@@ -16,9 +16,9 @@ test_that("works with rvine_matrix", {
     mat <- truncate_model(as_rvine_matrix(mat), 1)
 
     expect_equal(unname(dim(mat)), c(3, 1))
-    expect_equal(mat[1, ], c(1, 1, 1))
+    expect_equal(mat[1, ], c(3, 3, 3))
     expect_equal(mat[2, ], c(0, 2, 0))
-    expect_equal(mat[3, ], c(3, 0, 0))
+    expect_equal(mat[3, ], c(1, 0, 0))
 })
 
 test_that("works with vinecop objects", {