More tests

R/condformat_render.R

@@ -107,13 +107,13 @@ render_rules_condformat_tbl <- function(rules, xfiltered, xview) {
 
 render_show <- function(showobj, finalshow, x, ...) UseMethod("render_show")
 
-render_show.default <- function(showobj, finalshow, x , ...) {
-  finalshow
-}
+# render_show.default <- function(showobj, finalshow, x , ...) {
+#   finalshow
+# }
 
 applyrule <- function(rule, finalformat, xfiltered, xview, ...) UseMethod("applyrule")
 
-
-applyrule.default <- function(rule, finalformat, xfiltered, xview, ...) {
-  finalformat
-}
+#
+# applyrule.default <- function(rule, finalformat, xfiltered, xview, ...) {
+#   finalformat
+# }

tests/testthat/test_rule_fill_discrete.R

@@ -2,7 +2,7 @@
 library(condformat)
 library(dplyr)
 library(testthat)
-context("show")
+context("rule_fill_discrete")
 
 test_that("rule_fill_discrete works", {
   data(iris)
@@ -25,3 +25,48 @@ test_that("rule_fill_discrete works", {
 })
 
 
+test_that("rule_fill_discrete lock cells", {
+  data(iris)
+  x <- condformat(head(iris))
+  y <- x +
+    rule_fill_discrete(Species,
+                       expression  = 1,
+                       colours = c("1" = "red")) +
+    rule_fill_discrete(Species,
+                       expression  = 1,
+                       colours = c("1" = "blue"))
+  out <- condformat2html(y)
+  expect_that(out[1], not(matches("red")))
+
+  y <- x +
+    rule_fill_discrete(Species,
+                       expression  = 1,
+                       colours = c("1" = "red"),
+                       lockcells = TRUE) +
+    rule_fill_discrete(Species,
+                       expression  = 1,
+                       colours = c("1" = "blue"))
+  out <- condformat2html(y)
+  expect_that(out[1], not(matches("blue")))
+
+})
+
+
+test_that("rule_fill_discrete(_) syntax with multiple variables and no expression gives warning", {
+  expect_that(rule_fill_discrete(Species, Sepal.Length),
+              gives_warning("multiple variables"))
+  expect_that(rule_fill_discrete_(columns = c("Species", "Sepal.Length")),
+              gives_warning("multiple variables"))
+})
+
+test_that("rule_fill_discrete_ works", {
+  data(iris)
+  x <- condformat(head(iris))
+  y <- x + rule_fill_discrete_("Species")
+  out <- condformat2html(y)
+  expect_that(out[1], matches("^<table.*</table>$"))
+  y <- x + rule_fill_discrete_("Species", expression = "Sepal.Length > 4.6",
+                               colours = c("TRUE" = "red"))
+  out <- condformat2html(y)
+  expect_that(out[1], matches("^<table.*</table>$"))
+})

tests/testthat/test_rule_fill_gradient.R

@@ -0,0 +1,30 @@
+# Tests:
+library(condformat)
+library(dplyr)
+library(testthat)
+context("rule_fill_gradient")
+
+test_that("rule_fill_gradient works", {
+  data(iris)
+  x <- condformat(iris[c(1:10, 51:60, 101:110),])
+  y <- x + rule_fill_gradient(Sepal.Length)
+  out <- condformat2html(y)
+  expect_that(out[1], matches("^<table.*</table>$"))
+
+  y <- x + rule_fill_gradient_("Sepal.Length")
+  out <- condformat2html(y)
+  expect_that(out[1], matches("^<table.*</table>$"))
+})
+
+test_that("rule_fill_gradient2 works", {
+  data(iris)
+  x <- condformat(iris[c(1:10, 51:60, 101:110),])
+  y <- x + rule_fill_gradient2(Sepal.Length)
+  out <- condformat2html(y)
+  expect_that(out[1], matches("^<table.*</table>$"))
+
+  y <- x + rule_fill_gradient2_("Sepal.Length")
+  out <- condformat2html(y)
+  expect_that(out[1], matches("^<table.*</table>$"))
+})
+

tests/testthat/test_show.R

@@ -16,6 +16,16 @@ test_that("show_column works", {
   expect_that(out[1], matches("Species"))
 })
 
+test_that("show_column_ works", {
+  data(iris)
+  x <- condformat(head(iris)) + show_columns_(.dots = c("Sepal.Length", "Petal.Length"))
+  expect_true("Sepal.Width" %in% colnames(x))
+  out <- condformat2html(x)
+  expect_that(out[1], not(matches("Sepal.Width")))
+  expect_that(out[1], matches("Petal.Length"))
+})
+
+
 test_that("show_column works with custom names", {
   data(iris)
   x <- condformat(head(iris)) + show_columns(Sepal.Length, Petal.Width, Species,
@@ -45,3 +55,19 @@ test_that("show_row works", {
   # the html code only shows one row (that does not have any 8 digit)
   expect_that(out[1], not(matches("8")))
 })
+
+
+test_that("show_row works after modifying data frame", {
+  data(iris)
+  x <- condformat(head(iris, n = 10))
+  x$Sepal.Length <- x$Sepal.Length + 1
+
+  x <- x + show_rows(Sepal.Length == 6.1, Sepal.Width == 3.5,
+                     Petal.Length == 1.4, Petal.Width == 0.2)
+  # in the data frame nothing is filtered
+  expect_that(nrow(x), equals(10))
+  out <- condformat2html(x)
+  # the html code only shows one row (that does not have any 8 digit)
+  expect_that(out[1], not(matches("8")))
+})
+