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 Package: tableExtra
Title: Draws an awesome table Title: Draws an awesome table
Version: 0.99.0 Version: 0.99.1
Authors@R: Authors@R:
person(given = "Yoann", person(given = "Yoann",
family = "Pradat", family = "Pradat",
...@@ -13,7 +13,9 @@ LazyData: true ...@@ -13,7 +13,9 @@ LazyData: true
Roxygen: list(markdown = TRUE) Roxygen: list(markdown = TRUE)
RoxygenNote: 7.1.1 RoxygenNote: 7.1.1
Suggests: Suggests:
testthat testthat,
dplyr,
tibble
Depends: Depends:
R (>= 2.10) R (>= 2.10)
Imports: Imports:
......
# Generated by roxygen2: do not edit by hand # Generated by roxygen2: do not edit by hand
export(combine)
export(gtable_cbind) export(gtable_cbind)
export(gtable_combine)
export(gtable_rbind) export(gtable_rbind)
export(table_extra_grob) export(table_extra_grob)
export(ttheme_awesome) export(ttheme_awesome)
import(grid) import(grid)
import(gtable) import(gtable)
importFrom(grid,unit.c) importFrom(grid,unit.c)
importFrom(gtable,gtable_add_cols)
importFrom(gtable,gtable_add_rows) importFrom(gtable,gtable_add_rows)
importFrom(methods,is)
importFrom(utils,modifyList) importFrom(utils,modifyList)
This diff is collapsed.
...@@ -12,8 +12,8 @@ ...@@ -12,8 +12,8 @@
#' \item{Cancer.Types}{37 different cancer types} #' \item{Cancer.Types}{37 different cancer types}
#' \item{Sample.Names}{Unique tumour identifiers} #' \item{Sample.Names}{Unique tumour identifiers}
#' \item{Accuracy}{Cosine similarity between the tumour's mutational profile and the reconstructed mutational profile} #' \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 #' \item{SBS1}{Single-base-substitution signature 1. See <https://cancer.sanger.ac.uk/cosmic/signatures/SBS/SBS1.tt>}
#' tumour} #' ...
#' } #' }
#' #'
#' @docType data #' @docType data
......
...@@ -4,16 +4,24 @@ ...@@ -4,16 +4,24 @@
#' #'
#' @description Create a gtable containing circle grobs representing a numeric matrix. #' @description Create a gtable containing circle grobs representing a numeric matrix.
#' @param dscale a 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 dcolor (optional) a matrix
#' @param rows (optional) a character vector #' @param rows (optional) a character vector
#' @param cols (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 theme list of theme parameters
#' @param vp optional viewport #' @param vp optional viewport
#' #'
#' @import gtable #' @import gtable
#' @importFrom gtable gtable_add_rows #' @importFrom gtable gtable_add_rows
#' #'
#' @seealso [theme_awesome()] #' @seealso [ttheme_awesome()]
#' #'
#' @return An R object of class \code{grob} #' @return An R object of class \code{grob}
#' #'
...@@ -58,7 +66,7 @@ table_extra_grob <- function(dscale, dcolor=NULL, ...@@ -58,7 +66,7 @@ table_extra_grob <- function(dscale, dcolor=NULL,
fg_params=theme$colmore$fg_params, fg_params=theme$colmore$fg_params,
bg_params=theme$colmore$bg_params, bg_params=theme$colmore$bg_params,
padding=theme$colmore$padding) 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, ...@@ -84,7 +92,7 @@ table_extra_grob <- function(dscale, dcolor=NULL,
fg_params=theme$rowhead$fg_params, fg_params=theme$rowhead$fg_params,
bg_params=theme$rowhead$bg_params, bg_params=theme$rowhead$bg_params,
padding=theme$rowhead$padding) 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)){ if(!is.null(rows_more)){
for (rows_m_name in names(rows_more)){ for (rows_m_name in names(rows_more)){
...@@ -102,7 +110,7 @@ table_extra_grob <- function(dscale, dcolor=NULL, ...@@ -102,7 +110,7 @@ table_extra_grob <- function(dscale, dcolor=NULL,
fg_params=theme$rowmore$fg_params, fg_params=theme$rowmore$fg_params,
bg_params=theme$rowmore$bg_params, bg_params=theme$rowmore$bg_params,
padding=theme$rowmore$padding) 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 ...@@ -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_palette a character vector of color names
#' @param color_breaks a numeric vector of break points #' @param color_breaks a numeric vector of break points
#' #'
#' @importFrom methods is
#'
#' @author Yoann Pradat #' @author Yoann Pradat
#' @keywords internal #' @keywords internal
table_params_circle_color <- function(d, color_palette, color_breaks=NULL){ 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){ ...@@ -61,7 +59,7 @@ table_params_circle_color <- function(d, color_palette, color_breaks=NULL){
if (is.null(color_breaks)){ if (is.null(color_breaks)){
color_breaks <- length(color_palette) color_breaks <- length(color_palette)
} }
if (is(color_breaks,"integer")){ if (length(color_breaks)==1){
if (color_breaks==1){ if (color_breaks==1){
d <- as.matrix(color_palette, nrow=nrow(d), ncol=ncol(d)) d <- as.matrix(color_palette, nrow=nrow(d), ncol=ncol(d))
} }
......
...@@ -3,25 +3,31 @@ ...@@ -3,25 +3,31 @@
\name{gtable_rbind} \name{gtable_rbind}
\alias{gtable_rbind} \alias{gtable_rbind}
\alias{gtable_cbind} \alias{gtable_cbind}
\title{rbind gtables} \title{rbind two or more gtables}
\usage{ \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{ \arguments{
\item{...}{gtables} \item{...}{gtables}
\item{size}{how should the widths be calculated? \item{size}{how should the widths be calculated?
\code{max} maximum of all widths \enumerate{
\code{min} minimum of all widths \item \code{max} maximum of all widths
\code{first} widths/heights of first gtable \item \code{min} minimum of all widths
\code{last} widths/heights of last gtable} \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{z}{optional z level}
\item{width}{padding width between grobs}
} }
\description{ \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 ...@@ -10,8 +10,8 @@ A data frame with 2780 rows and 68 variables
\item{Cancer.Types}{37 different cancer types} \item{Cancer.Types}{37 different cancer types}
\item{Sample.Names}{Unique tumour identifiers} \item{Sample.Names}{Unique tumour identifiers}
\item{Accuracy}{Cosine similarity between the tumour's mutational profile and the reconstructed mutational profile} \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 \item{SBS1}{Single-base-substitution signature 1. See \url{https://cancer.sanger.ac.uk/cosmic/signatures/SBS/SBS1.tt}}
tumour} ...
} }
} }
\source{ \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( ...@@ -24,10 +24,22 @@ table_extra_grob(
\item{dcolor}{(optional) a matrix} \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{rows}{(optional) a character vector}
\item{cols}{(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{theme}{list of theme parameters}
\item{vp}{optional viewport} \item{vp}{optional viewport}
...@@ -42,7 +54,7 @@ Create a gtable containing circle grobs representing a numeric matrix. ...@@ -42,7 +54,7 @@ Create a gtable containing circle grobs representing a numeric matrix.
library(tableExtra) library(tableExtra)
} }
\seealso{ \seealso{
\code{\link[=theme_awesome]{theme_awesome()}} \code{\link[=ttheme_awesome]{ttheme_awesome()}}
} }
\author{ \author{
Yoann Pradat Yoann Pradat
......
suppressMessages(library(SummarizedExperiment))
suppressMessages(library(dplyr)) suppressMessages(library(dplyr))
suppressMessages(library(tibble)) 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() theme <- ttheme_awesome()
d <- t(SummarizedExperiment::colData(DBS)$description) d <- t(DBS$colData$description)
g1 <- gtable_table(d, name="colhead-1", g1 <- gtable_table(d, name="colhead-1",
fg_fun = theme$colhead$fg_fun, fg_fun = theme$colhead$fg_fun,
...@@ -17,14 +17,17 @@ test_that("rbind_2 on text row works", { ...@@ -17,14 +17,17 @@ test_that("rbind_2 on text row works", {
padding=theme$colhead$padding) padding=theme$colhead$padding)
g <- rbind_2(g1, g2, "max", height=theme$core$padding[1]) 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) 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() theme <- ttheme_awesome()
d <- SummarizedExperiment::rowData(DBS)$name d <- DBS$rowData$name
d <- matrix(rep(d, 5), nrow=5, byrow=T) d <- matrix(rep(d, 5), nrow=5, byrow=T)
g1 <- gtable_table(d, name="rowhead-1", g1 <- gtable_table(d, name="rowhead-1",
...@@ -42,15 +45,19 @@ test_that("rbind_2 on text mat works", { ...@@ -42,15 +45,19 @@ test_that("rbind_2 on text mat works", {
padding=theme$rowhead$padding) padding=theme$rowhead$padding)
g <- rbind_2(g1, g2, size="first", height=theme$rowhead$padding[1]) 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) expect_true(out$plot_success)
}) })
test_that("cbind_2 on table circle works", { test_that("cbind_2 on table circle works", {
theme <- ttheme_awesome() theme <- ttheme_awesome()
d <- SummarizedExperiment::assays(DBS)$proportion d <- DBS$assays$proportion
widths <- rep(theme$core$size, ncol(d)) widths <- rep(theme$core$size, ncol(d))
heights <- rep(theme$core$size, nrow(d)) heights <- rep(theme$core$size, nrow(d))
...@@ -65,6 +72,7 @@ test_that("cbind_2 on table circle works", { ...@@ -65,6 +72,7 @@ test_that("cbind_2 on table circle works", {
scale_breaks=theme$core$scale_breaks, scale_breaks=theme$core$scale_breaks,
dscale_min=NULL, dscale_min=NULL,
dscale_max=NULL, dscale_max=NULL,
r_min=0.1*theme$core$size,
r_max=0.5*theme$core$size) r_max=0.5*theme$core$size)
g2 <- gtable_table(d, name="circle", g2 <- gtable_table(d, name="circle",
...@@ -78,17 +86,22 @@ test_that("cbind_2 on table circle works", { ...@@ -78,17 +86,22 @@ test_that("cbind_2 on table circle works", {
scale_breaks=theme$core$scale_breaks, scale_breaks=theme$core$scale_breaks,
dscale_min=NULL, dscale_min=NULL,
dscale_max=NULL, dscale_max=NULL,
r_min=0.1*theme$core$size,
r_max=0.5*theme$core$size) r_max=0.5*theme$core$size)
g <- cbind_2(g1, g2, "max", width=theme$core$padding[2]) 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) expect_true(out$plot_success)
}) })
test_that("rbind_2 on table text - circle works", { test_that("rbind_2 on table text - circle works", {
theme <- ttheme_awesome() theme <- ttheme_awesome()
d <- SummarizedExperiment::assays(DBS)$proportion d <- DBS$assays$proportion
col <- t(colnames(d)) col <- t(colnames(d))
g1 <- gtable_table(col, name="colhead-1", g1 <- gtable_table(col, name="colhead-1",
...@@ -111,10 +124,11 @@ test_that("rbind_2 on table text - circle works", { ...@@ -111,10 +124,11 @@ test_that("rbind_2 on table text - circle works", {
scale_breaks=theme$core$scale_breaks, scale_breaks=theme$core$scale_breaks,
dscale_min=NULL, dscale_min=NULL,
dscale_max=NULL, dscale_max=NULL,
r_min=0.1*theme$core$size,
r_max=0.5*theme$core$size) r_max=0.5*theme$core$size)
g <- rbind_2(g1, g2, size="last", height=theme$core$padding[1]) 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) expect_true(out$plot_success)
}) })