library(testthat)
# most common expectations:
# equality: expect_equal() and expect_identical()
# regexp: expect_match()
# catch-all: expect_true() and expect_false()
# console output: expect_output()
# messages: expect_message()
# warning: expect_warning()
# errors: expect_error()
escapeString <- function(s) {
t <- gsub("(\\\\)", "\\\\\\\\", s)
t <- gsub("(\n)", "\\\\n", t)
t <- gsub("(\r)", "\\\\r", t)
t <- gsub("(\")", "\\\\\"", t)
return(t)
}
prepStr <- function(s, varName="html") {
t <- escapeString(s)
u <- eval(parse(text=paste0("\"", t, "\"")))
if(s!=u) stop("Unable to escape string!")
if(is.null(varName)) varName <- "html"
t <- paste0("\t", varName, " <- \"", t, "\"")
utils::writeClipboard(t)
return(invisible())
}
context("MERGED CELLS TESTS")
test_that("merge cells test", {
# data for the table
saleIds <- c(5334, 5336, 5338, 5339)
items <- c("Apple", "Orange", "Banana", "Grapefruit")
quantities <- c(5, 8, 6, 2)
prices <- c(0.34452354, 0.4732543, 1.3443243, 0.5628432)
status <- c("Good", "OK", "Bad", "OK")
# construct the table
library(basictabler)
tbl <- BasicTable$new()
tbl$addData(data.frame(saleIds, items, quantities, prices, status),
firstColumnAsRowHeaders=TRUE,
explicitColumnHeaders=c("Sale ID", "Item", "Quantity", "Price", "Status"),
columnFormats=list(NULL, NULL, NULL, "%.2f", NULL))
# merge the cells and specify new heading
tbl$mergeCells(rFrom=1, cFrom=2, rSpan=1, cSpan=2)
cell <- tbl$cells$getCell(1, 2)
cell$rawValue <- "Item & Qty"
cell$formattedValue <- "Item & Qty"
tbl$mergeCells(rFrom=3, cFrom=3, rSpan=2, cSpan=2)
cell <- tbl$cells$getCell(3, 3)
cell$rawValue <- "??"
cell$formattedValue <- "??"
# tbl$renderTable()
# prepStr(tbl$print(asCharacter=TRUE), "str")
# prepStr(as.character(tbl$getHtml()))
str <- "Sale ID Item & Qty Quantity Price Status \n 5334 Apple 5 0.34 Good \n 5336 Orange ?? 0.47 OK \n 5338 Banana 6 1.34 Bad \n 5339 Grapefruit 2 0.56 OK "
html <- "\n \n | Sale ID | \n Item & Qty | \n Price | \n Status | \n
\n \n \n | Apple | \n 5 | \n 0.34 | \n Good | \n
\n \n \n | Orange | \n ?? | \n OK | \n
\n \n \n | Banana | \n Bad | \n
\n \n \n | Grapefruit | \n 2 | \n 0.56 | \n OK | \n
\n
"
expect_identical(tbl$print(asCharacter=TRUE), str)
expect_identical(as.character(tbl$getHtml()), html)
})
test_that("merge cells test (using rowNumbers/columnNumbers and then from/to)", {
# data for the table
saleIds <- c(5334, 5336, 5338, 5339)
items <- c("Apple", "Orange", "Banana", "Grapefruit")
quantities <- c(5, 8, 6, 2)
prices <- c(0.34452354, 0.4732543, 1.3443243, 0.5628432)
status <- c("Good", "OK", "Bad", "OK")
# construct the table
library(basictabler)
tbl <- BasicTable$new()
tbl$addData(data.frame(saleIds, items, quantities, prices, status),
firstColumnAsRowHeaders=TRUE,
explicitColumnHeaders=c("Sale ID", "Item", "Quantity", "Price", "Status"),
columnFormats=list(NULL, NULL, NULL, "%.2f", NULL))
# merge the cells and specify new heading
tbl$mergeCells(rowNumbers=1, columnNumbers=c(2,3))
cell <- tbl$cells$getCell(1, 2)
cell$rawValue <- "Item & Qty"
cell$formattedValue <- "Item & Qty"
tbl$mergeCells(rFrom=3, cFrom=3, rTo=4, cTo=4)
cell <- tbl$cells$getCell(3, 3)
cell$rawValue <- "??"
cell$formattedValue <- "??"
# tbl$renderTable()
# prepStr(tbl$print(asCharacter=TRUE), "str")
# prepStr(as.character(tbl$getHtml()))
str <- "Sale ID Item & Qty Quantity Price Status \n 5334 Apple 5 0.34 Good \n 5336 Orange ?? 0.47 OK \n 5338 Banana 6 1.34 Bad \n 5339 Grapefruit 2 0.56 OK "
html <- "\n \n | Sale ID | \n Item & Qty | \n Price | \n Status | \n
\n \n \n | Apple | \n 5 | \n 0.34 | \n Good | \n
\n \n \n | Orange | \n ?? | \n OK | \n
\n \n \n | Banana | \n Bad | \n
\n \n \n | Grapefruit | \n 2 | \n 0.56 | \n OK | \n
\n
"
expect_identical(tbl$print(asCharacter=TRUE), str)
expect_identical(as.character(tbl$getHtml()), html)
})
test_that("merge cells test (compatibility mode)", {
# data for the table
saleIds <- c(5334, 5336, 5338, 5339)
items <- c("Apple", "Orange", "Banana", "Grapefruit")
quantities <- c(5, 8, 6, 2)
prices <- c(0.34452354, 0.4732543, 1.3443243, 0.5628432)
status <- c("Good", "OK", "Bad", "OK")
# construct the table
library(basictabler)
tbl <- BasicTable$new(compatibility=list(headerCellsAsTD=TRUE, explicitHeaderSpansOfOne=TRUE))
tbl$addData(data.frame(saleIds, items, quantities, prices, status),
firstColumnAsRowHeaders=TRUE,
explicitColumnHeaders=c("Sale ID", "Item", "Quantity", "Price", "Status"),
columnFormats=list(NULL, NULL, NULL, "%.2f", NULL))
# merge the cells and specify new heading
tbl$mergeCells(rFrom=1, cFrom=2, rSpan=1, cSpan=2)
cell <- tbl$cells$getCell(1, 2)
cell$rawValue <- "Item & Qty"
cell$formattedValue <- "Item & Qty"
tbl$mergeCells(rFrom=3, cFrom=3, rSpan=2, cSpan=2)
cell <- tbl$cells$getCell(3, 3)
cell$rawValue <- "??"
cell$formattedValue <- "??"
# tbl$renderTable()
# prepStr(tbl$print(asCharacter=TRUE), "str")
# prepStr(as.character(tbl$getHtml()))
str <- "Sale ID Item & Qty Quantity Price Status \n 5334 Apple 5 0.34 Good \n 5336 Orange ?? 0.47 OK \n 5338 Banana 6 1.34 Bad \n 5339 Grapefruit 2 0.56 OK "
html <- "\n \n | Sale ID | \n Item & Qty | \n Price | \n Status | \n
\n \n \n | Apple | \n 5 | \n 0.34 | \n Good | \n
\n \n \n | Orange | \n ?? | \n OK | \n
\n \n \n | Banana | \n Bad | \n
\n \n \n | Grapefruit | \n 2 | \n 0.56 | \n OK | \n
\n
"
expect_identical(tbl$print(asCharacter=TRUE), str)
expect_identical(as.character(tbl$getHtml()), html)
})
test_that("merge and manipulate test", {
# data for the table
ints0 <- 0:29
ints1 <- 100:129
ints2 <- 200:229
ints3 <- 300:329
ints4 <- 400:429
ints5 <- 500:529
ints6 <- 600:629
ints7 <- 700:729
ints8 <- 800:829
ints9 <- 900:929
df <- data.frame(ints0, ints1, ints2, ints3, ints4, ints5, ints6, ints7, ints8, ints9)
colNames <- c("0-99", "100-199", "200-299", "300-399", "400-499", "500-599", "600-699", "700-799", "800-899", "900-999")
# construct the table
library(basictabler)
tbl <- BasicTable$new(compatibility=list(headerCellsAsTD=TRUE, explicitHeaderSpansOfOne=TRUE))
# populate the table
tbl$addData(df, explicitColumnHeaders=colNames)
# do some merges!
tbl$mergeCells(rFrom=10, cFrom=4, rSpan=5, cSpan=3)
tbl$cells$setValue(10, 4, rawValue="Merge 1")
tbl$mergeCells(rFrom=17, cFrom=6, rSpan=7, cSpan=2)
tbl$cells$setValue(17, 6, rawValue="Merge 2!")
tbl$mergeCells(rFrom=6, cFrom=9, rSpan=7, cSpan=1)
tbl$cells$setValue(6, 9, rawValue="Merge 3!")
# do some manipulation
tbl$cells$insertRow(4)
tbl$cells$setValue(4, 5, rawValue="NEW")
tbl$cells$insertRow(8)
tbl$cells$setValue(8, 5, rawValue="NEW")
tbl$cells$deleteRow(13)
tbl$cells$deleteRow(12)
tbl$cells$deleteRow(14)
tbl$cells$deleteColumn(4)
tbl$cells$insertColumn(6)
# tbl$renderTable()
# prepStr(tbl$print(asCharacter=TRUE), "str")
# prepStr(as.character(tbl$getHtml()))
str <- "0-99 100-199 200-299 400-499 500-599 600-699 700-799 800-899 900-999 \n 0 100 200 400 500 600 700 800 900 \n 1 101 201 401 501 601 701 801 901 \n NEW \n 2 102 202 402 502 602 702 802 902 \n 3 103 203 403 503 603 703 803 903 \n 4 104 204 404 504 604 704 Merge 3! 904 \n NEW \n 5 105 205 405 505 605 705 805 905 \n 6 106 206 406 506 606 706 806 906 \n 7 107 207 407 507 607 707 807 907 \n 10 110 210 410 510 610 710 810 910 \n 11 111 211 411 511 611 711 811 911 \n 13 113 213 413 513 613 713 813 913 \n 14 114 214 414 514 614 714 814 914 \n 15 115 215 415 Merge 2! 615 715 815 915 \n 16 116 216 416 516 616 716 816 916 \n 17 117 217 417 517 617 717 817 917 \n 18 118 218 418 518 618 718 818 918 \n 19 119 219 419 519 619 719 819 919 \n 20 120 220 420 520 620 720 820 920 \n 21 121 221 421 521 621 721 821 921 \n 22 122 222 422 522 622 722 822 922 \n 23 123 223 423 523 623 723 823 923 \n 24 124 224 424 524 624 724 824 924 \n 25 125 225 425 525 625 725 825 925 \n 26 126 226 426 526 626 726 826 926 \n 27 127 227 427 527 627 727 827 927 \n 28 128 228 428 528 628 728 828 928 \n 29 129 229 429 529 629 729 829 929 "
html <- "\n \n | 0-99 | \n 100-199 | \n 200-299 | \n 400-499 | \n 500-599 | \n | \n 600-699 | \n 700-799 | \n 800-899 | \n 900-999 | \n
\n \n | 0 | \n 100 | \n 200 | \n 400 | \n 500 | \n | \n 600 | \n 700 | \n 800 | \n 900 | \n
\n \n | 1 | \n 101 | \n 201 | \n 401 | \n 501 | \n | \n 601 | \n 701 | \n 801 | \n 901 | \n
\n \n \n | \n | \n NEW | \n | \n | \n | \n | \n | \n | \n
\n \n | 2 | \n 102 | \n 202 | \n 402 | \n 502 | \n | \n 602 | \n 702 | \n 802 | \n 902 | \n
\n \n | 3 | \n 103 | \n 203 | \n 403 | \n 503 | \n | \n 603 | \n 703 | \n 803 | \n 903 | \n
\n \n | 4 | \n 104 | \n 204 | \n 404 | \n 504 | \n | \n 604 | \n 704 | \n Merge 3! | \n 904 | \n
\n \n \n | \n | \n NEW | \n | \n | \n | \n | \n | \n
\n \n | 5 | \n 105 | \n 205 | \n 405 | \n 505 | \n | \n 605 | \n 705 | \n 905 | \n
\n \n | 6 | \n 106 | \n 206 | \n 406 | \n 506 | \n | \n 606 | \n 706 | \n 906 | \n
\n \n | 7 | \n 107 | \n 207 | \n 407 | \n 507 | \n | \n 607 | \n 707 | \n 907 | \n
\n \n | 10 | \n 110 | \n 210 | \n 410 | \n | \n 610 | \n 710 | \n 910 | \n
\n \n | 11 | \n 111 | \n 211 | \n | \n 611 | \n 711 | \n 811 | \n 911 | \n
\n \n | 13 | \n 113 | \n 213 | \n 413 | \n 513 | \n | \n 613 | \n 713 | \n 813 | \n 913 | \n
\n \n | 14 | \n 114 | \n 214 | \n 414 | \n 514 | \n | \n 614 | \n 714 | \n 814 | \n 914 | \n
\n \n | 15 | \n 115 | \n 215 | \n 415 | \n Merge 2! | \n 715 | \n 815 | \n 915 | \n
\n \n | 16 | \n 116 | \n 216 | \n 416 | \n 716 | \n 816 | \n 916 | \n
\n \n | 17 | \n 117 | \n 217 | \n 417 | \n 717 | \n 817 | \n 917 | \n
\n \n | 18 | \n 118 | \n 218 | \n 418 | \n 718 | \n 818 | \n 918 | \n
\n \n | 19 | \n 119 | \n 219 | \n 419 | \n 719 | \n 819 | \n 919 | \n
\n \n | 20 | \n 120 | \n 220 | \n 420 | \n 720 | \n 820 | \n 920 | \n
\n \n | 21 | \n 121 | \n 221 | \n 421 | \n 721 | \n 821 | \n 921 | \n
\n \n | 22 | \n 122 | \n 222 | \n 422 | \n 522 | \n | \n 622 | \n 722 | \n 822 | \n 922 | \n
\n \n | 23 | \n 123 | \n 223 | \n 423 | \n 523 | \n | \n 623 | \n 723 | \n 823 | \n 923 | \n
\n \n | 24 | \n 124 | \n 224 | \n 424 | \n 524 | \n | \n 624 | \n 724 | \n 824 | \n 924 | \n
\n \n | 25 | \n 125 | \n 225 | \n 425 | \n 525 | \n | \n 625 | \n 725 | \n 825 | \n 925 | \n
\n \n | 26 | \n 126 | \n 226 | \n 426 | \n 526 | \n | \n 626 | \n 726 | \n 826 | \n 926 | \n
\n \n | 27 | \n 127 | \n 227 | \n 427 | \n 527 | \n | \n 627 | \n 727 | \n 827 | \n 927 | \n
\n \n | 28 | \n 128 | \n 228 | \n 428 | \n 528 | \n | \n 628 | \n 728 | \n 828 | \n 928 | \n
\n \n | 29 | \n 129 | \n 229 | \n 429 | \n 529 | \n | \n 629 | \n 729 | \n 829 | \n 929 | \n
\n
"
expect_identical(tbl$print(asCharacter=TRUE), str)
expect_identical(as.character(tbl$getHtml()), html)
})