R Under development (unstable) (2024-10-14 r87233 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> library(qwraps2)
> set.seed(42)
> 
> ################################################################################
> # testing attributes
> x <- qable(mtcars2[, c("mpg", "disp")], markup = "latex")
> stopifnot(
+   identical(
+     attributes(x)
+     ,
+     list(dim = c(32L, 3L), dimnames = list(NULL, c("", "mpg", "disp")), class = "qwraps2_qable", qable_args = list(rtitle = "", rgroup = numeric(0), rnames = c("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"), cnames = c("", "mpg", "disp"), markup = "latex", kable_args = list()))
+   )
+ )
> 
> ################################################################################
> # simple output tests
> output_latex <- capture.output(print(qable(mtcars2, markup = "latex")))
> output_markdown <- capture.output(print(qable(mtcars2, markup = "markdown")))
> 
> # simple print test
> stopifnot(any(grepl("142E\\ \\&\\ 21\\.4", output_latex)))
> stopifnot(any(grepl("142E\\ +\\|21\\.4", output_markdown)))
> 
> # error for unexpected markup language
> test <- tryCatch(qable(mtcars2, markup = "rts"), error = function(e) e)
> stopifnot(inherits(test, "error"))
> 
> 
> # rtitle
> out <- capture.output(print(qable(mtcars[1, ], rtitle = "user defined rtitle")))
> stopifnot(grepl("^user\\ defined\\ rtitle", out[4]))
> out <- capture.output(print(qable(mtcars[1, ], markup = "markdown", rtitle = "user defined rtitle")))
> stopifnot(grepl("^\\|user\\ defined\\ rtitle", out[3]))
> 
> # rgroups
> make <- sub("^(\\w+)\\s?(.*)$", "\\1", rownames(mtcars))
> make <- c(table(make))
> output <- capture.output(print(qable(mtcars[sort(rownames(mtcars)), ], rgroup = make)))
> 
> any(grepl("\\\\bf\\{Volvo\\}\\ \\&\\ ~", output))
[1] TRUE
> any(grepl("~~\\ Volvo\\ 142E\\ \\&\\ 21\\.4", output))
[1] TRUE
> 
> output <- capture.output(print(qable(mtcars[sort(rownames(mtcars)), ], rgroup = make, markup = "markdown")))
> 
> stopifnot(any(grepl("\\*\\*\\Volvo\\*\\*", output)))
> stopifnot(any(grepl("\\&nbsp;\\&nbsp;\\ Volvo", output)))
> 
> ################################################################################
> # Test cbind
> qtab_1 <- qable(mtcars[sort(rownames(mtcars)), c("mpg", "cyl")], rgroup = make, kable_args = list(caption = "1"))
> qtab_2 <- qable(mtcars[sort(rownames(mtcars)), c("disp", "hp", "drat")], rgroup = make, kable_args = list(caption = "2"))
> qtab_0 <- qable(mtcars[sort(rownames(mtcars)), c("mpg", "cyl", "disp", "hp", "drat")], rgroup = make, kable_args = list(caption = "1"))
> 
> # the number of column of each of these tables should be one more than the
> # number of columns of the data.frame passed.  the "extra" column is the row
> # grouping and names.
> stopifnot(identical(ncol(qtab_1), 3L))
> stopifnot(identical(ncol(qtab_2), 4L))
> stopifnot(identical(ncol(qtab_0), 6L))
> 
> # qtab_1 and qtab_2 should join together to be identical to qtab_0
> stopifnot(identical(cbind(qtab_1, qtab_2), qtab_0))
> 
> # should be able to cbind on a vector of values
> out <- cbind(qtab_1, a_number = rnorm(nrow(qtab_1)))
> stopifnot(identical(colnames(out), c("", "mpg", "cyl", "a_number")))
> 
> # should be able to cbind on a vector of values as a matrix
> out <- cbind(qtab_1, a_number = matrix(rnorm(nrow(qtab_1)), ncol = 1))
> stopifnot(identical(colnames(out), c("", "mpg", "cyl", "a_number")))
> 
> # or even another matrix
> out <- cbind(qtab_1, a = matrix(rnorm(3 * nrow(qtab_1)), ncol = 3))
> stopifnot(identical(colnames(out), c("", "mpg", "cyl", "a1", "a2", "a3")))
> 
> # error if nrows are not the same, or if a vector length is different from the
> # nrow of the first element
> test <-
+   tryCatch(
+            cbind(qtab_1, qtab_1_2, a_number = rnorm(nrow(qtab_1) - 1)),
+            error = function(e) e)
> stopifnot(inherits(test, "error"))
> 
> test <-
+   tryCatch(
+            cbind(qtab_1, qtab_1_2[1:3, ]),
+            error = function(e) e)
> stopifnot(inherits(test, "error"))
> 
> # there should be an error if the row groups are not identical
> m <- make; names(m) <- toupper(names(m))
> qtab_1_2 <- qable(mtcars[, c("mpg", "cyl")], rgroup = m)
> test <- tryCatch(cbind(qtab_1, qtab_1_2), error = function(e) e)
> stopifnot(inherits(test, "error"))
> 
> qtab_1_3 <- qable(mtcars[, c("mpg", "cyl")], rgroup = sample(make))
> test <- tryCatch(cbind(qtab_1, qtab_1_3), error = function(e) e)
> stopifnot(inherits(test, "error"))
> 
> # the attributes of the object from cbind should  be those of the first object
> # passed in
> stopifnot(identical(attributes(qtab_2)$qable_args$kable_args, list(caption = "2")))
> stopifnot(identical(attributes(qtab_1)$qable_args$kable_args, list(caption = "1")))
> stopifnot(identical(attributes(cbind(qtab_1, qtab_2))$qable_args$kable_args, list(caption = "1")))
> stopifnot(identical(attributes(cbind(qtab_2, qtab_1))$qable_args$kable_args, list(caption = "2")))
> 
> ################################################################################
> # testing rbind
> m1 <- mtcars2[grepl("^M", mtcars2$make), ]
> m1 <- m1[order(m1$make, m1$model), ]
> m2 <- mtcars2[!grepl("^M", mtcars2$make), ]
> m2 <- m2[order(m2$make, m2$model), ]
> 
> rg1 <- c(table(m1$make))
> rg2 <- c(table(m2$make))
> m <- rbind(m1, m2)
> rg <- c(table(m$make))
> rg <- rg[c(names(rg1), names(rg2))]
> 
> stopifnot(isTRUE(
+   all.equal(
+     rbind(qable(m1, rgroup = rg1), qable(m2, rgroup = rg2))
+     ,
+     qable(m, rgroup = rg)
+     )
+   )
+ )
> 
> ################################################################################
> ##                                End of File                                 ##
> ################################################################################
> 
> proc.time()
   user  system elapsed 
   0.31    0.15    0.45