Commit 092dac72 authored by Pradat Yoann's avatar Pradat Yoann

allow multiple cols_more with a named list; pass test on DEXP

parent 162f7c04
repository <- "viz"
repository <- "visualisation"
if (grepl(repository, getwd())){
path <- unlist(strsplit(getwd(), repository))[1]
......
......@@ -25,7 +25,7 @@
extra_table_grob <- function(dscale, dcolor=NULL,
rows=rownames(dscale), cols=colnames(dscale),
rows_more=NULL, cols_more=NULL,
rows_more_title="", cols_more_title="",
rows_more_title="",
theme=ttheme_awesome(), vp=NULL){
widths <- rep(theme$core$size, ncol(dscale))
......@@ -48,13 +48,16 @@ extra_table_grob <- function(dscale, dcolor=NULL,
if(!is.null(cols)){
if (!is.null(cols_more)){
gc <- gtable_table(t(cols_more), name="colmore",
fg_fun=theme$colmore$fg_fun,
bg_fun=theme$colmore$bg_fun,
fg_params=theme$colmore$fg_params,
bg_params=theme$colmore$bg_params,
padding=theme$colmore$padding)
g <- rbind_2(gc, g, "max", height=theme$colmore$padding[1])
for (cols_m_name in names(cols_more)){
cols_m <- cols_more[[cols_m_name]]
gc <- gtable_table(t(cols_m), name="colmore",
fg_fun=theme$colmore$fg_fun,
bg_fun=theme$colmore$bg_fun,
fg_params=theme$colmore$fg_params,
bg_params=theme$colmore$bg_params,
padding=theme$colmore$padding)
g <- rbind_2(gc, g, "max", height=theme$colmore$padding[1])
}
}
gc <- gtable_table(t(cols), name="colhead",
......@@ -69,7 +72,7 @@ extra_table_grob <- function(dscale, dcolor=NULL,
if(!is.null(rows)){
if(!is.null(cols)){
if(!is.null(cols_more))
rows <- c("", cols_more_title, rows)
rows <- c("", names(cols_more), rows)
else
rows <- c("", rows)
}
......
suppressMessages(library(SummarizedExperiment))
load("testdata/DBS.rda")
load("testdata/DEXP.rda")
......@@ -14,7 +14,7 @@ test_that("extra table grob cols more", {
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=",
cols_more=list("n="=SummarizedExperiment::colData(DBS)$description),
theme=theme)
out <- plot_grob(g, name="extra_table_grob_cols_more.pdf", width=4, height=4)
......@@ -26,7 +26,7 @@ test_that("extra table grob cols more rows more no color", {
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=",
cols_more=list("n="=SummarizedExperiment::colData(DBS)$description),
rows_more=SummarizedExperiment::rowData(DBS)$description, rows_more_title="Proposied aetiology",
theme=theme)
......@@ -44,10 +44,29 @@ test_that("extra table grob cols more rows more with color", {
g <- extra_table_grob(dscale=dscale, dcolor=dcolor,
rows=rownames(dscale), cols=colnames(dscale),
cols_more=SummarizedExperiment::colData(DBS)$description, cols_more_title="n=",
cols_more=list("n="=SummarizedExperiment::colData(DBS)$description),
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_with_color.pdf", width=5, height=4)
expect_true(out$plot_success)
})
test_that("extra table grob genes work", {
pal <- c("#6e0d25", "#c6ca53")
pal_breaks <- c(-2, 0, 2)
theme <- ttheme_awesome(core_size=unit(5, "mm"), pal=pal, pal_breaks=pal_breaks)
dscale <- SummarizedExperiment::assays(DEXP)$pvalue
dcolor <- SummarizedExperiment::assays(DEXP)$sign
g <- extra_table_grob(dscale=dscale, dcolor=dcolor,
rows=rownames(dscale), cols=colnames(dscale),
cols_more=list("n1="=SummarizedExperiment::colData(DBS)$description,
"n2="=SummarizedExperiment::colData(DBS)$description),
rows_more=NULL,
theme=theme)
out <- plot_grob(g, name="extra_table_grob_cols_more_with_color_genes.pdf", width=5, height=12)
expect_true(out$plot_success)
})
# R code for producing synthetic data for tests
suppressMessages(library(SummarizedExperiment))
rows <- sapply(1:50, function(i) paste0("ENSG00000",i))
cols <- c("Biliary-AdenoCA", "Bladder-TCC", "Bone-Osteosarc", "Bone-Other", "Breast", "Cervix", "CNS-GBM",
"CNS-Medullo", "CNS-Oligo", "CNS-PiloAstro", "Colorect-AdenoCA", "Eso-AdenoCA")
assays <- SimpleList()
# metadata =============================================================================================================
metadata <- list("pvalue" = "adjusted pvalue multiple testing",
"sign" = "sign of the beta coefficient")
# proportions assay ====================================================================================================
data <- matrix(runif(length(rows)*length(cols), min=0, max=1), nrow=length(rows))
rownames(data) <- rows
colnames(data) <- cols
assays[["pvalue"]] <- data
# median numbers assay =================================================================================================
data <- matrix(sample(c(-1,1), size=length(rows)*length(cols), replace=T), nrow=length(rows))
rownames(data) <- rows
colnames(data) <- cols
assays[["sign"]] <- data
# row data for SummarizedExperiment object =============================================================================
rowData <- data.frame(name=rows, stringsAsFactors=F)
# col data for SummarizedExperiment object =============================================================================
cols.desc <- c(8, 10, 0, 0, 18, 0, 2, 0, 0, 0, 13, 1)
colData <- data.frame(name=cols, description=cols.desc, stringsAsFactors=F)
# SummarizedExperiment object ==========================================================================================
DEXP <- SummarizedExperiment(
assays = assays,
colData = colData,
rowData = rowData,
metadata = metadata
)
# save data ============================================================================================================
dir.create("inst/testdata", showWarnings=F, recursive=T)
save(DEXP, file="inst/testdata/DEXP.rda")
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