Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
MICS_Biomathematics
prettyplots
tableExtra
Commits
6324cdd6
Commit
6324cdd6
authored
Nov 08, 2020
by
Pradat Yoann
Browse files
succesfully make plot extra table cols more rows more
parent
b65662b8
Changes
31
Hide whitespace changes
Inline
Side-by-side
R/gtables.R
View file @
6324cdd6
...
...
@@ -33,9 +33,9 @@ gtable_table <- function(d, widths, heights,
nr
<-
nrow
(
d
)
n
<-
nc
*
nr
t
able
_params
<-
table_params
(
d
,
fg_params
,
bg_params
)
bg_params
<-
t
able
_params
[[
"bg_params"
]]
fg_params
<-
t
able
_params
[[
"fg_params"
]]
t
b
_params
<-
table_params
(
d
,
fg_params
,
bg_params
)
bg_params
<-
t
b
_params
[[
"bg_params"
]]
fg_params
<-
t
b
_params
[[
"fg_params"
]]
fg_params
<-
add_table_params
(
d
,
fg_params
,
fg_fun
,
...
)
frgds
<-
do.call
(
mapply
,
c
(
fg_params
,
list
(
FUN
=
fg_fun
,
SIMPLIFY
=
FALSE
)))
...
...
@@ -44,10 +44,19 @@ gtable_table <- function(d, widths, heights,
frgds_grobs
<-
matrix
(
frgds
,
ncol
=
nc
,
byrow
=
FALSE
)
bkgds_grobs
<-
matrix
(
bkgds
,
ncol
=
nc
,
byrow
=
FALSE
)
# print(unlist(bkgds[[1]]))
# # change default bg width/height
# bkgd_grob <- rect_grob(width=unit(12, "mm"), height=unit(4, "mm"))
# bkgd_grob <- rect_grob(width=unit(12, "mm"), height=unit(4, "mm"))
# bkgds_grobs <- matrix(lapply(1:nc, function(x) return(bkgd_grob)), ncol=nc)
# widths <- rep(unit(12, "mm"), ncol(bkgds_grobs))
# heights <- unit(4, "mm")
if
(
missing
(
widths
))
widths
<-
col_widths
(
frgds_grobs
)
+
padding
[
1
]
widths
<-
col_widths
(
frgds_grobs
)
if
(
missing
(
heights
))
heights
<-
row_heights
(
frgds_grobs
)
+
padding
[
2
]
heights
<-
row_heights
(
frgds_grobs
)
## make the gtable matrix of foreground
g
<-
gtable_matrix
(
paste0
(
name
,
"-fg"
),
...
...
@@ -68,511 +77,32 @@ gtable_table <- function(d, widths, heights,
g
}
# library(grid)
# library(gtable)
# suppressMessages(library(SummarizedExperiment))
# load("../tests/testthat/testdata/DBS.rda")
#
# theme <- ttheme_awesome(base_size=8)
# cols <- t(colnames(DBS))
#
# name="colhead"
# fg_fun = theme$colhead$fg_fun
# bg_fun = theme$colhead$bg_fun
# fg_params = theme$colhead$fg_params
# bg_params = theme$colhead$bg_params
# padding=theme$colhead$padding
#
# d <- cols
#
# nc <- ncol(d)
# nr <- nrow(d)
# n <- nc*nr
#
# table_params <- table_params(d, fg_params, bg_params)
# bg_params <- table_params[["bg_params"]]
# fg_params <- table_params[["fg_params"]]
# fg_params <- add_table_params(d, fg_params, fg_fun)
#
# frgds <- do.call(mapply, c(fg_params, list(FUN = fg_fun, SIMPLIFY=FALSE)))
# bkgds <- do.call(mapply, c(bg_params, list(FUN = bg_fun, SIMPLIFY=FALSE)))
#
# frgds_grobs <- matrix(frgds, ncol = nc, byrow = FALSE)
# bkgds_grobs <- matrix(bkgds, ncol = nc, byrow = FALSE)
#
# pdf("testplot.pdf", width=6, height=6)
#
# widths <- col_widths(frgds_grobs) + padding[1]
# heights <- row_heights(frgds_grobs) + padding[2]
# bkgd_grob <- rect_grob(width=unit(10, "mm"), height=unit(4, "mm"))
# bkgds_grobs <- gList(bkgd_grob,bkgd_grob,bkgd_grob,bkgd_grob,bkgd_grob,bkgd_grob,bkgd_grob,bkgd_grob)
# widths <- rep(bkgd_grob$width, ncol(bkgds_grobs))
# heights <- bkgd_grob$height
#
# ## make the gtable matrix of foreground
# g <- gtable_matrix(
paste0(name,
"-
f
g"
)
,
# grobs =
fr
gds_grobs,
# g <- gtable_matrix("-
b
g",
# grobs =
bk
gds_grobs,
# widths = widths,
# heights = heights, vp=vp)
#
# ## add the background
# g <- gtable_add_grob(g, bkgds_grobs,
# t=rep(seq_len(nr), length.out = n),
# l=rep(seq_len(nc), each = nr), z=0,
# name=paste0(name, "-bg"))
#
# # add padding
# g <- gtable::gtable_add_col_space(g, padding[1])
# g <- gtable::gtable_add_row_space(g, padding[2])
#
# grid.draw(g)
#
# dev.off()
#
# gc <- gtable_table(t(cols), name="colhead",
# fg_fun = theme$colhead$fg_fun,
# bg_fun = theme$colhead$bg_fun,
# fg_params = theme$colhead$fg_params,
# bg_params = theme$colhead$bg_params,
# padding=theme$colhead$padding)
#
# gr <- gtable_table(rowData(DBS)$name, name="colhead",
# fg_fun = theme$rowhead$fg_fun,
# bg_fun = theme$rowhead$bg_fun,
# fg_params = theme$rowhead$fg_params,
# bg_params = theme$rowhead$bg_params,
# padding=theme$rowhead$padding)
#
#
# d = t(cols)
# d <- rowData(DBS)$name
#
# nc <- ncol(d)
# nr <- nrow(d)
# n <- nc*nr
#
#
#
# table_params <- table_params(d, fg_params, bg_params)
# bg_params <- table_params[["bg_params"]]
# fg_params <- table_params[["fg_params"]]
# fg_params <- add_table_params(d, fg_params, fg_fun)
#
# frgds <- do.call(mapply, c(fg_params, list(FUN = fg_fun, SIMPLIFY=FALSE)))
# bkgds <- do.call(mapply, c(bg_params, list(FUN = bg_fun, SIMPLIFY=FALSE)))
#
# frgds_grobs <- matrix(frgds, ncol = nc, byrow = FALSE)
# bkgds_grobs <- matrix(bkgds, ncol = nc, byrow = FALSE)
#
# heights = heights)
#
# all.equal(fg_fun, text_grob)
# #' Build a table with text grobs.
# #'
# #' This function is a copy of the internal function \code{gtable_table} of gridExtra package.
# #'
# #' @param d data.frame or matrix
# #' @param width optional \code{unit.list} specifying the grob widths
# #' @param heights optional \code{unit.list} specifying the grob heights
# #' @param fg_fun grob-drawing function
# #' @param fg_params named list of params passed to fg_fun
# #' @param bg_fun grob-drawing function
# #' @param bg_params named list of params passed to bg_fun
# #' @param padding \code{unit.list} object specifying the padding between adjacent cells.
# #' @param name optional name of the grob
# #' @param vp optional viewport
# #' @return A gtable.
# #'
# #' @importFrom gtable gtable_matrix gtable_add_grob
# #'
# #' @author Yoann Pradat
# #' @keywords internal
# gtable_text <- function(d, widths, heights,
# fg_fun = text_grob, fg_params = list(),
# bg_fun = rect_grob, bg_params = list(),
# padding = unit(c(4, 4), "mm"),
# name = "table", vp = NULL){
#
# label_matrix <- as.matrix(d)
#
# nc <- ncol(label_matrix)
# nr <- nrow(label_matrix)
# n <- nc*nr
#
# ## formatting parameters will be recycled iff
# ## there are fewer elements than needed
# rep_ifshort <- function(x, n, nc, nr){
# if(length(x) >= n){
# return(x[1:n])
# } else # recycle
# return(rep(rep(x, length.out = nr), length.out= n))
# }
#
# fg_params <- lapply(fg_params, rep_ifshort, n = n, nc = nc, nr = nr)
# bg_params <- lapply(bg_params, rep_ifshort, n = n, nc = nc, nr = nr)
#
# fg_params <- data.frame(fg_params,
# label = as.vector(label_matrix), # colwise
# stringsAsFactors=FALSE)
#
# bg_params <- data.frame(bg_params, stringsAsFactors=FALSE)
#
# labels <- do.call(mapply, c(fg_params, list(FUN = fg_fun,
# SIMPLIFY=FALSE)))
# bkgds <- do.call(mapply, c(bg_params, list(FUN = bg_fun,
# SIMPLIFY=FALSE)))
#
# label_grobs <- matrix(labels, ncol = nc, byrow = FALSE)
# bkgds_grobs <- matrix(bkgds, ncol = nc, byrow = FALSE)
#
# if(missing(widths))
# widths <- col_widths(label_grobs) + padding[1]
# if(missing(heights))
# heights <- row_heights(label_grobs) + padding[2]
#
# ## place labels in a gtable
# g <- gtable_matrix(paste0(name, "-fg"),
# grobs = label_grobs,
# widths = widths,
# heights = heights, vp=vp)
#
# ## add the background
# g <- gtable_add_grob(g, bkgds_grobs,
# t=rep(seq_len(nr), length.out = n),
# l=rep(seq_len(nc), each = nr), z=0,
# name=paste0(name, "-bg"))
#
# # add padding
# g <- gtable::gtable_add_col_space(g, padding[1])
# g <- gtable::gtable_add_row_space(g, padding[2])
#
# g
# }
#
# #' Build a table with circle grobs.
# #'
# #' This function is a copy of the internal function \code{gtable_table} of gridExtra package.
# #'
# #' @param d data.frame or matrix
# #' @param width optional \code{unit.list} specifying the grob widths
# #' @param heights optional \code{unit.list} specifying the grob heights
# #' @param fg_fun grob-drawing function
# #' @param fg_params named list of params passed to fg_fun
# #' @param bg_fun grob-drawing function
# #' @param bg_params named list of params passed to bg_fun
# #' @param padding \code{unit.list} object specifying the padding between adjacent cells.
# #' @param name optional name of the grob
# #' @param vp optional viewport
# #' @return A gtable.
# #'
# #' @importFrom gtable gtable_matrix gtable_add_grob
# #'
# #' @author Yoann Pradat
# #' @keywords internal
# gtable_circle <- function(d, widths, heights,
# fg_fun = text_grob, fg_params = list(),
# bg_fun = rect_grob, bg_params = list(),
# core_size = unit(10, "mm"),
# padding = unit(c(1, 1), "mm"),
# name = "table", vp = NULL){
#
# d <- as.matrix(d)
# nc <- ncol(d)
# nr <- nrow(d)
# n <- nc*nr
#
# fg_fun <- rect_grob()
#
#
# theme <- ttheme_awesome()
# fg_params <- theme$core$fg_params
#
# fg_params <- list(r=do.call(unit.c, lapply(sizes, function(x) x*core_size)))
#
#
# fg_params <- lapply(fg_params, rep_ifshort, n = n, nc = nc, nr = nr)
# bg_params <- lapply(bg_params, rep_ifshort, n = n, nc = nc, nr = nr)
#
# fg_params <- data.frame(fg_params,
# r = do.call(unit.c, do.call(as.vector(d_matrix), # colwise
# stringsAsFactors=FALSE)
#
# bg_params <- data.frame(bg_params, stringsAsFactors=FALSE)
#
# labels <- do.call(mapply, c(fg_params, list(FUN = fg_fun,
# SIMPLIFY=FALSE)))
# bkgds <- do.call(mapply, c(bg_params, list(FUN = bg_fun,
# SIMPLIFY=FALSE)))
#
# label_grobs <- matrix(labels, ncol = nc, byrow = FALSE)
# bkgds_grobs <- matrix(bkgds, ncol = nc, byrow = FALSE)
# bkgd_grob <- rect_grob(width=unit(10, "mm"), height=unit(4, "mm"))
# bkgds_grobs <- matrix(lapply(1:12, function(x) return(bkgd_grob)), ncol=12)
# widths <- rep(bkgd_grob$width, ncol(bkgds_grobs))
# heights <- bkgd_grob$height
#
# # if(missing(widths))
# # #widths <- rep(max(col_widths(label_grobs)), nc) + padding[1]
# # widths <- rep(max(col_widths(label_grobs)), nc) + padding[1]
# # if(missing(heights))
# # #heights <- rep(max(row_heights(label_grobs)), nr) + padding[2]
# # heights <- rep(max(row_heights(label_grobs)), nr) + padding[2]
#
# widths <- rep(core_size, nc) - padding[1]
# heights <- rep(core_size, nr) - padding[2]
#
# ## place labels in a gtable
# g <- gtable_matrix(paste0(name, "-fg"),
# grobs = label_grobs,
# ## make the gtable matrix of foreground
# g <- gtable_matrix("-bg",
# grobs = bkgds_grobs,
# widths = widths,
# heights = heights, vp=vp)
#
#
# ## add the background
# g <- gtable_add_grob(g, bkgds_grobs,
# t=rep(seq_len(nr), length.out = n),
# l=rep(seq_len(nc), each = nr), z=0,
# name=paste0(name, "-bg"))
# ## add padding
# g <- gtable::gtable_add_col_space(g, padding[1])
# g <- gtable::gtable_add_row_space(g, padding[2])
#
# g
# }
# library(grid)
# library(gtable)
# load("../tests/testthat/testdata/DBS.rda")
#
#
# apply(d, 1:2, function(x) x * unit(1, "mm"))
#
# d <- SummarizedExperiment::assays(DBS)$proportion
# d <- norm_and_cat(d,ncat=theme$core$ncircle, vmax=0.5)
# col <- t(colnames(d))
#
# theme <- ttheme_awesome(base_size=8)
#
# pdf('testplot.pdf')
#
# g1 <- gtable_text(col, name="colhead-1",
# fg_fun = theme$colhead$fg_fun,
# bg_fun = theme$colhead$bg_fun,
# fg_params = theme$colhead$fg_params,
# bg_params = theme$colhead$bg_params,
# padding=theme$colhead$padding)
#
# g2 <- gtable_circle(d, name="circle",
# fg_fun = theme$core$fg_fun,
# bg_fun = theme$core$bg_fun,
# fg_params = theme$core$fg_params,
# bg_params = theme$core$bg_params,
# padding=theme$core$padding)
#
# g <- rbind(g1, g2, size="last")
#
# g2 <- gtable_add_cols(g2, pos=0, widths=unit(6, "cm"))
# g2 <- gtable_add_rows(g2, pos=0, heights=unit(8, "cm"))
# g2 <- gtable_add_rows(g2, pos=-1, heights=unit(8, "cm"))
# g2 <- gtable_add_cols(g2, pos=-1, widths=unit(6, "cm"))
# heights = heights)
#
#
grid.draw(g2
)
#
out <- plot_grob(g, name="gtable_text_row_unwanted_padding.pdf", width=8, height=1
)
#
# dev.off()
#
# col_widths <- function(m){
# do.call(grid::unit.c, apply(m, 2, function(l)
# max(do.call(grid::unit.c, lapply(l, grid::grobWidth)))))
# }
# library(gtable)
#
# load("../tests/testthat/testdata/DBS.rda")
#
# pdf("testplot.pdf")
#
# theme <- ttheme_awesome()
# d <- SummarizedExperiment::rowData(DBS)$name
# d <- matrix(rep(d, 5), nrow=5, byrow=T)
#
# g1 <- gtable_text(d, name="colhead-1",
# fg_fun = theme$colhead$fg_fun,
# bg_fun = theme$colhead$bg_fun,
# fg_params = theme$colhead$fg_params,
# bg_params = theme$colhead$bg_params,
# padding=theme$colhead$padding)
#
# g2 <- gtable_text(d, name="colhead-2",
# fg_fun = theme$colhead$fg_fun,
# bg_fun = theme$colhead$bg_fun,
# fg_params = theme$colhead$fg_params,
# bg_params = theme$colhead$bg_params,
# padding=theme$colhead$padding)
#
# g <- cbind(g1, g2, size="first")
#
# grid.draw(g)
#
# dev.off()
# pdf("testplot.pdf")
#
# library(grid)
# gt <- gtable(unit(1, "null"), unit(0.5, "null"))
# gt <- gtable_add_grob(gt, rectGrob(gp = gpar(fill = "black"), x=1, y=0.5), 1, 1)
#
# plot(gt)
# plot(cbind(gt, gt))
# plot(rbind(gt, gt))
#
# pad <- gtable_add_padding(gt, unit(1, "cm"))
# plot(pad)
# plot(cbind(pad, pad))
# plot(rbind(pad, pad))
#
# pad <- gtable_add_padding(pad, unit(-0.5, "cm"))
# plot(pad)
# plot(cbind(pad, pad))
# plot(rbind(pad, pad))
#
# dev.off()
#
# print("ok")
# load("../tests/testthat/testdata/DBS.rda")
# suppressMessages(library(SummarizedExperiment))
#
# d <- assays(DBS)$proportion
# theme <- ttheme_awesome()
#
# d <- norm_and_cat(d,ncat=theme$core$ncircle, vmax=0.5)
#
# ## map continuous values to [0,1]
# if (min(d) == max(d)){
# if (min(d) != 0){
# d_norm <- d/max(d)
# } else {
# d_norm <- d
# }
# } else {
# d_norm <- (d-min(d))/(max(d) - min(d))
# }
#
# ## bin into n_circle categories and map to [0,0.5]
# d_norm <- apply(d_norm, 1:2, function(x) round(x*theme$core$n_circle)/(2*theme$core$n_circle))
#
# cols <- colnames(d)
# rows <- rownames(d)
#
# g <- gtable_circle(d_norm, name="core",
# fg_fun = theme$core$fg_fun,
# bg_fun = theme$core$bg_fun,
# fg_params = theme$core$fg_params,
# bg_params = theme$core$bg_params,
# padding=theme$core$padding)
#
# if(!is.null(cols)){
# gc <- gtable_text(t(cols), name="colhead",
# fg_fun = theme$colhead$fg_fun,
# bg_fun = theme$colhead$bg_fun,
# fg_params = theme$colhead$fg_params,
# bg_params = theme$colhead$bg_params,
# padding=theme$colhead$padding)
# gc <- gtable_add_rows(gc, theme$rowhead$padding[1])
# g <- rbind_2(gc, g, "max")
#
#
# if(!is.null(rows)){
# if(!is.null(cols)) # need to add dummy cell
# rows <- c("", rows)
# gr <- gtable_text(rows, name="rowhead",
# fg_fun = theme$rowhead$fg_fun,
# bg_fun = theme$rowhead$bg_fun,
# fg_params = theme$rowhead$fg_params,
# bg_params = theme$rowhead$bg_params,
# padding=theme$rowhead$padding)
# g <- cbind_2(gr, g, "max")
# }
#
# colnames(g) <- paste0("c", seq_len(ncol(g)))
# rownames(g) <- paste0("r", seq_len(nrow(g)))
# load("../tests/testthat/testdata/DBS.rda")
# suppressMessages(library(SummarizedExperiment))
#
# d <- assays(DBS)$proportion
# d <- apply(d, 1:2, function(x) round(x*10)/20)
# theme <- ttheme_awesome()
# #
# # fg_fun = theme$core$fg_fun
# # bg_fun = theme$core$bg_fun
# # fg_params = theme$core$fg_params
# # bg_params = theme$core$bg_params
# # padding=theme$core$padding
#
#
# circle_small_plot <- function(nc=2, nr=2, padding=grid::unit(c(0.01,0.01), "npc")){
# row_heights <- function(m){
# do.call(grid::unit.c, apply(m, 1, function(l)
# max(do.call(grid::unit.c, lapply(l, grid::grobHeight)))))
# }
#
# col_widths <- function(m){
# do.call(grid::unit.c, apply(m, 2, function(l)
# max(do.call(grid::unit.c, lapply(l, grid::grobWidth)))))
# }
#
# fg_params <- data.frame(r=c(unit(0.5, "npc")), fill=c("#6767f8"), lwd=c(0), col=c("white"), stringsAsFactors=F)
# bg_params <- data.frame(fill=c("#f2f2f2"), lwd=0, col=c("white"), stringsAsFactors=F)
#
#
# fg_params <- fg_params[rep(seq_len(nrow(fg_params)), each = nc*nr), ]
# bg_params <- bg_params[rep(seq_len(nrow(bg_params)), each = nc*nr), ]
#
# labels <- do.call(mapply, c(fg_params, list(FUN = circle_grob,
# SIMPLIFY=FALSE)))
# bkgds <- do.call(mapply, c(bg_params, list(FUN = rect_grob,
# SIMPLIFY=FALSE)))
#
# label_grobs <- matrix(labels, ncol = nc, byrow = FALSE)
# bkgds_grobs <- matrix(bkgds, ncol = nc, byrow = FALSE)
#
# # widths <- rep(max(col_widths(label_grobs)), nc) + padding[1]
# # heights <- rep(max(row_heights(label_grobs)), nr) + padding[2]
#
# widths <- rep(unit(1/max(nc,nr), "npc"), nc) - padding[1]
# heights <- rep(unit(1/max(nc,nr), "npc"), nr) - padding[2]
#
# ## place labels in a gtable
# g <- gtable::gtable_matrix(paste0(name, "-fg"),
# grobs = label_grobs,
# widths = widths,
# heights = heights, vp=vp)
#
# ## add the background
# g <- gtable::gtable_add_grob(g, bkgds_grobs,
# t=rep(seq_len(nr), length.out = nr*nc),
# l=rep(seq_len(nc), each = nr), z=0,
# name=paste0(name, "-bg"))
# g <- gtable::gtable_add_col_space(g, padding[1])
# g <- gtable::gtable_add_row_space(g, padding[2])
#
# g
# }
#
# pdf(file="gtable_circle_small.pdf")
#
# g <- circle_small_plot(nc=3, nr=2, padding=unit(c(0.01,0.01), "npc"))
#
# grid.draw(g)
# dev.off()
#
#
# pdf(file="gtable_circle_small.pdf")
#
# g1 <- circle_small_plot(nc=2, nr=4)
# g2 <- circle_small_plot(nc=1, nr=4)
#
# g <- cbind_2(g1, g2, "max")
#
# grid.draw(g)
# dev.off()
# as.vector(SummarizedExperiment::rowData(DBS)$description)
R/other_utils.R
View file @
6324cdd6
...
...
@@ -8,12 +8,12 @@ rep_along <- function(x, y) {
row_heights
<-
function
(
m
){
do.call
(
grid
::
unit.c
,
apply
(
m
,
1
,
function
(
l
)
max
(
do.call
(
grid
::
unit.c
,
lapply
(
l
,
grid
::
grobHeight
)))))
1.1
*
max
(
do.call
(
grid
::
unit.c
,
lapply
(
l
,
grid
::
grobHeight
)))))
}
col_widths
<-
function
(
m
){
do.call
(
grid
::
unit.c
,
apply
(
m
,
2
,
function
(
l
)
max
(
do.call
(
grid
::
unit.c
,
lapply
(
l
,
grid
::
grobWidth
)))))
1.1
*
max
(
do.call
(
grid
::
unit.c
,
lapply
(
l
,
grid
::
grobWidth
)))))
}
scalecat
<-
function
(
m
,
n_cat
=
10
,
vmax
=
0.5
){
...
...
R/table_extra.R
View file @
6324cdd6
...
...
@@ -19,49 +19,86 @@
#' @examples
#' library(tableExtra)
extra_table_grob
<-
function
(
d
,
rows
=
rownames
(
d
),
cols
=
colnames
(
d
),
theme
=
ttheme_awesome
(),
vp
=
NULL
){
g
<-
gtable_table
(
d
,
name
=
"core"
,
fg_fun
=
theme
$
core
$
fg_fun
,
bg_fun
=
theme
$
core
$
bg_fun
,
fg_params
=
theme
$
core
$
fg_params
,
bg_params
=
theme
$
core
$
bg_params
,
padding
=
theme
$
core
$
padding
,
n_cat
=
theme
$
core
$
n_cat
,
r_max
=
theme
$
core
$
size
-
pmax
(
theme
$
core
$
padding
))
rows_more
=
NULL
,
cols_more
=
NULL
,
rows_more_title
=
""
,
cols_more_title
=
""
,
theme
=
ttheme_awesome
(),
vp
=
NULL
){
widths
<-
rep
(
theme
$
core
$
size
,
ncol
(
d
))
heights
<-
rep
(
theme
$
core
$
size
,
nrow
(
d
))
g
<-
gtable_table
(
d
,
name
=
"circle"
,
widths
=
widths
,
heights
=
heights
,
fg_fun
=
theme
$
core
$
fg_fun
,
bg_fun
=
theme
$
core
$
bg_fun
,
fg_params
=
theme
$
core
$
fg_params
,
bg_params
=
theme
$
core
$
bg_params
,
padding
=
theme
$
core
$
padding
,
r_max
=
0.5
*
theme
$
core
$
size
)
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
])
}
gc
<-
gtable_table
(
t
(
cols
),
name
=
"colhead"
,
fg_fun
=
theme
$
colhead
$
fg_fun
,
bg_fun
=
theme
$
colhead
$
bg_fun
,
fg_params
=
theme
$
colhead
$
fg_params
,
bg_params
=
theme
$
colhead
$
bg_params
,
fg_fun
=
theme
$
colhead
$
fg_fun
,
bg_fun
=
theme
$
colhead
$
bg_fun
,
fg_params
=
theme
$
colhead
$
fg_params
,
bg_params
=
theme
$
colhead
$
bg_params
,
padding
=
theme
$
colhead
$
padding
)
g
<-
rbind_2
(
gc
,
g
,
"max"
,
height
=
theme
$
row
head
$
padding
[
1
])
g
<-
rbind_2
(
gc
,
g
,
"max"
,
height
=
theme
$
col
head
$
padding
[
1
])