#' @title Convert a \code{data.frame} to a \code{list} #' #' @description Convert data to a format suitable for ApexCharts.js #' #' @param data A \code{data.frame} or an object coercible to \code{data.frame}. #' @param add_names Use names of columns in output. Can be logical to #' reuse \code{data} names or a character vector of new names. #' #' @return A \code{list} that can be used to specify data in \code{\link{ax_series}} for example. #' #' @export #' @importFrom stats setNames #' #' @examples #' #' # All iris dataset #' parse_df(iris) #' #' # Keep variables names #' parse_df(iris[, 1:2], add_names = TRUE) #' #' # Use custom names #' #' parse_df(iris[, 1:2], add_names = c("x", "y")) #' parse_df <- function(data, add_names = FALSE) { data <- as.data.frame(data) names_ <- names(data) l <- lapply( X = data[], FUN = function(x) { if (inherits(x, "Date")) { # js_date(x) as.numeric(x) * 1000 * 60*60*24 } else if (inherits(x, "POSIXt")) { # js_date(x) as.numeric(x) * 1000 } else if (inherits(x, "factor")) { as.character(x) } else { # if (!identical(add_names, FALSE)) { # formatNoSci(x) # } else { # x # } x } } ) ll <- lapply( X = seq_len(nrow(data)), FUN = function(i) { res <- lapply(l, `[[`, i) if (identical(add_names, FALSE)) { res <- unname(res) } if (is.character(add_names) & length(add_names) == length(names_)) { res <- setNames(res, nm = add_names) } return(res) } ) return(ll) } #' @importFrom htmlwidgets JS js_date <- function(x) { if (inherits(x, "POSIXt")) x <- format(x, format = "%Y-%m-%d %H:%M:%S") lapply(sprintf("new Date('%s').getTime()", x), JS) } parse_timeline_data <- function(.list) { if (is.null(.list$group)) { lapply( X = seq_len(length(.list[[1]])), FUN = function(i) { val <- lapply(.list, `[[`, i) l <- list( x = as.character(val$x), y = js_date(c(val$start, val$end)) ) if (!is.null(val$fill)) { l$fillColor <- val$fill } l } ) } else { grouped <- as.data.frame(.list, stringsAsFactors = FALSE) grouped$group <- NULL grouped <- split( x = grouped, f = .list$group ) grouped <- lapply(grouped, as.list) lapply( X = names(grouped), FUN = function(name) { list( name = name, data = parse_timeline_data(grouped[[name]]) ) } ) } } parse_dumbbell_data <- function(.list) { if (is.null(.list$group)) { lapply( X = seq_len(length(.list[[1]])), FUN = function(i) { val <- lapply(.list, `[[`, i) l <- list( x = as.character(val$y), y = list(val$x, val$xend) ) if (!is.null(val$fill)) { l$fillColor <- val$fill } l } ) } else { grouped <- as.data.frame(.list, stringsAsFactors = FALSE) grouped$group <- NULL grouped <- split( x = grouped, f = .list$group ) grouped <- lapply(grouped, as.list) lapply( X = names(grouped), FUN = function(name) { list( name = name, data = parse_dumbbell_data(grouped[[name]]) ) } ) } } parse_candlestick_data <- function(.list) { list(list( type = "candlestick", data = lapply( X = seq_len(length(.list[[1]])), FUN = function(i) { val <- lapply(.list, `[[`, i) list( # x = js_date(val$x)[[1]], x = as.numeric(val$x) * 1000, y = c(val$open, val$high, val$low, val$close) ) } ) )) } #' @importFrom graphics boxplot parse_boxplot_data <- function(.list, serie_name = NULL) { if (!is.numeric(.list$y) & is.numeric(.list$x)) { .list[c("x", "y")] <- .list[c("y", "x")] } boxed <- boxplot(y ~ x, data = .list, plot = FALSE) list(dropNulls(list( serie_name = serie_name, type = "boxPlot", data = lapply( X = seq_along(boxed$names), FUN = function(i) { list( x = boxed$names[i], y = c( boxed$stats[1, i], boxed$stats[2, i], boxed$stats[3, i], boxed$stats[4, i], boxed$stats[5, i] ) ) } ) ))) }