Commit 839e5713 authored by Pradat Yoann's avatar Pradat Yoann
Browse files

successfully run tests with color; devtools::check() does not pass though

parent 6324cdd6
suppressMessages(library(SummarizedExperiment))
load("testdata/DBS.rda")
test_that("load test data DBS.rda works", {
load("testdata/DBS.rda")
expect_equal(nrow(DBS), 11)
expect_equal(ncol(DBS), 12)
expect_true(is(DBS, "SummarizedExperiment"))
......
test_that("extra table grob", {
load("testdata/DBS.rda")
theme <- ttheme_awesome()
theme <- ttheme_awesome(core_size=unit(5, "mm"))
d <- SummarizedExperiment::assays(DBS)$proportion
g <- extra_table_grob(d, rows=rownames(d), cols=colnames(d),
theme=theme)
out <- plot_grob(g, name="extra_table_grob_big.pdf", width=6, height=6)
out <- plot_grob(g, name="extra_table_grob.pdf", width=4, height=4)
expect_true(out$plot_success)
})
test_that("extra table grob", {
load("testdata/DBS.rda")
test_that("extra table grob cols more", {
theme <- ttheme_awesome(core_size=unit(5, "mm"))
d <- SummarizedExperiment::assays(DBS)$proportion
g <- extra_table_grob(d, rows=rownames(d), cols=colnames(d),
cols_more=SummarizedExperiment::colData(DBS)$description, cols_more_title="n=",
theme=theme)
out <- plot_grob(g, name="extra_table_grob.pdf", width=4, height=4)
out <- plot_grob(g, name="extra_table_grob_cols_more.pdf", width=4, height=4)
expect_true(out$plot_success)
})
test_that("extra table grob cols more", {
load("testdata/DBS.rda")
test_that("extra table grob cols more rows more no color", {
theme <- ttheme_awesome(core_size=unit(5, "mm"))
d <- SummarizedExperiment::assays(DBS)$proportion
g <- extra_table_grob(d, rows=rownames(d), cols=colnames(d),
cols_more=SummarizedExperiment::colData(DBS)$description, cols_more_title="n=",
rows_more=SummarizedExperiment::rowData(DBS)$description, rows_more_title="Proposied aetiology",
theme=theme)
out <- plot_grob(g, name="extra_table_grob_cols_more.pdf", width=4, height=4)
out <- plot_grob(g, name="extra_table_grob_cols_more_rows_more_no_color.pdf", width=5, height=4)
expect_true(out$plot_success)
})
test_that("extra table grob cols more rows more", {
load("testdata/DBS.rda")
test_that("extra table grob cols more rows more with color", {
pal <- c("#ffc651", "#ffa759", "#ff8962", "#ff6b6b", "#cc6999", "#9968c8", "#6767f8", "#4459ce", "#224ba5", "#013d7c")
pal_breaks <- c(0, 0.001,0.005,0.008,0.01,0.02,0.03,0.05,0.1,0.5,1)
theme <- ttheme_awesome(core_size=unit(5, "mm"))
d <- SummarizedExperiment::assays(DBS)$proportion
theme <- ttheme_awesome(core_size=unit(5, "mm"), pal=pal, pal_breaks=pal_breaks)
dscale <- SummarizedExperiment::assays(DBS)$proportion
dcolor <- SummarizedExperiment::assays(DBS)$median
g <- extra_table_grob(d, rows=rownames(d), cols=colnames(d),
g <- extra_table_grob(dscale=dscale, dcolor=dcolor,
rows=rownames(dscale), cols=colnames(dscale),
cols_more=SummarizedExperiment::colData(DBS)$description, cols_more_title="n=",
rows_more=SummarizedExperiment::rowData(DBS)$description, rows_more_title="Proposied aetiology",
theme=theme)
out <- plot_grob(g, name="extra_table_grob_cols_more_rows_more.pdf", width=5, height=4)
out <- plot_grob(g, name="extra_table_grob_cols_more_rows_more_with_color.pdf", width=5, height=4)
expect_true(out$plot_success)
})
test_that("rbind_2 on text row", {
load("testdata/DBS.rda")
theme <- ttheme_awesome()
d <- t(SummarizedExperiment::colData(DBS)$description)
......@@ -25,8 +23,6 @@ test_that("rbind_2 on text row", {
})
test_that("rbind_2 on text mat", {
load("testdata/DBS.rda")
theme <- ttheme_awesome()
d <- SummarizedExperiment::rowData(DBS)$name
d <- matrix(rep(d, 5), nrow=5, byrow=T)
......@@ -53,8 +49,6 @@ test_that("rbind_2 on text mat", {
test_that("cbind_2 on table circle", {
load("testdata/DBS.rda")
theme <- ttheme_awesome()
d <- SummarizedExperiment::assays(DBS)$proportion
widths <- rep(theme$core$size, ncol(d))
......@@ -68,6 +62,7 @@ test_that("cbind_2 on table circle", {
fg_params = theme$core$fg_params,
bg_params = theme$core$bg_params,
padding=theme$core$padding,
n_cat=theme$core$n_cat,
r_max=0.5*theme$core$size)
g2 <- gtable_table(d, name="circle",
......@@ -78,6 +73,7 @@ test_that("cbind_2 on table circle", {
fg_params = theme$core$fg_params,
bg_params = theme$core$bg_params,
padding=theme$core$padding,
n_cat=theme$core$n_cat,
r_max=0.5*theme$core$size)
g <- cbind_2(g1, g2, "max", width=theme$core$padding[2])
......@@ -87,8 +83,6 @@ test_that("cbind_2 on table circle", {
})
test_that("rbind_2 on table text - circle", {
load("testdata/DBS.rda")
theme <- ttheme_awesome()
d <- SummarizedExperiment::assays(DBS)$proportion
col <- t(colnames(d))
......@@ -112,6 +106,7 @@ test_that("rbind_2 on table text - circle", {
fg_params = theme$core$fg_params,
bg_params = theme$core$bg_params,
padding=theme$core$padding,
n_cat=theme$core$n_cat,
r_max=0.5*theme$core$size)
g <- rbind_2(g1, g2, size="last", height=theme$core$padding[1])
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment