Commit 4354909c authored by Pradat Yoann's avatar Pradat Yoann

v0.99.1 and add gitlab-ci.yml

parent 34f1ddad
image: rocker/r-base
stages:
- dependencies
- build
- document
- check
- test
- install
variables:
CODECOV_TOKEN: "b524d434-9189-48fc-a919-72e40de8cd22"
before_script:
- apt-get update
install_dependencies:
stage: dependencies
script:
- apt-get install --yes --no-install-recommends r-cran-devtools
- R -e 'devtools::install_deps(dependencies=c("Depends", "Imports", "Suggests"))'
buildbinary:
stage: build
script:
- R -e 'devtools::build(binary=T)'
documentation:
stage: document
script:
- R -e 'devtools::document()'
checkerrors:
stage: check
script:
- R -e 'if (!identical(devtools::check(document = FALSE, args = "--no-tests")[["errors"]], character(0))) stop("Check with Errors")'
unittests:
stage: test
script:
- R -e 'if (any(as.data.frame(devtools::test())[["failed"]] > 0)) stop("Some tests failed.")'
codecov:
stage: test
script:
- R -e 'covr::codecov()'
install:
stage: install
script:
- R -e 'devtools::install()'
Package: tableExtra
Title: Draws an awesome table
Version: 0.99.0
Version: 0.99.1
Authors@R:
person(given = "Yoann",
family = "Pradat",
......@@ -13,7 +13,9 @@ LazyData: true
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.1.1
Suggests:
testthat
testthat,
dplyr,
tibble
Depends:
R (>= 2.10)
Imports:
......
# Generated by roxygen2: do not edit by hand
export(combine)
export(gtable_cbind)
export(gtable_combine)
export(gtable_rbind)
export(table_extra_grob)
export(ttheme_awesome)
import(grid)
import(gtable)
importFrom(grid,unit.c)
importFrom(gtable,gtable_add_cols)
importFrom(gtable,gtable_add_rows)
importFrom(methods,is)
importFrom(utils,modifyList)
This diff is collapsed.
......@@ -12,8 +12,8 @@
#' \item{Cancer.Types}{37 different cancer types}
#' \item{Sample.Names}{Unique tumour identifiers}
#' \item{Accuracy}{Cosine similarity between the tumour's mutational profile and the reconstructed mutational profile}
#' \item{SBSXXX}{Each SBSXXX variable represents the counts attributed to the signature SBSXXX in the corresponding
#' tumour}
#' \item{SBS1}{Single-base-substitution signature 1. See <https://cancer.sanger.ac.uk/cosmic/signatures/SBS/SBS1.tt>}
#' ...
#' }
#'
#' @docType data
......
......@@ -4,16 +4,24 @@
#'
#' @description Create a gtable containing circle grobs representing a numeric matrix.
#' @param dscale a matrix
#' @param dscale_min value for setting the minimum scale size of foreground grobs. Entries in the \code{dscale} matrix
#' below \code{dscale_min} will have a scale of 0 (no grob).
#' @param dscale_max value for setting the maximum scale size of foreground grobs. Entries in the \code{dscale} matrix
#' above \code{dscale_max} will have a scale of 0 (no grob).
#' @param dcolor (optional) a matrix
#' @param rows (optional) a character vector
#' @param cols (optional) a character vector
#' @param rows_more (optional) a named list of additional columns (right-part) of the plot for describing the rows. The
#' list names will be used as column headers.
#' @param cols_more (optional) a named list of additional rows (top-part) of the plot for describing the columns The
#' list names will be used as row headers.
#' @param theme list of theme parameters
#' @param vp optional viewport
#'
#' @import gtable
#' @importFrom gtable gtable_add_rows
#'
#' @seealso [theme_awesome()]
#' @seealso [ttheme_awesome()]
#'
#' @return An R object of class \code{grob}
#'
......@@ -58,7 +66,7 @@ table_extra_grob <- function(dscale, dcolor=NULL,
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])
g <- gtable_rbind(gc, g, size="max", height=theme$colmore$padding[1])
}
}
......@@ -84,7 +92,7 @@ table_extra_grob <- function(dscale, dcolor=NULL,
fg_params=theme$rowhead$fg_params,
bg_params=theme$rowhead$bg_params,
padding=theme$rowhead$padding)
g <- cbind_2(gr, g, "max", width=theme$rowhead$padding[2])
g <- gtable_cbind(gr, g, size="max", width=theme$rowhead$padding[2])
if(!is.null(rows_more)){
for (rows_m_name in names(rows_more)){
......@@ -102,7 +110,7 @@ table_extra_grob <- function(dscale, dcolor=NULL,
fg_params=theme$rowmore$fg_params,
bg_params=theme$rowmore$bg_params,
padding=theme$rowmore$padding)
g <- cbind_2(g, gr, "max", width=theme$rowmore$padding[2])
g <- gtable_cbind(g, gr, size="max", width=theme$rowmore$padding[2])
}
}
}
......
......@@ -50,8 +50,6 @@ table_params_circle_scale <- function(d, scale_breaks=10, r_min=unit(4, "mm"), r
#' @param color_palette a character vector of color names
#' @param color_breaks a numeric vector of break points
#'
#' @importFrom methods is
#'
#' @author Yoann Pradat
#' @keywords internal
table_params_circle_color <- function(d, color_palette, color_breaks=NULL){
......@@ -61,7 +59,7 @@ table_params_circle_color <- function(d, color_palette, color_breaks=NULL){
if (is.null(color_breaks)){
color_breaks <- length(color_palette)
}
if (is(color_breaks,"integer")){
if (length(color_breaks)==1){
if (color_breaks==1){
d <- as.matrix(color_palette, nrow=nrow(d), ncol=ncol(d))
}
......
......@@ -3,25 +3,31 @@
\name{gtable_rbind}
\alias{gtable_rbind}
\alias{gtable_cbind}
\title{rbind gtables}
\title{rbind two or more gtables}
\usage{
gtable_rbind(..., size = "max", z = NULL)
gtable_rbind(..., size = "max", height = NULL, z = NULL)
gtable_cbind(..., size = "max", z = NULL)
gtable_cbind(..., size = "max", width = NULL, z = NULL)
}
\arguments{
\item{...}{gtables}
\item{size}{how should the widths be calculated?
\code{max} maximum of all widths
\code{min} minimum of all widths
\code{first} widths/heights of first gtable
\code{last} widths/heights of last gtable}
\enumerate{
\item \code{max} maximum of all widths
\item \code{min} minimum of all widths
\item \code{first} widths/heights of first gtable
\item \code{last} widths/heights of last gtable
}}
\item{height}{padding height between grobs}
\item{z}{optional z level}
\item{width}{padding width between grobs}
}
\description{
rbind gtables
rbind two or more gtables
cbind gtables
cbind two or more gtables
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/gtable_utils.R
\name{cbind_2}
\alias{cbind_2}
\title{cbind two gtables}
\usage{
cbind_2(x, y, size = "max", width = NULL)
}
\arguments{
\item{x}{}
\item{size}{how should the widths be calculated?
\enumerate{
\item \code{max} maximum of all widths
\item \code{min} minimum of all widths
\item \code{first} widths/heights of first gtable
\item \code{last} widths/heights of last gtable
}}
\item{width}{padding width between grobs}
}
\description{
cbind two gtables
}
\keyword{internal}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/gtable_utils.R
\name{gtable_combine}
\alias{gtable_combine}
\alias{combine}
\title{Combine gtables based on row/column names.}
\usage{
gtable_combine(..., along = 1L, join = "outer")
combine(..., along = 1L, join = "outer")
}
\arguments{
\item{...}{gtables}
\item{along}{dimension to align along, \code{1} = rows,
\code{2} = cols.}
\item{join}{when x and y have different names, how should the difference be resolved?
\code{inner} keep names that appear in both,
\code{outer} keep names that appear in either,
\code{left} keep names from \code{x},
and \code{right} keep names from \code{y}.}
}
\description{
Combine gtables based on row/column names.
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/gtable_utils.R
\name{insert.unit}
\alias{insert.unit}
\title{Insert unit}
\usage{
insert.unit(x, values, after = length(x))
}
\arguments{
\item{x}{x param}
\item{values}{values param}
\item{after}{(optional) after param}
}
\description{
Helper for \link{rbind_2} and \link{cbind_2}.
}
\keyword{internal}
......@@ -10,8 +10,8 @@ A data frame with 2780 rows and 68 variables
\item{Cancer.Types}{37 different cancer types}
\item{Sample.Names}{Unique tumour identifiers}
\item{Accuracy}{Cosine similarity between the tumour's mutational profile and the reconstructed mutational profile}
\item{SBSXXX}{Each SBSXXX variable represents the counts attributed to the signature SBSXXX in the corresponding
tumour}
\item{SBS1}{Single-base-substitution signature 1. See \url{https://cancer.sanger.ac.uk/cosmic/signatures/SBS/SBS1.tt}}
...
}
}
\source{
......
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/gtable_utils.R
\name{rbind_2}
\alias{rbind_2}
\title{rbind two gtables}
\usage{
rbind_2(x, y, size = "max", height = NULL)
}
\arguments{
\item{x}{}
\item{size}{how should the widths be calculated?
\enumerate{
\item \code{max} maximum of all widths
\item \code{min} minimum of all widths
\item \code{first} widths/heights of first gtable
\item \code{last} widths/heights of last gtable
}}
\item{height}{padding height between grobs}
}
\description{
rbind two gtables
}
\keyword{internal}
......@@ -24,10 +24,22 @@ table_extra_grob(
\item{dcolor}{(optional) a matrix}
\item{dscale_min}{value for setting the minimum scale size of foreground grobs. Entries in the \code{dscale} matrix
below \code{dscale_min} will have a scale of 0 (no grob).}
\item{dscale_max}{value for setting the maximum scale size of foreground grobs. Entries in the \code{dscale} matrix
above \code{dscale_max} will have a scale of 0 (no grob).}
\item{rows}{(optional) a character vector}
\item{cols}{(optional) a character vector}
\item{rows_more}{(optional) a named list of additional columns (right-part) of the plot for describing the rows. The
list names will be used as column headers.}
\item{cols_more}{(optional) a named list of additional rows (top-part) of the plot for describing the columns The
list names will be used as row headers.}
\item{theme}{list of theme parameters}
\item{vp}{optional viewport}
......@@ -42,7 +54,7 @@ Create a gtable containing circle grobs representing a numeric matrix.
library(tableExtra)
}
\seealso{
\code{\link[=theme_awesome]{theme_awesome()}}
\code{\link[=ttheme_awesome]{ttheme_awesome()}}
}
\author{
Yoann Pradat
......
suppressMessages(library(SummarizedExperiment))
suppressMessages(library(dplyr))
suppressMessages(library(tibble))
......
test_that("load test data DBS.rda works", {
expect_equal(nrow(DBS), 11)
expect_equal(ncol(DBS), 12)
expect_true(is(DBS, "SummarizedExperiment"))
})
test_that("rbind_2 on text row works", {
test_that("rbind_2 and gtable_rbind on text row works", {
theme <- ttheme_awesome()
d <- t(SummarizedExperiment::colData(DBS)$description)
d <- t(DBS$colData$description)
g1 <- gtable_table(d, name="colhead-1",
fg_fun = theme$colhead$fg_fun,
......@@ -17,14 +17,17 @@ test_that("rbind_2 on text row works", {
padding=theme$colhead$padding)
g <- rbind_2(g1, g2, "max", height=theme$core$padding[1])
out <- plot_grob(g, name="rbind_2_text_row.pdf", width=4, height=1)
expect_true(out$plot_success)
out <- plot_grob(g, name="gtable_rbind_2_text_row.pdf", width=4, height=1)
g <- gtable_rbind(g1, g2, g1, g2, size="max", height=theme$core$padding[1])
out <- plot_grob(g, name="gtable_rbind_4_text_row.pdf", width=4, height=1)
expect_true(out$plot_success)
})
test_that("rbind_2 on text mat works", {
test_that("rbind_2 and gtable_rbind on text mat works", {
theme <- ttheme_awesome()
d <- SummarizedExperiment::rowData(DBS)$name
d <- DBS$rowData$name
d <- matrix(rep(d, 5), nrow=5, byrow=T)
g1 <- gtable_table(d, name="rowhead-1",
......@@ -42,15 +45,19 @@ test_that("rbind_2 on text mat works", {
padding=theme$rowhead$padding)
g <- rbind_2(g1, g2, size="first", height=theme$rowhead$padding[1])
out <- plot_grob(g, name="rbind_2_text_mat.pdf", width=4, height=3)
expect_true(out$plot_success)
out <- plot_grob(g, name="gtable_rbind_2_text_mat.pdf", width=4, height=3)
g <- gtable_rbind(g1, g2, g1, g2, size="max", height=theme$core$padding[1])
out <- plot_grob(g, name="gtable_rbind_4_text_mat.pdf", width=6, height=3)
expect_true(out$plot_success)
})
test_that("cbind_2 on table circle works", {
theme <- ttheme_awesome()
d <- SummarizedExperiment::assays(DBS)$proportion
d <- DBS$assays$proportion
widths <- rep(theme$core$size, ncol(d))
heights <- rep(theme$core$size, nrow(d))
......@@ -65,6 +72,7 @@ test_that("cbind_2 on table circle works", {
scale_breaks=theme$core$scale_breaks,
dscale_min=NULL,
dscale_max=NULL,
r_min=0.1*theme$core$size,
r_max=0.5*theme$core$size)
g2 <- gtable_table(d, name="circle",
......@@ -78,17 +86,22 @@ test_that("cbind_2 on table circle works", {
scale_breaks=theme$core$scale_breaks,
dscale_min=NULL,
dscale_max=NULL,
r_min=0.1*theme$core$size,
r_max=0.5*theme$core$size)
g <- cbind_2(g1, g2, "max", width=theme$core$padding[2])
out <- plot_grob(g, name="cbind_2_circles.pdf", width=10, height=6)
expect_true(out$plot_success)
out <- plot_grob(g, name="gtable_circle_cbind.pdf", width=10, height=6)
g <- gtable_cbind(g1, g2, g1, g2, size="max", width=theme$core$padding[2])
out <- plot_grob(g, name="gtable_cbind_4_circles.pdf", width=20, height=6)
expect_true(out$plot_success)
})
test_that("rbind_2 on table text - circle works", {
theme <- ttheme_awesome()
d <- SummarizedExperiment::assays(DBS)$proportion
d <- DBS$assays$proportion
col <- t(colnames(d))
g1 <- gtable_table(col, name="colhead-1",
......@@ -111,10 +124,11 @@ test_that("rbind_2 on table text - circle works", {
scale_breaks=theme$core$scale_breaks,
dscale_min=NULL,
dscale_max=NULL,
r_min=0.1*theme$core$size,
r_max=0.5*theme$core$size)
g <- rbind_2(g1, g2, size="last", height=theme$core$padding[1])
out <- plot_grob(g, name="gtable_rbind_2_text_circle.pdf")
out <- plot_grob(g, name="rbind_2_text_circle.pdf")
expect_true(out$plot_success)
})
test_that("gtable text row no padding", {
theme <- ttheme_awesome(padding=unit(c(0,0), "mm"))
d <- t(SummarizedExperiment::colData(DBS)$description)
d <- t(DBS$colData$description)
widths <- rep(theme$core$size, ncol(d))
heights <- unit(4, "mm")
......@@ -20,7 +20,7 @@ test_that("gtable text row no padding", {
test_that("gtable text row with padding", {
theme <- ttheme_awesome(padding=unit(c(2,0), "mm"))
d <- t(SummarizedExperiment::colData(DBS)$description)
d <- t(DBS$colData$description)
widths <- rep(theme$core$size, ncol(d))
heights <- unit(4, "mm")
......@@ -39,8 +39,8 @@ test_that("gtable text row with padding", {
test_that("gtable text col", {
theme <- ttheme_awesome(padding=unit(c(0,0), "mm"))
d <- SummarizedExperiment::rowData(DBS)["name"]
heights <- rep(theme$core$size, nrow(d))
d <- DBS$rowData$name
heights <- rep(theme$core$size, length(d))
gr <- gtable_table(d, name="rowhead",
heights=heights,
......@@ -56,7 +56,7 @@ test_that("gtable text col", {
test_that("gtable text mat no padding", {
theme <- ttheme_awesome(padding=unit(c(0,0), "mm"))
d <- SummarizedExperiment::rowData(DBS)$name
d <- DBS$rowData$name
d <- matrix(rep(d, 5), nrow=5, byrow=T)
widths <- rep(theme$core$size, ncol(d))
heights <- rep(theme$core$size, nrow(d))
......@@ -76,7 +76,7 @@ test_that("gtable text mat no padding", {
test_that("gtable text mat with padding", {
theme <- ttheme_awesome(padding=unit(c(1,1), "mm"))
d <- SummarizedExperiment::rowData(DBS)$name
d <- DBS$rowData$name
d <- matrix(rep(d, 5), nrow=5, byrow=T)
widths <- rep(theme$core$size, ncol(d))
heights <- rep(theme$core$size, nrow(d))
......@@ -97,7 +97,7 @@ test_that("gtable text mat with padding", {
test_that("gtable circle", {
theme <- ttheme_awesome()
d <- SummarizedExperiment::assays(DBS)$proportion
d <- DBS$assays$proportion
widths <- rep(theme$core$size, ncol(d))
heights <- rep(theme$core$size, nrow(d))
......@@ -112,6 +112,7 @@ test_that("gtable circle", {
scale_breaks=theme$core$scale_breaks,
dscale_min=NULL,
dscale_max=NULL,
r_min=0.1*theme$core$size,
r_max=0.5*theme$core$size)
out <- plot_grob(g, name="gtable_circle.pdf")
......
test_that("extra table grob", {
theme <- ttheme_awesome(core_size=unit(5, "mm"))
d <- SummarizedExperiment::assays(DBS)$proportion
d <- DBS$assays$proportion
g <- table_extra_grob(d, rows=rownames(d), cols=colnames(d),
theme=theme)
......@@ -11,10 +11,10 @@ test_that("extra table grob", {
test_that("extra table grob cols more", {
theme <- ttheme_awesome(core_size=unit(5, "mm"))
d <- SummarizedExperiment::assays(DBS)$proportion
d <- DBS$assays$proportion
g <- table_extra_grob(d, rows=rownames(d), cols=colnames(d),
cols_more=list("n="=SummarizedExperiment::colData(DBS)$description),
cols_more=list("n="=DBS$colData$description),
theme=theme)
out <- plot_grob(g, name="table_extra_grob_cols_more.pdf", width=4, height=4)
......@@ -23,9 +23,9 @@ test_that("extra table grob cols more", {
test_that("extra table grob cols more rows more no color", {
theme <- ttheme_awesome(core_size=unit(5, "mm"))
d <- SummarizedExperiment::assays(DBS)$proportion
cols_more <- list("n="=SummarizedExperiment::colData(DBS)$description)
rows_more <- list("Proposed aetiology"=SummarizedExperiment::rowData(DBS)$description)
d <- DBS$assays$proportion
cols_more <- list("n="=DBS$colData$description)
rows_more <- list("Proposed aetiology"=DBS$rowData$description)
g <- table_extra_grob(d, rows=rownames(d), cols=colnames(d),
cols_more=cols_more, rows_more=rows_more,
......@@ -41,10 +41,10 @@ test_that("extra table grob cols more rows more with color", {
color_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"), color_palette=color_palette, color_breaks=color_breaks)
dscale <- SummarizedExperiment::assays(DBS)$proportion
dcolor <- SummarizedExperiment::assays(DBS)$median
cols_more <- list("n="=SummarizedExperiment::colData(DBS)$description)
rows_more <- list("Proposed aetiology"=SummarizedExperiment::rowData(DBS)$description)
dscale <- DBS$assays$proportion
dcolor <- DBS$assays$median
cols_more <- list("n="=DBS$colData$description)
rows_more <- list("Proposed aetiology"=DBS$rowData$description)
g <- table_extra_grob(dscale=dscale, dcolor=dcolor,
rows=rownames(dscale), cols=colnames(dscale),
......@@ -60,13 +60,13 @@ test_that("extra table grob genes work", {
color_breaks <- c(-2, 0, 2)
theme <- ttheme_awesome(core_size=unit(5, "mm"), color_palette=color_palette, color_breaks=color_breaks)
dscale <- -log10(SummarizedExperiment::assays(DEXP)$pvalue) + 1
dcolor <- SummarizedExperiment::assays(DEXP)$sign
dscale <- -log10(DEXP$assays$pvalue) + 1
dcolor <- DEXP$assays$sign
g <- table_extra_grob(dscale=dscale, dcolor=dcolor,
rows=rownames(dscale), cols=colnames(dscale),
cols_more=list("n1="=SummarizedExperiment::colData(DBS)$description,
"n2="=SummarizedExperiment::colData(DBS)$description),
cols_more=list("n1="=DBS$colData$description,