Robot
/
apexcharter
mirror of https://github.com/dreamRs/apexcharter.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

updated build_grid method

This commit is contained in:
pvictor 2021-01-07 20:17:06 +01:00
parent 2d9b9ff631
commit f91a6c69c6
2 changed files with 58 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
R/facets.R
View File

@ -10,7 +10,7 @@ get_facets <- function(data, rows, cols, type = c("wrap", "grid")) {
FUN = function(i) { FUN = function(i) {
facet <- facets[[i]] facet <- facets[[i]]
attr(facet, "keys") <- strsplit( attr(facet, "keys") <- strsplit(
x = names(facets)[i], x = names(facets)[i],
split = "|__|", fixed = TRUE split = "|__|", fixed = TRUE
)[[1]] )[[1]]
facet facet
@ -51,7 +51,7 @@ set_scale <- function(ax, values, scales = c("fixed", "free", "free_y", "free_x"
} else { } else {
range_vals <- NULL range_vals <- NULL
} }
fmt <- function(x, time = inherits(values, c("Date", "POSIXt"))) { fmt <- function(x, time = inherits(values, c("Date", "POSIXt"))) {
if (is.null(x)) if (is.null(x))
return(NULL) return(NULL)
@ -65,7 +65,7 @@ set_scale <- function(ax, values, scales = c("fixed", "free", "free_y", "free_x"
"x" = "xaxis", "x" = "xaxis",
"y" = "yaxis" "y" = "yaxis"
) )
if (scales == "fixed") { if (scales == "fixed") {
ax$x$ax_opts[[waxis]]$min <- ax$x$ax_opts[[waxis]]$min %||% fmt(range_vals[1]) ax$x$ax_opts[[waxis]]$min <- ax$x$ax_opts[[waxis]]$min %||% fmt(range_vals[1])
ax$x$ax_opts[[waxis]]$max <- ax$x$ax_opts[[waxis]]$max %||% fmt(range_vals[2]) ax$x$ax_opts[[waxis]]$max <- ax$x$ax_opts[[waxis]]$max %||% fmt(range_vals[2])
@ -89,7 +89,7 @@ set_scale <- function(ax, values, scales = c("fixed", "free", "free_y", "free_x"
ax$x$ax_opts[[waxis]]$max <- NULL ax$x$ax_opts[[waxis]]$max <- NULL
} }
} }
return(ax) return(ax)
} }
@ -99,8 +99,8 @@ build_facets <- function(chart) {
mapall <- lapply(chart$x$mapping, eval_tidy, data = data) mapall <- lapply(chart$x$mapping, eval_tidy, data = data)
labeller <- chart$x$facet$labeller labeller <- chart$x$facet$labeller
facets_list <- get_facets( facets_list <- get_facets(
data = data, data = data,
rows = chart$x$facet$facets_row, rows = chart$x$facet$facets_row,
cols = chart$x$facet$facets_col, cols = chart$x$facet$facets_col,
type = chart$x$facet$type type = chart$x$facet$type
) )
@ -113,9 +113,9 @@ build_facets <- function(chart) {
data = c( data = c(
nums, nums,
rep(NA, times = (dims$nrow * dims$ncol) - length(nums)) rep(NA, times = (dims$nrow * dims$ncol) - length(nums))
), ),
nrow = dims$nrow, nrow = dims$nrow,
ncol = dims$ncol, ncol = dims$ncol,
byrow = TRUE byrow = TRUE
) )
lrow <- get_last_row(grid) lrow <- get_last_row(grid)
@ -160,7 +160,7 @@ build_facets <- function(chart) {
list( list(
facets = facets, facets = facets,
type = chart$x$facet$type, type = chart$x$facet$type,
nrow = facets_list$nrow, nrow = facets_list$nrow,
ncol = facets_list$ncol, ncol = facets_list$ncol,
label_row = facets_list$label_row, label_row = facets_list$label_row,
label_col = facets_list$label_col label_col = facets_list$label_col
@ -189,14 +189,14 @@ get_last_row <- function(mat) {
#' #'
#' @return An \code{apexcharts} \code{htmlwidget} object. #' @return An \code{apexcharts} \code{htmlwidget} object.
#' @export #' @export
#' #'
#' @name apex-facets #' @name apex-facets
#' #'
#' @importFrom rlang quos syms #' @importFrom rlang quos syms
#' #'
#' @example examples/facet_wrap.R #' @example examples/facet_wrap.R
ax_facet_wrap <- function(ax, ax_facet_wrap <- function(ax,
facets, facets,
nrow = NULL, nrow = NULL,
ncol = NULL, ncol = NULL,
scales = c("fixed", "free", "free_y", "free_x"), scales = c("fixed", "free", "free_y", "free_x"),
@ -221,13 +221,13 @@ ax_facet_wrap <- function(ax,
} }
#' @param rows,cols A set of variables or expressions quoted by vars() and defining faceting groups on the rows or columns dimension. #' @param rows,cols A set of variables or expressions quoted by vars() and defining faceting groups on the rows or columns dimension.
#' @export #' @export
#' #'
#' @rdname apex-facets #' @rdname apex-facets
#' #'
#' @example examples/facet_grid.R #' @example examples/facet_grid.R
ax_facet_grid <- function(ax, ax_facet_grid <- function(ax,
rows = NULL, rows = NULL,
cols = NULL, cols = NULL,
scales = c("fixed", "free", "free_y", "free_x"), scales = c("fixed", "free", "free_y", "free_x"),
@ -269,9 +269,9 @@ build_facet_tag <- function(x) {
if (!is.null(facets$nrow)) { if (!is.null(facets$nrow)) {
for (i in seq_along(facets$label_row)) { for (i in seq_along(facets$label_row)) {
content <- append( content <- append(
x = content, x = content,
values = tagList(tags$div( values = tagList(tags$div(
class = "apexcharter-facet-row-label", class = "apexcharter-facet-row-label",
x$x$facet$labeller(facets$label_row[i]) x$x$facet$labeller(facets$label_row[i])
)), )),
after = ((facets$ncol %||% 1 + 1) * i) - 1 after = ((facets$ncol %||% 1 + 1) * i) - 1
@ -281,7 +281,7 @@ build_facet_tag <- function(x) {
if (!is.null(facets$ncol)) { if (!is.null(facets$ncol)) {
content <- tagList( content <- tagList(
lapply( lapply(
X = facets$label_col, X = facets$label_col,
FUN = function(label_col) { FUN = function(label_col) {
tags$div(x$x$facet$labeller(label_col), class = "apexcharter-facet-col-label") tags$div(x$x$facet$labeller(label_col), class = "apexcharter-facet-col-label")
} }
@ -291,12 +291,12 @@ build_facet_tag <- function(x) {
) )
} }
TAG <- build_grid( TAG <- build_grid(
content, content,
nrow = facets$nrow %||% 1, nrow = facets$nrow %||% 1,
ncol = facets$ncol %||% 1, ncol = facets$ncol %||% 1,
row_label = if (!is.null(facets$ncol)) "30px" else NULL, row_before = if (!is.null(facets$ncol)) "30px",
col_label = if (!is.null(facets$nrow)) "30px" else NULL, col_after = if (!is.null(facets$nrow)) "30px",
row_gap = "3px", row_gap = "3px",
col_gap = "3px" col_gap = "3px"
) )
} else { } else {
@ -320,9 +320,9 @@ build_facet_tag <- function(x) {
#' #'
#' @return An Apexcharts output that can be included in the application UI. #' @return An Apexcharts output that can be included in the application UI.
#' @export #' @export
#' #'
#' @name apexcharter-shiny-facets #' @name apexcharter-shiny-facets
#' #'
#' @importFrom htmltools tagList #' @importFrom htmltools tagList
#' @importFrom shiny uiOutput #' @importFrom shiny uiOutput
#' @importFrom htmlwidgets getDependency #' @importFrom htmlwidgets getDependency
@ -339,11 +339,11 @@ apexfacetOutput <- function(outputId) {
#' @param env The environment in which to evaluate \code{expr}. #' @param env The environment in which to evaluate \code{expr}.
#' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This #' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
#' is useful if you want to save an expression in a variable. #' is useful if you want to save an expression in a variable.
#' #'
#' @export #' @export
#' #'
#' @rdname apexcharter-shiny-facets #' @rdname apexcharter-shiny-facets
#' #'
#' @importFrom shiny exprToFunction createRenderFunction createWebDependency #' @importFrom shiny exprToFunction createRenderFunction createWebDependency
#' @importFrom htmltools renderTags resolveDependencies #' @importFrom htmltools renderTags resolveDependencies
renderApexfacet <- function(expr, env = parent.frame(), quoted = FALSE) { # nocov start renderApexfacet <- function(expr, env = parent.frame(), quoted = FALSE) { # nocov start
@ -411,7 +411,7 @@ complete_mapdata <- function(mapdata, mapall) {
complete_data <- function(data, vars, fill_var, fill_value = 0) { complete_data <- function(data, vars, fill_var, fill_value = 0) {
full_data <- expand.grid(lapply( full_data <- expand.grid(lapply(
X = data[, vars], X = data[, vars],
FUN = unique FUN = unique
)) ))
full_data <- merge( full_data <- merge(

70
R/grid.R
View File

@ -12,7 +12,7 @@ get_grid_dims <- function(content, nrow = NULL, ncol = NULL) {
} else { } else {
ncol <- 2 ncol <- 2
nrow <- ceiling(n / ncol) nrow <- ceiling(n / ncol)
} }
} }
list(nrow = nrow, ncol = ncol) list(nrow = nrow, ncol = ncol)
} }
@ -22,40 +22,22 @@ get_grid_dims <- function(content, nrow = NULL, ncol = NULL) {
build_grid <- function(content, build_grid <- function(content,
nrow = NULL, nrow = NULL,
ncol = NULL, ncol = NULL,
row_gap = "5px", row_gap = "5px",
col_gap = "0px", col_gap = "0px",
row_label = NULL, row_before = NULL,
col_label = NULL, row_after = NULL,
col_before = NULL,
col_after = NULL,
height = NULL, height = NULL,
width = NULL) { width = NULL) {
d <- get_grid_dims(content, nrow, ncol) d <- get_grid_dims(content, nrow, ncol)
if (is.null(col_label)) { col_style <- paste("grid-template-columns:", col_before, sprintf("repeat(%s, 1fr)", d$ncol), col_after, ";")
col_style <- sprintf( row_style <- paste("grid-template-rows:", row_before, sprintf("repeat(%s, 1fr)", d$nrow), row_after, ";")
"-ms-grid-columns: repeat(%1$s, 1fr); grid-template-columns: repeat(%1$s, 1fr);",
d$ncol
)
} else {
col_style <- sprintf(
"-ms-grid-columns: repeat(%1$s, 1fr) %2$s; grid-template-columns: repeat(%1$s, 1fr) %2$s;",
d$ncol, col_label
)
}
if (is.null(row_label)) {
row_style <- sprintf(
"-ms-grid-rows: repeat(%1$s, 1fr); grid-template-rows: repeat(%1$s, 1fr);",
d$nrow
)
} else {
row_style <- sprintf(
"-ms-grid-rows: %2$s repeat(%1$s, 1fr); grid-template-rows: %2$s repeat(%1$s, 1fr);",
d$nrow, row_label
)
}
tags$div( tags$div(
class = "apexcharter-grid-container", class = "apexcharter-grid-container",
style = if (!is.null(height)) paste0("height:", height, ";"), style = if (!is.null(height)) paste0("height:", height, ";"),
style = if (!is.null(width)) paste0("width:", width, ";"), style = if (!is.null(width)) paste0("width:", width, ";"),
style = "display:-ms-grid; display: grid;", style = "display: grid;",
style = col_style, style = col_style,
style = row_style, style = row_style,
style = sprintf("grid-column-gap: %s;", col_gap), style = sprintf("grid-column-gap: %s;", col_gap),
@ -67,27 +49,27 @@ build_grid <- function(content,
#' Create a grid of ApexCharts #' Create a grid of ApexCharts
#' #'
#' @param ... Several \code{apexcharts} \code{htmlwidget} objects. #' @param ... Several \code{apexcharts} \code{htmlwidget} objects.
#' @param nrow,ncol Number of rows and columns. #' @param nrow,ncol Number of rows and columns.
#' @param row_gap,col_gap Gap between rows and columns. #' @param row_gap,col_gap Gap between rows and columns.
#' @param grid_area Custom grid area to make elements take more than a single #' @param grid_area Custom grid area to make elements take more than a single
#' cell in grid, see \url{https://cssgrid-generator.netlify.app/} for examples. #' cell in grid, see \url{https://cssgrid-generator.netlify.app/} for examples.
#' @param height,width Height and width of the main grid. #' @param height,width Height and width of the main grid.
#' @param .list A list of \code{apexcharts} \code{htmlwidget} objects. #' @param .list A list of \code{apexcharts} \code{htmlwidget} objects.
#' #'
#' @return Custom \code{apex_grid} object. #' @return Custom \code{apex_grid} object.
#' #'
#' @note You have to provide either height for the grid or individual chart height to make it work. #' @note You have to provide either height for the grid or individual chart height to make it work.
#' #'
#' @export #' @export
#' #'
#' @importFrom htmltools tags #' @importFrom htmltools tags
#' #'
#' @example examples/apex_grid.R #' @example examples/apex_grid.R
apex_grid <- function(..., apex_grid <- function(...,
nrow = NULL, nrow = NULL,
ncol = NULL, ncol = NULL,
row_gap = "10px", row_gap = "10px",
col_gap = "0px", col_gap = "0px",
grid_area = NULL, grid_area = NULL,
@ -134,9 +116,9 @@ apex_grid <- function(...,
#' #'
#' @return An Apexcharts output that can be included in the application UI. #' @return An Apexcharts output that can be included in the application UI.
#' @export #' @export
#' #'
#' @name apexcharter-shiny-grid #' @name apexcharter-shiny-grid
#' #'
#' @importFrom htmltools tagList #' @importFrom htmltools tagList
#' @importFrom shiny uiOutput #' @importFrom shiny uiOutput
#' @importFrom htmlwidgets getDependency #' @importFrom htmlwidgets getDependency
@ -153,11 +135,11 @@ apexgridOutput <- function(outputId) {
#' @param env The environment in which to evaluate \code{expr}. #' @param env The environment in which to evaluate \code{expr}.
#' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This #' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
#' is useful if you want to save an expression in a variable. #' is useful if you want to save an expression in a variable.
#' #'
#' @export #' @export
#' #'
#' @rdname apexcharter-shiny-grid #' @rdname apexcharter-shiny-grid
#' #'
#' @importFrom shiny exprToFunction createRenderFunction createWebDependency #' @importFrom shiny exprToFunction createRenderFunction createWebDependency
#' @importFrom htmltools renderTags resolveDependencies #' @importFrom htmltools renderTags resolveDependencies
renderApexgrid <- function(expr, env = parent.frame(), quoted = FALSE) { # nocov start renderApexgrid <- function(expr, env = parent.frame(), quoted = FALSE) { # nocov start
@ -176,7 +158,7 @@ renderApexgrid <- function(expr, env = parent.frame(), quoted = FALSE) { # nocov
TAG <- build_grid( TAG <- build_grid(
result$content, result$content,
nrow = result$nrow, nrow = result$nrow,
ncol = result$ncol, ncol = result$ncol,
col_gap = result$col_gap, col_gap = result$col_gap,
row_gap = result$row_gap, row_gap = result$row_gap,
height = result$height, height = result$height,
@ -206,7 +188,7 @@ print.apex_grid <- function(x, ...) {
TAG <- build_grid( TAG <- build_grid(
x$content, x$content,
nrow = x$nrow, nrow = x$nrow,
ncol = x$ncol, ncol = x$ncol,
col_gap = x$col_gap, col_gap = x$col_gap,
row_gap = x$row_gap, row_gap = x$row_gap,
height = x$height, height = x$height,
@ -219,7 +201,7 @@ knit_print.apex_grid <- function(x, ..., options = NULL) {
TAG <- build_grid( TAG <- build_grid(
x$content, x$content,
nrow = x$nrow, nrow = x$nrow,
ncol = x$ncol, ncol = x$ncol,
col_gap = x$col_gap, col_gap = x$col_gap,
row_gap = x$row_gap, row_gap = x$row_gap,
height = x$height, height = x$height,