R/coordsys.R
In madlogos/recharts2: An R Interface to ECharts3
Defines functions
setAxis
autoFacetTitle
autoAxis
setYAxis
setY1Axis
setXAxis
setX1Axis
setY2Axis
axisType
flipAxis
setGrid
relocTitle
relocLegend
relocDataZoom
relocDataRange
relocTimeline
relocToolbox
relocWidget
.getGridParam
tuneGrid
autoPolar
setPolar
Documented in
relocDataRange
relocDataZoom
relocLegend
relocTimeline
relocTitle
relocToolbox
relocWidget
setAxis
setGrid
setPolar
setX1Axis
setXAxis
setY1Axis
setY2Axis
setYAxis
#' Set \code{x|yAxis} of Echarts (Primary or Secondary)
#'
#' When an echart object is generated, you can modify it by setting axis using
#' \code{\link{\%>\%}}. \cr \cr
#' You can use work functions \code{setXAxis}, \code{setYAxis}, \code{setX1Axis},
#' \code{setY1Axis}. \cr \cr
#' This function modified a few default options for the axis component in
#' ECharts:
#' \enumerate{
#' \item \code{scale = TRUE} (was \code{FALSE} by default in ECharts);
#' \item \code{axisLine$onZero = FALSE} (was \code{TRUE} in ECharts).
#' }
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}}
#' @param series Which series to be put on this axis. Could be:
#' \itemize{
#' \item series names, in vectors. E.g, \code{c('setosa', 'virginica')};
#' \item index of series, in vectors. E.g., \code{1:2} or \code{c(1,3)}.
#' }
#' @param which Which axis to be modified. Could be one of the following:
#' \describe{
#' \item{x}{primary x axis}
#' \item{y}{primary y axis}
#' \item{x1}{secondary x axis}
#' \item{y1}{secondary y axis}
#' }
#' @param type Type of the axis. Could be \code{c('time', 'value', 'category', 'log')}.
#' Default 'value'.
#' @param position Position of this axis. Could be \code{c('bottom', 'top', 'left',
#' 'right')} (default for primary x axis, secondary x axis, primary y axis and secondary
#' y axis, respectively.)
#' @param boundaryGap A two-element numeric vector, defining the policy of the space
#' at the two ends of the axis (percents). Deafult \code{c(0, 0)}.
#' @param min The mininum value of the axis. Default NULL (automatic). If a numeric
#' value is set, \code{boundaryGap} is disabled.
#' @param max The maxinum value of the axis. Default NULL (automatic). If a numeric
#' value is set, \code{boundaryGap} is disabled.
#' @param scale Logical, for axis of 'value', 'time', 'log' type, to define whether
#' zoom the scale to the range between _min and _max. Default TRUE.
#' @param splitNumber Numeric, how many sections to devide the axis. Default NULL,
#' automatically deviding based on algorithms of \code{min} and \code{max}.
#' @param axisLine A list. Default: \cr
#' \code{list(show=TRUE, onZero=FALSE, lineStyle=list( \cr
#' type='solid', color='#48b', width=2, shadowColor='rgba(0,0,0,0)', shadowBlur=5,
#' shadowOffsetX=3, shadowOffsetY=3))} \cr \cr
#' \code{lineStyle} accepts features \code{color, width, type, shadowColor, shadowBlur,
#' shadowOffsetX, shadowOffsetY}
#' @param axisTick A list. Default: \cr
#' \code{show=FALSE, inside=FALSE, length=5, lineStyle=list(color="#333", width=1)} \cr \cr
#' \code{lineStyle} accepts feature \code{color, width, type, shadowColor, shadowBlur,
#' shadowOffsetX, shadowOffsetY}
#' @param axisLabel A list controlling the axis labels. Default \code{show=TRUE,
#' rotate=0, margin=8, clickable=FALSE, formatter=NULL, textStyle=list(color="#333")} \cr \cr
#' \code{textStyle} accepts features \code{color, align, baseline, fontFamily, fontSize,
#' fontStyle, fontWeight}. \cr \cr
#' \strong{\code{formatter}}:
#' \describe{
#' \item{sprintf/format string}{String to overide \code{axisLable$formatter}.
#' It accepts \code{sprintf} (category and value) and \code{strptime} (time) formats.}
#' \item{js mode}{a JS function/expression, which is default}
#' } \cr
#' \code{axisLabel=list(formatter="\%s cm")} is equal to \cr
#' \code{axisLabel=list(formatter=JS('function (value) {return value + "cm";}'))} or \cr
#' \code{axisLabel=list(formatter='{value} cm')}
#' @param splitLine A list controlling the split lines. Default \code{show=TRUE,
#' lineStyle=list(color=list("#ccc"), width=1, type="solid")} \cr \cr
#' \code{lineStyle} accepts features \code{color, width, type, shadowColor, shadowBlur,
#' shadowOffsetX, shadowOffsetY}.
#' @param splitArea A list controlling the split areas. Default \code{show=FALSE,
#' onGap=NULL, areaStyle= list(color= list("rgba(250,250,250,0.3)", "rgba(200,200,200,0.3)")
#' , type="default"} \cr \cr
#' \code{areaStyle} accepts features \code{color, type}.
#' @param data A character vector/list for axis of type 'category', to define the text
#' labels shown in this axis. Default NULL. You can even pass in a complicated list with
#' \code{textSytle} list: \cr
#' \code{list('Jan', 'Feb', 'Mar', \cr list(value='Apr', textStyle=list(color='red', ...)),
#' \cr 'May', ...)}
#' @param grid
#' @param offset
#' @param inverse
#' @param interval
#' @param logBase
#' @param silent
#' @param triggerEvent
#' @param zlevel
#' @param z
#' @param mode
#'
#' @export
#' @seealso \code{\link{setXAxis}}, \code{\link{setYAxis}}, \code{\link{setX1Axis}},
#' \code{\link{setY1Axis}}
#' @references
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#tooltip-line1~xAxis-i}
#'
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#tooltip-line1~yAxis-i}
#' @examples
#' \dontrun{
#' g = echart(iris, Sepal.Width, Petal.Width, series=Species)
#'
#' # Change the style
#' g %>% setTheme('gray') %>% setXAxis(splitLine=list(show=FALSE)) %>%
#' setYAxis(axisLine=list(lineStyle=list(width=0)))
#'
#' # Dual-yAxis, series 1,2 on primary y-axis, series 3 on secondary y-axis
#' g %>% setYAxis(1:2, name="setosa/versicolor") %>%
#' setY1Axis("virginica", name="virginica")
#' }
setAxis = function(
chart, series = NULL, grid = NULL, which = c('x', 'y', 'x1', 'y1', 'y2'),
type = c('value', 'category', 'time', 'log'), offset = 0, show = TRUE,
position = c('bottom', 'top', 'left', 'right'), inverse = FALSE,
name = '', nameLocation = c('end', 'middle', 'start'), onZero = FALSE,
nameTextStyle = emptyList(), nameGap = 15, nameRotate = NULL,
boundaryGap = c(0, 0), min = NULL, max = NULL, scale = TRUE, splitNumber = NULL,
interval = NULL, logBase = 10, silent = FALSE, triggerEvent = FALSE,
axisLine = list(show = TRUE, onZero = onZero), axisTick = list(show = FALSE),
axisLabel = list(show = TRUE), splitLine = list(show = TRUE),
splitArea = list(show = FALSE), data = list(), zlevel = 0, z = 0
) {
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
layout = getLayout(chart)
layout = layout[layout$coordSys == 'cartesian2d',]
which = match.arg(which)
whichAx = substr(which, 0, 1) # x or y axis
hasT = "timeline" %in% names(chart$x)
if (!is.numeric(grid)) grid = NULL
# get intersect of the series (char)
allSeries = getSeriesPart(chart, 'category', drop=FALSE, fetch.all=TRUE) # all levels of series
if (!hasT) allSeries = as.matrix(allSeries, ncol=1)
uniSeries = unique(as.vector(allSeries))
if (!is.null(allSeries) && !is.null(series)){
if (is.numeric(series)){
series = intersect(series, seq_len(nrow(allSeries)))
series = if (length(series) > 0) allSeries[series,1] else NULL
}else{
series = intersect(as.character(series), unique(as.vector(allSeries)))
if (length(series) == 0) series = NULL
}
if (length(series) == 0) return(chart)
}else{
series = unique(layout$series)
}
# get intersect of gridIndex (num)
if (is.numeric(grid)){
grid = intersect(grid-1, layout$coordIdx)
if (length(grid) == 0) return(chart)
}else{
grid = unique(layout$coordIdx)
}
# modify df layout, chart already has 2*facet axes lists by autoAxis()
targetAxRows = which(layout$series %in% series & layout$coordIdx %in% grid)
if (which == 'x1'){
layout$xAxisIdx[targetAxRows] = layout$xAxisIdx[targetAxRows] +
length(seq_along(unique(layout$xAxisIdx)))
}
if (which == 'y1'){
layout$yAxisIdx[targetAxRows] = layout$yAxisIdx[targetAxRows] +
length(seq_along(unique(layout$yAxisIdx)))
}
if (which == 'y2'){
targetAx = unique(grid) + length(seq_along(unique(layout$coordIdx)))
layout$yAxisIdx[targetAxRows] = seq_along(targetAx) -1 +
2*length(seq_along(unique(layout$yAxisIdx)))
}
# original data along the axis
if (hasT){
odata = lapply(chart$x$options, getMeta)
if (!is.null(series)) {
sdata = lapply(odata, function(lst) lst['series'])
sdata = do.call('rbind', sdata)[,1]
}
odata = lapply(odata, function(lst) lst[[which]])
odata = do.call('rbind', odata)[,1]
}else{
odata = getMeta(chart)[[which]][,1]
if (!is.null(series)) sdata = getMeta(chart)[['series']][,1]
}
if (!is.null(series)) {
odata = odata[sdata %in% series]
}
# only get odata of specific series
if (missing(type)) type = axisType(odata, which)
if (missing(position)) {
position = switch(which, x = 'bottom', y = 'left', x1 = 'top',
y1 = 'right', y2 = 'right')
}else{
position = match.arg(position)
}
if (!is.null(axisLabel$formatter))
if (!is.list(axisLabel$formatter)){
axisLabel = mergeList(axisLabel, list(
formatter = if (inherits(axisLabel$formatter, 'JS_EVAL'))
axisLabel$formatter else convFormat2JS(axisLabel$formatter, type)
)
)
}
if (hasT) x = chart$x$baseOption else x = chart$x
i = paste0(whichAx, 'Axis')
o = list(
type = match.arg(type), show = show, position = position,
inverse = inverse, name = name, nameLocation = match.arg(nameLocation),
nameTextStyle = nameTextStyle, nameGap = nameGap, nameRotate = nameRotate,
boundaryGap = boundaryGap, min = min, max = max, scale = scale,
offset = offset, splitNumber = splitNumber, interval = interval,
logBase = logBase, triggerEvent = triggerEvent, silent = silent,
axisLine = axisLine, axisTick = axisTick, axisLabel = axisLabel,
splitLine = splitLine, splitArea = splitArea, data = data
)
if (length(x[[i]]) == 0) chart = autoAxis(chart)
# only merge the arguments that are not missing, e.g. eAxis(min = 0) will
# only overide 'min' but will not overide the 'name' attribute
a = intersect(c('position', 'axisLine', 'scale', 'show',
names(as.list(match.call()[-1]))), names(o))
if (which %in% c('x', 'x1')){
for (j in unique(layout[targetAxRows, 'xAxisIdx']))
x[[i]][[j+1]] = mergeList(x[[i]][[j+1]], o[a])
}else if (which %in% c('y', 'y1')){
for (j in unique(layout[targetAxRows, 'yAxisIdx']))
x[[i]][[j+1]] = mergeList(x[[i]][[j+1]], o[a])
}else if (which %in% 'y2'){
for (j in unique(layout[targetAxRows, 'yAxisIdx']))
x[[i]][j+1] = list(o[a])
}
if (hasT) chart$x$baseOption = x else chart$x = x
# revise axisIndex
ax = paste0(whichAx, "AxisIndex")
if (hasT){
for (i in targetAxRows)
chart$x$baseOption$series[[i]][c('xAxisIndex', 'yAxisIndex')] =
list(layout$xAxisIdx[i], layout$yAxisIdx[i])
}else{
for (i in targetAxRows)
chart$x$series[[i]][c('xAxisIndex', 'yAxisIndex')] =
list(layout$xAxisIdx[i], layout$yAxisIdx[i])
}
return(chart)
}
autoFacetTitle = function(chart){
stopifnot(inherits(chart, 'echarts'))
layout = getLayout(chart)
meta = getMeta(chart)
facet.name = if ('facet' %in% meta) names(meta$facet) else
names(meta[[1]]$facet)
hasT = 'baseOption' %in% names(chart$x)
if (max(layout$ifacet) == 1) return(chart)
f.layout = layout[!duplicated(layout$ifacet),]
f.text = paste0(facet.name[1], ': ', f.layout$row)
if (!all(is.na(f.layout$col)))
f.text = paste(f.text, paste0(facet.name[2], ': ', f.layout$col),
sep=' | ')
f.layout$width = as.numeric(gsub('%', '', f.layout$width))
f.layout$left = as.numeric(gsub('%', '', f.layout$left))
lstTitle = lapply(unique(layout$ifacet), function(i){
list(text=f.text[i], meta='facet_title', top=f.layout$top[i],
left=paste0(f.layout$left[i] + f.layout$width[i]/2, '%'),
textAlign='center', backgroundColor='rgba(0,0,0,0.1)',
textStyle=list(fontSize = 12))
})
if (hasT){
chart$x$baseOption$title = append(
ifnull(chart$x$baseOption$title, list()), lstTitle)
}else{
chart$x$title = append(ifnull(chart$x$title, list()), lstTitle)
}
return(chart)
}
autoAxis = function(chart, hasSubAxis = TRUE, showMainAxis = TRUE, ...) {
stopifnot(inherits(chart, 'echarts'))
layout = getLayout(chart)
layout = layout[layout$coordSys == 'cartesian2d',]
hasT = 'baseOption' %in% names(chart$x)
meta = getMeta(if (hasT) chart$x$options[[1]] else chart)
xlab = if ('x' %in% names(meta[[1]])) names(meta[[1]]$x)[1] else
names(meta$x)[1]
ylab = if ('y' %in% names(meta[[1]])) names(meta[[1]]$y)[1] else
names(meta$y)[1]
if (nrow(layout) == 0) return(chart)
lstXAxis = lapply(unique(layout$xAxisIdx), function(x){
type = if (hasT) axisType(getMeta(chart)[[1]][[x+1]]$x[,1], 'x') else
axisType(getMeta(chart)[[x+1]]$x[,1], 'x')
if (type == 'category'){
idx = getLayout(chart)$i[getLayout(chart)$xAxisIdx == x]
data = getMeta(chart)[idx]
data = lapply(data, function(lst) data.frame(rownames=lst$rownames[,1],
x=lst$x[,1]))
data = do.call('rbind', data)
data = data[order(data$rownames),]
axisData = unique(as.character(data$x))
}else{
axisData = list()
}
list(gridIndex = x, show = showMainAxis, type = type, name = xlab,
axisLine = list(onZero=FALSE), scale = TRUE, data = axisData
)
})
if (hasSubAxis)
lstXAxis = append(lstXAxis, lapply(unique(layout$xAxisIdx), function(x){
list(gridIndex = x, show = FALSE, type = if (hasT)
axisType(getMeta(chart)[[1]][[x+1]]$x[,1], 'x') else
axisType(getMeta(chart)[[x+1]]$x[,1], 'x'),
axisLine = list(onZero=FALSE), scale = TRUE, data = list()
)
}))
lstYAxis = lapply(unique(layout$yAxisIdx), function(x){
type = if (hasT) axisType(getMeta(chart)[[1]][[x+1]]$y[,1], 'y') else
axisType(getMeta(chart)[[x+1]]$y[,1], 'y')
if (type == 'category'){
idx = getLayout(chart)$i[getLayout(chart)$yAxisIdx == x]
data = getMeta(chart)[idx]
data = lapply(data, function(lst) data.frame(rownames=lst$rownames[,1],
y=lst$y[,1]))
data = do.call('rbind', data)
data = data[order(data$rownames),]
axisData = unique(as.character(data$y))
}else{
axisData = list()
}
list(gridIndex = x, show = showMainAxis, type = type, name = ylab,
axisLine = list(onZero=FALSE), scale = TRUE, data = axisData
)
})
if (hasSubAxis)
lstYAxis = append(lstYAxis, lapply(unique(layout$yAxisIdx), function(x){
list(gridIndex = x, show = FALSE, type = if (hasT)
axisType(getMeta(chart)[[1]][[x+1]]$y[,1], 'y') else
axisType(getMeta(chart)[[x+1]]$y[,1], 'y'),
axisLine = list(onZero=FALSE), scale = TRUE, data = list()
)
}))
lstGrid = lapply(unique(layout$coordIdx), function(x){
rec = layout[layout$coordIdx == x,][1,]
return(list(top=rec$top, left=rec$left, width=rec$width, height=rec$height,
containLabel=TRUE))
})
# set axis
if (hasT){
chart$x$baseOption[c('xAxis', 'yAxis', 'grid')] = list(
lstXAxis, lstYAxis, lstGrid)
}else{
chart$x[c('xAxis', 'yAxis', 'grid')] = list(lstXAxis, lstYAxis, lstGrid)
}
return(chart)
}
#' @export
#' @rdname setAxis
setYAxis = function(chart, ...) { # set primary y axis
setAxis(chart, which = 'y', position = 'left', ...)
}
#' @export
#' @rdname setAxis
setY1Axis = function(chart, ...) { # set secondary y axis
setAxis(chart, which = 'y1', position = 'right', ...)
}
#' @export
#' @rdname setAxis
setXAxis = function(chart, ...) { # set primary x axis
setAxis(chart, which = 'x', position = 'bottom', ...)
}
#' @export
#' @rdname setAxis
setX1Axis = function(chart, ...) { # set secondary x axis
setAxis(chart, which = 'x1', position = 'top', ...)
}
#' @export
#' @rdname setAxis
setY2Axis = function(chart, ...) { # set secondary x axis
setAxis(chart, which = 'y2', position = 'right', offset = 20, ...)
}
axisType = function(data, which = c('x', 'y')) {
if (is.numeric(data) || is.null(data)) return('value')
if (is.factor(data) || is.character(data)) return('category')
if (inherits(data, c('Date', 'POSIXct', 'POSIXlt'))) return('time')
message('The structure of the ', which, ' variable:')
str(data)
stop('Unable to derive the axis type automatically from the ', which, ' variable')
}
flipAxis = function(chart, flip=NULL, ...){
# flip x|y-axis, and exchange x,y in data series
# flip: index of series
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
layout = getLayout(chart)
flip = intersect(flip, which(layout$coordSys == 'cartesian2d'))
if (length(flip) == 0) return(chart)
gridIdx = unique(layout$coordIdx[flip])
hasT = 'baseOption' %in% names(chart$x)
if (hasT){
if (all(c('xAxis', 'yAxis') %in% names(chart$x$baseOption))) {
lstAx = chart$x$baseOption[c('xAxis', 'yAxis')]
axes = sapply(lstAx, function(lst) sapply(lst, function(l) {
l$gridIndex}))
axes = data.table::melt(axes)
axes = axes[axes$value %in% gridIdx,]
if (nrow(axes) > 0){
xAxIdx = axes$Var1[axes$Var2=='xAxis']
yAxIdx = axes$Var1[axes$Var2=='yAxis']
tmp = list(chart$x$baseOption$xAxis[xAxIdx],
chart$x$baseOption$yAxis[yAxIdx])
for (i in xAxIdx) chart$x$xAxis[[i]] = tmp[[2]][[which(xAxIdx==i)]]
for (i in yAxIdx) chart$x$yAxis[[i]] = tmp[[1]][[which(yAxIdx==i)]]
}
for (t in seq_along(chart$x$options)){
for (s in flip){
if (is.list(chart$x$options[[t]]$series[[s]]$data)){
chart$x$options[[t]]$series[[s]]$data = lapply(
chart$x$options[[t]]$series[[s]]$data, function(l){
l[1:2] = l[2:1]
}
)
}else if (is.data.frame(chart$x$options[[t]]$series[[s]]$data) &&
ncol(chart$x$options[[t]]$series[[s]]$data) > 1){
chart$x$options[[t]]$series[[s]]$data[,1:2] =
chart$x$options[[t]]$series[[s]]$data[,2:1]
}
}
}
}
}else{
if (all(c('xAxis', 'yAxis') %in% names(chart$x))){
lstAx = chart$x[c('xAxis', 'yAxis')]
axes = sapply(lstAx, function(lst) sapply(lst, function(l) {
l$gridIndex}))
axes = data.table::melt(axes)
axes = axes[axes$value %in% gridIdx,]
if (nrow(axes) > 0){
xAxIdx = axes$Var1[axes$Var2=='xAxis']
yAxIdx = axes$Var1[axes$Var2=='yAxis']
tmp = list(chart$x$xAxis[xAxIdx], chart$x$yAxis[yAxIdx])
for (i in xAxIdx) chart$x$xAxis[[i]] = tmp[[2]][[which(xAxIdx==i)]]
for (i in yAxIdx) chart$x$yAxis[[i]] = tmp[[1]][[which(yAxIdx==i)]]
}
for (s in flip){
if (is.list(chart$x$series[[s]]$data)){
chart$x$series[[s]]$data = lapply(
chart$x$series[[s]]$data, function(l){
l[1:2] = l[2:1]
}
)
}else if (is.data.frame(chart$x$series[[s]]$data) &&
ncol(chart$x$series[[s]]$data) > 1){
chart$x$series[[s]]$data[,1:2] =
chart$x$series[[s]]$data[,2:1]
}
}
}
}
return(chart)
}
#' Set \code{grid} of Echarts Widgets And Pane
#'
#' When an echart object is generated, you can modify it by setting grid using
#' \code{\link{\%>\%}}. \cr
#' \strong{It is recommended to put \code{setGrid} at the end of the piped command.} \cr
#' When used for 'pane', it is only applicable for \code{scatter, point, bubble,
#' line, area, bar, histogram}. When used for 'timeline', it only take in params
#' \code{x, y, x2, y2}. When used for 'legend', 'title', 'dataZoom', 'dataRange',
#' 'toolbox', 'roamController', it only takes in params \code{x, y}.
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}}
#' @param widget Widget name to set. Could be \code{c('pane', 'timeline', 'legend',
#' 'title', 'dataZoom', 'dataRange', 'toolbox')}.
#' \describe{
#' \item{pane}{the area pane, takes in all the parameters}
#' \item{timeline}{timeline widget, only use \code{x, y, x2, y2}}
#' \item{legend, title, dataZoom, dataRange, toolbox, roamController}{other widgets,
#' only use \code{x, y}}
#' }
#' @param index Integer, index of the widget, if widget is 'pane'. Default 1.
#' @param left Left margin of the plot area. Default NULL ('auto').
#' @param top Top margin of the plot area. Default 60 px.
#' @param right Right margin of the plot area. Default '10\%'.
#' @param bottom Bottom margin of the plot area. Default 60 px.
#' @param width Width of the plot area. Default NULL (automatically configured)
#' @param height Height of the plot area. Default NULL (automatically configured)
#' @param containLabel Logical, whether grid area contains axis label. Default FALSE.
#' Set if TRUE when the chart is too small to show the axis label.
#' @param bgColor Background color of plot area. Default transparent ('rgba(0,0,0,0)').
#' @param borderColor Border color of the plot area. Default '#ccc'.
#' @param borderWidth Border width of the plot area. Default 0px (not shown).
#' @param shadowBlur Numeric, size of shadow blur. Only effective when \code{show} is TRUE.
#' @param shadowColor Color of the shadow. Only effective when \code{show} is TRUE.
#' @param shadowOffsetX Numeric, horizontal offset of the shadow. Only effective
#' when \code{show} is TRUE.
#' @param shadowOffsetY Numeric, vertical offset of the shadow. Only effective
#' when \code{show} is TRUE.
#' @param show Logical, if grid is shown. Default FALSE.
#' @param z Layer index of the widget. It does not create new canvas. Default 2.
#' @param zlevel Layer index of the canvas. Default 0.
#' @param ... Other arguments to pass to echarts object.
#'
#' @return A modified echarts object
#' @export
#' @seealso \code{\link{relocWidget}}
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~grid}
#' @examples
#' \dontrun{
#' g = iris %>% echartR(x=Sepal.Width, y=Petal.Width, series=Species)
#' g %>% setGrid(x=40, y=40, x2=70, y2=30, bgColor='gray90')
#' }
setGrid = function(chart, index=1, left=NULL, top=60, right='10%', bottom=60,
width=NULL, height=NULL, containLabel=FALSE,
bgColor=NULL, borderColor=NULL, borderWidth=1,
shadowBlur=NULL, shadowColor=NULL, shadowOffsetX=0,
shadowOffsetY=0, show=TRUE, z=2, zlevel=0,
widget=c('pane', 'timeline', 'legend', 'title', 'dataZoom',
'dataRange', 'toolbox'), ...){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
hasT = 'baseOption' %in% names(chart$x)
types = getSeriesPart(chart, 'type')
widget = match.arg(widget)
if (widget == 'pane') widget = 'grid'
lstGrid = list(left = left, top = top, right = right, bottom = bottom)
if (widget == 'grid') lstGrid = append(lstGrid, list(
width = width, height = height, borderWidth = borderWidth,
borderColor = borderColor, backgroundColor = getColors(bgColor)[1],
shadowBlur = shadowBlur, shadowColor = shadowColor,
shadowOffsetX = shadowOffsetX, shadowOffsetY = shadowOffsetY,
show = show, z = z, zlevel = zlevel
))
lstGrid = lstGrid[intersect(as.list(match.call())[-1], names(lstGrid))]
## wrap up
if (hasT){
if (widget == 'timeline'){
chart$x$timeline = mergeList(chart$x$timeline, lstGrid)
}else if((widget == 'grid') || widget %in% names(chart$x$baseOption)){
if (is.null(chart$x$baseOption[[widget]])){
chart$x$baseOption[[widget]] = list(lstGrid)
}else{
index = intersect(index, seq_along(chart$x$baseOption[[widget]]))
for (i in index){
chart$x$baseOption[[widget]][[i]] =
mergeList(chart$x$baseOption[[widget]][[i]], lstGrid)
}
}
}
}else{
if ((widget == 'grid') || widget %in% names(chart$x))
if (is.null(chart$x[[widget]])){
chart$x[[widget]] = list(lstGrid)
}else{
index = intersect(index, seq_along(chart$x[[widget]]))
for (i in index){
chart$x[[widget]][[i]] =
mergeList(chart$x[[widget]][[i]], lstGrid)
}
}
}
return(chart)
}
#' @export
#' @rdname setGrid
relocTitle = function(chart, ...){
setGrid(chart, widget='title', ...)
}
#' @export
#' @rdname setGrid
relocLegend = function(chart, ...){
setGrid(chart, widget='legend', ...)
}
#' @export
#' @rdname setGrid
relocDataZoom = function(chart, ...){
setGrid(chart, widget='dataZoom', ...)
}
#' @export
#' @rdname setGrid
relocDataRange = function(chart, ...){
setGrid(chart, widget='dataRange', ...)
}
#' @export
#' @rdname setGrid
relocTimeline = function(chart, ...){
setGrid(chart, widget='timeline', ...)
}
#' @export
#' @rdname setGrid
relocToolbox = function(chart, ...){
setGrid(chart, widget='toolbox', ...)
}
#' Re-locate Echarts Widgets (Position of Upper-left/Lower-right Point)
#'
#' @param chart Echarts object
#' @param widgets Vector or list, could be \code{'title', 'timeline', 'legend', 'toolbox',
#' 'dataRange', 'dataZoom'}
#' @param x Vector, x-coordinates of the widgets' upper-left point
#' @param y Vector, y-coordinates of the widgets' upper-left point
#' @param x2 Vector, x-coordinates of the widgets' lower-right point
#' @param y2 Vector, y-coordinates of the widgets' lower-right point
#' @note If \code{x, y, x2, y2} are shorter in length than the list \code{widgets},
#' the last element of \code{x, y, x2, y2} will be applied to cover the rest.
#' If \code{x, y, x2, y2} are longer in length than the list \code{widgets},
#' the redundent elements will be dropped.
#' @return A modified Echarts object
#' @export
#' @seealso \code{\link{setGrid}}
#' @examples
#' \dontrun{
#' g = echartR(iris, Sepal.Width, Petal.Width) %>% setDataZoom()
#' g %>% relocWidgets('dataZoom', x=150)
#' }
relocWidget = function(chart, widgets, x=NULL, y=NULL, x2=NULL, y2=NULL){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
stopifnot(all(widgets %in% c('title', 'timeline', 'legend', 'toolbox',
'dataRange', 'dataZoom', 'roamController')))
if (!missing(x)) if (!is.null(x)) x = if (length(x) < length(widgets))
c(x, rep(x[length(x)], length(widgets) - length(x))) else x[length(widgets)]
if (!missing(y)) if (!is.null(y)) y = if (length(y) < length(widgets))
c(y, rep(y[length(y)], length(widgets) - length(y))) else x[length(widgets)]
if (!missing(x2)) if (!is.null(x2)) x = if (length(x2) < length(widgets))
c(x2, rep(x2[length(x2)], length(widgets) - length(x2))) else x[length(widgets)]
if (!missing(y2)) if (!is.null(y2)) x = if (length(y2) < length(widgets))
c(y2, rep(y2[length(y2)], length(widgets) - length(y2))) else x[length(widgets)]
for (i in 1:length(widgets)){
chart = chart %>% setGrid(x[i], y[i], x2[i], y2[i], widget=widgets[i])
}
return(chart)
}
.getGridParam = function(chart, control, pos, size, horizontal=TRUE){
stopifnot(length(pos) == 4) ## x, y, x2, y2
stopifnot(length(size) == 2) ## height, width
hasT = 'baseOption' %in% names(chart$x)
if (hasT){
if (control == 'timeline') obj = chart$x$timeline
else obj = chart$x$baseOption[[control]]
}else{
obj = chart$x[[control]]
}
lst = lapply(c('x', 'y', 'x2', 'y2', 'orient', 'height', 'width'),
function(param){obj[[param]]})
lstDefault = c(as.list(pos), ifelse(horizontal, 'horizontal', 'vertical'),
as.list(size))
names(lst) = names(lstDefault) = c('x', 'y', 'x2', 'y2', 'orient',
'height', 'width')
if (!is.null(obj))
lst = unlist(mergeList(lstDefault, lst, keep.null=TRUE,
skip.merge.null=TRUE))
# x, y , orient
else return(rep(NA, 8))
# x, y, x2, y2, width, height
x = ifelse(lst['x'] %in% c('left', 'center', 'right'), lst['x'],
ifelse(grepl("document\\.getElementById", lst['x']), 'right',
suppressWarnings(as.numeric(lst['x']))))
if (is.numeric(x)) x = if (ifna(x, 0) < 80) 'left' else
if (ifna(x, 0) < 400) 'center' else 'right'
y = ifelse(lst['y'] %in% c('top', 'center', 'bottom'), lst['y'],
ifelse(grepl("document\\.getElementById", lst['y']), 'bottom',
suppressWarnings(as.numeric(lst['y']))))
if (is.numeric(y)) y = if (ifna(y, 0) < 60) 'top' else
if (ifna(y, 0) < 400) 'center' else 'bottom'
x2 = suppressWarnings(as.numeric(lst['x2']))
y2 = suppressWarnings(as.numeric(lst['y2']))
height = suppressWarnings(as.numeric(lst['height']))
width = suppressWarnings(as.numeric(lst['width']))
pos = ifelse(length(clockPos(x, y, lst['orient'])) == 0, 12,
clockPos(x, y, lst['orient']))
x = suppressWarnings(as.numeric(lst['x']))
y = suppressWarnings(as.numeric(lst['y']))
if (is.na(x)) x = ifnull(switch(lst['x'], left=0, center=0, right=NA), 0)
if (is.na(x2)) x2 = ifnull(switch(lst['x'], left=NA, center=0, right=0), 0)
if (is.na(y)) y = ifnull(switch(lst['y'], top=0, center=0, bottom=NA), 0)
if (is.na(y2)) y2 = ifnull(switch(lst['y'], top=NA, center=0, bottom=0), 0)
return(c(pos, x, y, x2, y2, height, width, unname(lst['orient']=='horizontal')))
}
#' @export
#' @importFrom data.table data.table dcast
tuneGrid = function(chart, ...){
# tune the grid of pane and widgets
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
types = getSeriesPart(chart, 'type')
hasT = 'baseOption' %in% names(chart$x)
# if not Cartesian Coord chart, skip out
controls = c('title', 'timeline', 'legend', 'toolbox', 'dataRange',
'dataZoom', 'roamController')
gridParam = c('pos', 'x', 'y', 'x2', 'y2', 'height', 'width', 'orient')
dfGrid = data.frame(matrix(ncol=length(gridParam), nrow=length(controls)))
colnames(dfGrid) = gridParam
rownames(dfGrid) = controls
#---------- get x, y, x1, y1 of each control --------------
dfGrid['title',] = .getGridParam(
chart, 'title', c('center', 'bottom', NA, NA), c(50, 50))
dfGrid['legend',] = .getGridParam(
chart, 'legend', c('left', 'top', NA, NA), c(50, 50))
dfGrid['dataRange',] = .getGridParam(
chart, 'dataRange', c('left', 'bottom', NA, NA), c(50, 120), FALSE)
dfGrid['dataZoom',] = .getGridParam(
chart, 'dataZoom', c('center', 'bottom', NA, NA), c(30, 30))
dfGrid['toolbox',] = .getGridParam(
chart, 'toolbox', c('right', 'top', NA, NA), c(50, 50))
dfGrid['timeline',] = .getGridParam(
chart, 'timeline', c('center', 'bottom', 80, 0), c(50, 50))
dfGrid['roamController',] = .getGridParam(
chart, 'roamController', c('right', 'top', NA, NA), c(80, 150), FALSE)
# remove all NA rows
dfGrid = dfGrid[!(apply(dfGrid, 1, function(row) all(is.na(row)))),]
#dfGrid <<- dfGrid
# browser()
sumGrid = dcast(data.table(dfGrid), orient + pos ~ ., fun=sum,
value.var=c("x", "y", "x2", "y2", "height", "width"))
uniqueGrid = dfGrid[!duplicated(paste(dfGrid$orient, dfGrid$pos)),]
uniqueGrid = uniqueGrid[order(uniqueGrid$orient, uniqueGrid$pos),]
sumGrid[,c('x_sum_.', 'y_sum_.', 'x2_sum_.', 'y2_sum_.')] =
uniqueGrid[, c('x', 'y', 'x2', 'y2')]
sumGrid$x = ifblank(
rowSums(sumGrid[,list(x_sum_., width_sum_.)], na.rm=TRUE), NA)
sumGrid$y = ifblank(
rowSums(sumGrid[,list(y_sum_., height_sum_.)], na.rm=TRUE), NA)
sumGrid$x2 = ifblank(
rowSums(sumGrid[, list(x2_sum_., width_sum_.)], na.rm=TRUE), NA)
sumGrid$y2 = ifblank(
rowSums(sumGrid[, list(y2_sum_., height_sum_.)], na.rm=TRUE), NA)
#uniqueGrid <<- uniqueGrid
#sumGrid <<- sumGrid
lstGrid = list()
if (length(sumGrid[pos %in% c(8, 9, 10), x]) > 0)
if (max(sumGrid[pos %in% c(8, 9, 10), x]) > 70)
lstGrid$x = unname(max(ifblank(sumGrid[pos == 9, x], 70)) + 20)
if (length(sumGrid[pos %in% c(11, 12, 1), y]) > 0)
if (max(sumGrid[pos %in% c(11, 12, 1), y]) > 50)
lstGrid$y = unname(max(ifblank(sumGrid[pos == 12, y], 50)) + 30)
if (length(sumGrid[pos %in% c(2, 3, 4), x2]) > 0)
if (max(sumGrid[pos %in% c(2, 3, 4), x2]) > 70)
lstGrid$x2 = unname(max(ifblank(sumGrid[pos == 3, x2], 70)) + 20)
if (length(sumGrid[pos %in% c(5, 6, 7), y2]) > 0)
if (max(sumGrid[pos %in% c(5, 6, 7), y2]) > 50)
lstGrid$y2 = unname(max(ifblank(sumGrid[pos == 6, y2], 50)) + 30)
## tune grid if there are duplicated pos
if (any(duplicated(dfGrid$pos))){
dupPos = table(dfGrid$pos)
dupPos = as.numeric(names(dupPos[dupPos > 1]))
for (i in dupPos){
dfDupGrid = dfGrid[dfGrid$pos == i,]
len = nrow(dfDupGrid)
widgets = row.names(dfDupGrid)[2:len]
widgetsNotTL = widgets[!widgets %in% 'timeline']
dfDupGrid$cumHeight = cumsum(dfDupGrid$height)
dfDupGrid$cumWidth = cumsum(dfDupGrid$width)
sizeParam = ifelse(i %in% c(1, 5, 6, 7, 11, 12), 'height', 'width')
if (i %in% c(11, 12, 1)){
cumSize = ifna(dfDupGrid[1, 'y'],0) +
dfDupGrid[1: (len - 1), c("cumHeight")]
w = 'y'
w2 = 'y2'
}else if (i %in% c(2, 3, 4)){
cumSize = ifna(dfDupGrid[1, 'x2'],0) +
dfDupGrid[1: (len - 1), c("cumWidth")]
w = 'x2'
w2 = 'x'
}else if (i %in% c(5, 6, 7)){
cumSize = ifna(dfDupGrid[1, 'y2'],0) +
dfDupGrid[1: (len - 1), c("cumHeight")]
w = 'y2'
w2 = 'y'
}else if (i %in% c(8, 9, 10)){
cumSize = ifna(dfDupGrid[1, 'x'],0) +
dfDupGrid[1: (len - 1), c("cumWidth")]
w = 'x'
w2 = 'x2'
}
names(cumSize) = widgets
if (hasT){
for (j in widgets){
if (j == 'timeline') chart$x[[j]][[w]] = unname(cumSize[j])
else {
chart$x$baseOption[[j]][[w]] = unname(cumSize[j])
#if (w %in% c('x2', 'y2'))
#FIXME!!!!
# chart$x$baseOption[[j]][[w2]] = JS(
# paste0(getJSElementSize(
# chart, ifelse(w == 'x2', 'width', "height")),
# " - ", dfGrid[j, sizeParam] +
# chart$x$baseOption[[j]][[w]]))
}
}
}else{
for (j in widgets) {
chart$x[[j]][[w]] = unname(cumSize[j])
#if (w %in% c('x2', 'y2'))
#FIXME!!!!!
# chart$x[[j]][[w2]] = JS(
# paste0(getJSElementSize(
# chart, ifelse(w == 'x2', 'width', "height")),
# " - ", dfGrid[j, sizeParam] +
# chart$x[[j]][[w]]))
}
}
}
}
## additional tuning
if ('dataZoom' %in% row.names(dfGrid))
if (dfGrid['dataZoom', 'orient'] == 1){
if (hasT) chart$x$baseOption$dataZoom$x = ifnull(lstGrid$x, 80)
else chart$x$dataZoom$x = ifnull(lstGrid$x, 80)
}else{
if (hasT) chart$x$baseOption$dataZoom$y = ifnull(lstGrid$y, 60)
else chart$x$dataZoom$y = ifnull(lstGrid$y, 60)
}
if ('timeline' %in% row.names(dfGrid)){
chart$x$timeline$x = ifnull(lstGrid$x, 80)
chart$x$timeline$x2 = ifnull(lstGrid$x2, 80)
}
## wrap up
# collect all grid features
if (all(types %in% c('scatter', 'line', 'bar', 'k', 'eventRiver')))
if (length(lstGrid) > 0){
if (hasT)
chart$x$baseOption[['grid']] = lstGrid
else
chart$x[['grid']] = lstGrid
}
return(chart)
}
autoPolar = function(chart, type){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
chartTypes = getSeriesPart(chart, 'type')
hasT = 'baseOption' %in% names(chart$x)
if (!all(chartTypes %in% c('radar'))) return(chart)
# get chart meta data
hasT = 'baseOption' %in% names(chart$x)
if (hasT){
data = lapply(chart$x$options, function(l) getMeta(l))
list.names = names(data[[1]])
data = lapply(list.names, function(v) {
do.call('rbind', lapply(data, function(l) l[[v]]))
})
names(data) = list.names
}else data = getMeta(chart)
dt = data.frame(x=data$x[,1], y=data$y[,1])
dt$idx = if (is.null(data$series)) 1 else data$series[,1]
index = as.character(unique(dt$idx))
dt$series = if (ncol(data$x) == 1) names(data$y)[1] else data$x[,2]
if (!is.null(data$t)) {
dt$t = data$t[,1]
dt = data.table::dcast(dt, idx + x + series + t ~., sum, value.var='y')
names(dt) = c('idx', 'x', 'series', 't', 'y')
}else{
dt = data.table::dcast(dt, idx + x + series ~., sum, value.var='y')
names(dt) = c('idx', 'x', 'series', 'y')
}
# layout
layouts = autoMultiPolarChartLayout(length(index), gap=1.5)
rows = layouts$rows
cols = layouts$cols
centers = layouts$centers
rownames(centers) = index
radius = layouts$radius
# build polar lists
obj = lapply(index, function(i){
dat = dt[dt$idx == i,]
o = list(center=paste0(centers[i, 1:2], '%'), radius=paste0(radius, '%'))
indicator = lapply(as.character(unique(dat$x)), function(x){
list(text=x, max=ifna(max(unname(dt[dt$x==x, 'y'])), 0) * 1.2)
})
o[['indicator']] = indicator
if (grepl('circle', type[which(index == i), 'misc']))
o[['type']] = 'circle'
return(o)
})
if (hasT){
chart$x$baseOption[['polar']] = obj
}else{
chart$x[['polar']] = obj
}
return(chart)
}
#' Set \code{polar} of Echarts (For Radar Charts)
#'
#' Set the \code{polar} coordinates of Echarts for radar charts. \cr
#' When an echart object is generated, you can modify it by setting aesthetics using
#' \code{\link{\%>\%}}.
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{
#' \link{echartR}}
#' @param polarIndex Integer vector. The index of the polar systems you want to set.
#' Default NULL.
#' @param center Vector of the x, y position of the polar center. Could be numeric
#' or character (percent form) vectors of length 2. Default c('50\%', '50\%').
#' @param radius The radius of the polar system, could be numeric or character (percent form).
#' Default '75\%'.
#' @param startAngle Numeric (-180 ~ 180). The start angle. Default 90.
#' @param splitNumber Numeric. The number of sections to divide. Default 5.
#' @param boundaryGap Numeric vector of length 2. The gapping policy of the axis.
#' Default c(0, 0).
#' @param scale Logical. Whether to ignore zero and zoom toward the range of _min and _max.
#' @param axisLine List. Axis line styles. You can set its \code{show, onZero, lineStyle}
#' features. Default \code{list(show=TRUE)}.
#' @param axisLabel List. Axis label styles. You can set its \code{show, rotate, margin,
#' clickable, formatter, textStyle} features. Default \code{list(show=FALSE)}.
#' @param splitLine List. Split line styles. You can set its \code{show, lineStyle}
#' features. Default \code{list(show=TRUE)}.
#' @param splitArea List. Split area styles. You can set its \code{show, onGap, areaStyle}
#' features. Default \code{list(show=TRUE)}.
#' @param type Character, 'polygon' or 'circle'. The type of the polar shape.
#' Default 'polygon'.
#' @param indicator List. The radar indicator and labels. The basic structure is \code{
#' list(list(text='...', min=..., max=..., axisLabel=list(...)), list(text='...', min=..., max=...),
#' list(...), ...)}. Default is empty.
#' @param axisName List. The name of the axis. You can set its \code{show, formatter,
#' textStyle} features. Default \code{list(show=TRUE, formatter=NULL, textStyle=
#' list(color='#333'))}.
#' @param ... Elipsis
#'
#' @return A modified echarts object
#' @export
#'
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~polar}
#' @examples
#' \dontrun{
#' cars = mtcars[c('Merc 450SE','Merc 450SL','Merc 450SLC'),
#' c('mpg','disp','hp','qsec','wt','drat')]
#' cars$model = rownames(cars)
#' cars = data.table::melt(cars, id.vars='model')
#' names(cars) = c('model', 'indicator', 'Parameter')
#' g = echartr(cars, indicator, Parameter, model, type='radar') %>%
#' setTitle('Merc 450SE vs 450SL vs 450SLC')
#' g %>% setPolar(c(1,3), type='circle') %>%
#' setPolar(2, splitArea=list(show=FALSE)) %>%
#' setPolar(3, axisName=list(textStyle=textStyle(color='red')))
#' }
#'
setPolar = function(chart, polarIndex=NULL, center=c('50%', '50%'), radius='75%',
startAngle=90, splitNumber=5, boundaryGap=c(0, 0),
scale=FALSE, axisLine=NULL, axisLabel=NULL, splitLine=NULL,
splitArea=NULL, type=c('polygon', 'circle'),
indicator=NULL, axisName=NULL,
...){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
chartTypes = getSeriesPart(chart, 'type')
if (!all(chartTypes=='radar')) return(chart)
hasT = 'baseOption' %in% names(chart$x)
if (hasT){
nIndex = length(chart$x$baseOption$series)
}else{
nIndex = length(chart$x$series)
}
if (is.null(polarIndex)) polarIndex = 1:nIndex else
if (!all(data.table::between(polarIndex, 1, nIndex)))
stop(paste('polarIndex is not valid. It should all be between 1 and', nIndex))
lstPolar = list()
if (!missing(center)) lstPolar[['center']] = center
if (!missing(radius)) lstPolar[['radius']] = radius
if (!missing(startAngle)) lstPolar[['startAngle']] = startAngle
if (!missing(splitNumber)) lstPolar[['splitNumber']] = splitNumber
if (!missing(boundaryGap)) lstPolar[['boundaryGap']] = boundaryGap
if (!missing(scale)) lstPolar[['scale']] = scale
if (!missing(axisLine)) lstPolar[['axisLine']] = axisLine
if (!missing(axisLabel)) lstPolar[['axisLabel']] = axisLabel
if (!missing(splitLine)) lstPolar[['splitLine']] = splitLine
if (!missing(splitArea)) lstPolar[['splitArea']] = splitArea
type = match.arg(type)
if (type != 'polygon') lstPolar[['type']] = type
if (!missing(indicator)) lstPolar[['indicator']] = indicator
if (!missing(axisName)) lstPolar[['name']] = axisName
for (i in polarIndex){
if (hasT){
chart$x$baseOption$polar[[i]] = mergeList(
chart$x$baseOption$polar[[i]], lstPolar)
}else{
chart$x$polar[[i]] = mergeList(
chart$x$polar[[i]], lstPolar)
}
}
return(chart)
}
madlogos/recharts2 documentation built on May 21, 2019, 11:03 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions setAxis autoFacetTitle autoAxis setYAxis setY1Axis setXAxis setX1Axis setY2Axis axisType flipAxis setGrid relocTitle relocLegend relocDataZoom relocDataRange relocTimeline relocToolbox relocWidget .getGridParam tuneGrid autoPolar setPolar
Documented in relocDataRange relocDataZoom relocLegend relocTimeline relocTitle relocToolbox relocWidget setAxis setGrid setPolar setX1Axis setXAxis setY1Axis setY2Axis setYAxis
#' Set \code{x|yAxis} of Echarts (Primary or Secondary)
#'
#' When an echart object is generated, you can modify it by setting axis using
#' \code{\link{\%>\%}}. \cr \cr
#' You can use work functions \code{setXAxis}, \code{setYAxis}, \code{setX1Axis},
#' \code{setY1Axis}. \cr \cr
#' This function modified a few default options for the axis component in
#' ECharts:
#' \enumerate{
#' \item \code{scale = TRUE} (was \code{FALSE} by default in ECharts);
#' \item \code{axisLine$onZero = FALSE} (was \code{TRUE} in ECharts).
#' }
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}}
#' @param series Which series to be put on this axis. Could be:
#' \itemize{
#' \item series names, in vectors. E.g, \code{c('setosa', 'virginica')};
#' \item index of series, in vectors. E.g., \code{1:2} or \code{c(1,3)}.
#' }
#' @param which Which axis to be modified. Could be one of the following:
#' \describe{
#' \item{x}{primary x axis}
#' \item{y}{primary y axis}
#' \item{x1}{secondary x axis}
#' \item{y1}{secondary y axis}
#' }
#' @param type Type of the axis. Could be \code{c('time', 'value', 'category', 'log')}.
#' Default 'value'.
#' @param position Position of this axis. Could be \code{c('bottom', 'top', 'left',
#' 'right')} (default for primary x axis, secondary x axis, primary y axis and secondary
#' y axis, respectively.)
#' @param boundaryGap A two-element numeric vector, defining the policy of the space
#' at the two ends of the axis (percents). Deafult \code{c(0, 0)}.
#' @param min The mininum value of the axis. Default NULL (automatic). If a numeric
#' value is set, \code{boundaryGap} is disabled.
#' @param max The maxinum value of the axis. Default NULL (automatic). If a numeric
#' value is set, \code{boundaryGap} is disabled.
#' @param scale Logical, for axis of 'value', 'time', 'log' type, to define whether
#' zoom the scale to the range between _min and _max. Default TRUE.
#' @param splitNumber Numeric, how many sections to devide the axis. Default NULL,
#' automatically deviding based on algorithms of \code{min} and \code{max}.
#' @param axisLine A list. Default: \cr
#' \code{list(show=TRUE, onZero=FALSE, lineStyle=list( \cr
#' type='solid', color='#48b', width=2, shadowColor='rgba(0,0,0,0)', shadowBlur=5,
#' shadowOffsetX=3, shadowOffsetY=3))} \cr \cr
#' \code{lineStyle} accepts features \code{color, width, type, shadowColor, shadowBlur,
#' shadowOffsetX, shadowOffsetY}
#' @param axisTick A list. Default: \cr
#' \code{show=FALSE, inside=FALSE, length=5, lineStyle=list(color="#333", width=1)} \cr \cr
#' \code{lineStyle} accepts feature \code{color, width, type, shadowColor, shadowBlur,
#' shadowOffsetX, shadowOffsetY}
#' @param axisLabel A list controlling the axis labels. Default \code{show=TRUE,
#' rotate=0, margin=8, clickable=FALSE, formatter=NULL, textStyle=list(color="#333")} \cr \cr
#' \code{textStyle} accepts features \code{color, align, baseline, fontFamily, fontSize,
#' fontStyle, fontWeight}. \cr \cr
#' \strong{\code{formatter}}:
#' \describe{
#' \item{sprintf/format string}{String to overide \code{axisLable$formatter}.
#' It accepts \code{sprintf} (category and value) and \code{strptime} (time) formats.}
#' \item{js mode}{a JS function/expression, which is default}
#' } \cr
#' \code{axisLabel=list(formatter="\%s cm")} is equal to \cr
#' \code{axisLabel=list(formatter=JS('function (value) {return value + "cm";}'))} or \cr
#' \code{axisLabel=list(formatter='{value} cm')}
#' @param splitLine A list controlling the split lines. Default \code{show=TRUE,
#' lineStyle=list(color=list("#ccc"), width=1, type="solid")} \cr \cr
#' \code{lineStyle} accepts features \code{color, width, type, shadowColor, shadowBlur,
#' shadowOffsetX, shadowOffsetY}.
#' @param splitArea A list controlling the split areas. Default \code{show=FALSE,
#' onGap=NULL, areaStyle= list(color= list("rgba(250,250,250,0.3)", "rgba(200,200,200,0.3)")
#' , type="default"} \cr \cr
#' \code{areaStyle} accepts features \code{color, type}.
#' @param data A character vector/list for axis of type 'category', to define the text
#' labels shown in this axis. Default NULL. You can even pass in a complicated list with
#' \code{textSytle} list: \cr
#' \code{list('Jan', 'Feb', 'Mar', \cr list(value='Apr', textStyle=list(color='red', ...)),
#' \cr 'May', ...)}
#' @param grid
#' @param offset
#' @param inverse
#' @param interval
#' @param logBase
#' @param silent
#' @param triggerEvent
#' @param zlevel
#' @param z
#' @param mode
#'
#' @export
#' @seealso \code{\link{setXAxis}}, \code{\link{setYAxis}}, \code{\link{setX1Axis}},
#' \code{\link{setY1Axis}}
#' @references
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#tooltip-line1~xAxis-i}
#'
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#tooltip-line1~yAxis-i}
#' @examples
#' \dontrun{
#' g = echart(iris, Sepal.Width, Petal.Width, series=Species)
#'
#' # Change the style
#' g %>% setTheme('gray') %>% setXAxis(splitLine=list(show=FALSE)) %>%
#' setYAxis(axisLine=list(lineStyle=list(width=0)))
#'
#' # Dual-yAxis, series 1,2 on primary y-axis, series 3 on secondary y-axis
#' g %>% setYAxis(1:2, name="setosa/versicolor") %>%
#' setY1Axis("virginica", name="virginica")
#' }
setAxis = function(
chart, series = NULL, grid = NULL, which = c('x', 'y', 'x1', 'y1', 'y2'),
type = c('value', 'category', 'time', 'log'), offset = 0, show = TRUE,
position = c('bottom', 'top', 'left', 'right'), inverse = FALSE,
name = '', nameLocation = c('end', 'middle', 'start'), onZero = FALSE,
nameTextStyle = emptyList(), nameGap = 15, nameRotate = NULL,
boundaryGap = c(0, 0), min = NULL, max = NULL, scale = TRUE, splitNumber = NULL,
interval = NULL, logBase = 10, silent = FALSE, triggerEvent = FALSE,
axisLine = list(show = TRUE, onZero = onZero), axisTick = list(show = FALSE),
axisLabel = list(show = TRUE), splitLine = list(show = TRUE),
splitArea = list(show = FALSE), data = list(), zlevel = 0, z = 0
) {
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
layout = getLayout(chart)
layout = layout[layout$coordSys == 'cartesian2d',]
which = match.arg(which)
whichAx = substr(which, 0, 1) # x or y axis
hasT = "timeline" %in% names(chart$x)
if (!is.numeric(grid)) grid = NULL
# get intersect of the series (char)
allSeries = getSeriesPart(chart, 'category', drop=FALSE, fetch.all=TRUE) # all levels of series
if (!hasT) allSeries = as.matrix(allSeries, ncol=1)
uniSeries = unique(as.vector(allSeries))
if (!is.null(allSeries) && !is.null(series)){
if (is.numeric(series)){
series = intersect(series, seq_len(nrow(allSeries)))
series = if (length(series) > 0) allSeries[series,1] else NULL
}else{
series = intersect(as.character(series), unique(as.vector(allSeries)))
if (length(series) == 0) series = NULL
}
if (length(series) == 0) return(chart)
}else{
series = unique(layout$series)
}
# get intersect of gridIndex (num)
if (is.numeric(grid)){
grid = intersect(grid-1, layout$coordIdx)
if (length(grid) == 0) return(chart)
}else{
grid = unique(layout$coordIdx)
}
# modify df layout, chart already has 2*facet axes lists by autoAxis()
targetAxRows = which(layout$series %in% series & layout$coordIdx %in% grid)
if (which == 'x1'){
layout$xAxisIdx[targetAxRows] = layout$xAxisIdx[targetAxRows] +
length(seq_along(unique(layout$xAxisIdx)))
}
if (which == 'y1'){
layout$yAxisIdx[targetAxRows] = layout$yAxisIdx[targetAxRows] +
length(seq_along(unique(layout$yAxisIdx)))
}
if (which == 'y2'){
targetAx = unique(grid) + length(seq_along(unique(layout$coordIdx)))
layout$yAxisIdx[targetAxRows] = seq_along(targetAx) -1 +
2*length(seq_along(unique(layout$yAxisIdx)))
}
# original data along the axis
if (hasT){
odata = lapply(chart$x$options, getMeta)
if (!is.null(series)) {
sdata = lapply(odata, function(lst) lst['series'])
sdata = do.call('rbind', sdata)[,1]
}
odata = lapply(odata, function(lst) lst[[which]])
odata = do.call('rbind', odata)[,1]
}else{
odata = getMeta(chart)[[which]][,1]
if (!is.null(series)) sdata = getMeta(chart)[['series']][,1]
}
if (!is.null(series)) {
odata = odata[sdata %in% series]
}
# only get odata of specific series
if (missing(type)) type = axisType(odata, which)
if (missing(position)) {
position = switch(which, x = 'bottom', y = 'left', x1 = 'top',
y1 = 'right', y2 = 'right')
}else{
position = match.arg(position)
}
if (!is.null(axisLabel$formatter))
if (!is.list(axisLabel$formatter)){
axisLabel = mergeList(axisLabel, list(
formatter = if (inherits(axisLabel$formatter, 'JS_EVAL'))
axisLabel$formatter else convFormat2JS(axisLabel$formatter, type)
)
)
}
if (hasT) x = chart$x$baseOption else x = chart$x
i = paste0(whichAx, 'Axis')
o = list(
type = match.arg(type), show = show, position = position,
inverse = inverse, name = name, nameLocation = match.arg(nameLocation),
nameTextStyle = nameTextStyle, nameGap = nameGap, nameRotate = nameRotate,
boundaryGap = boundaryGap, min = min, max = max, scale = scale,
offset = offset, splitNumber = splitNumber, interval = interval,
logBase = logBase, triggerEvent = triggerEvent, silent = silent,
axisLine = axisLine, axisTick = axisTick, axisLabel = axisLabel,
splitLine = splitLine, splitArea = splitArea, data = data
)
if (length(x[[i]]) == 0) chart = autoAxis(chart)
# only merge the arguments that are not missing, e.g. eAxis(min = 0) will
# only overide 'min' but will not overide the 'name' attribute
a = intersect(c('position', 'axisLine', 'scale', 'show',
names(as.list(match.call()[-1]))), names(o))
if (which %in% c('x', 'x1')){
for (j in unique(layout[targetAxRows, 'xAxisIdx']))
x[[i]][[j+1]] = mergeList(x[[i]][[j+1]], o[a])
}else if (which %in% c('y', 'y1')){
for (j in unique(layout[targetAxRows, 'yAxisIdx']))
x[[i]][[j+1]] = mergeList(x[[i]][[j+1]], o[a])
}else if (which %in% 'y2'){
for (j in unique(layout[targetAxRows, 'yAxisIdx']))
x[[i]][j+1] = list(o[a])
}
if (hasT) chart$x$baseOption = x else chart$x = x
# revise axisIndex
ax = paste0(whichAx, "AxisIndex")
if (hasT){
for (i in targetAxRows)
chart$x$baseOption$series[[i]][c('xAxisIndex', 'yAxisIndex')] =
list(layout$xAxisIdx[i], layout$yAxisIdx[i])
}else{
for (i in targetAxRows)
chart$x$series[[i]][c('xAxisIndex', 'yAxisIndex')] =
list(layout$xAxisIdx[i], layout$yAxisIdx[i])
}
return(chart)
}
autoFacetTitle = function(chart){
stopifnot(inherits(chart, 'echarts'))
layout = getLayout(chart)
meta = getMeta(chart)
facet.name = if ('facet' %in% meta) names(meta$facet) else
names(meta[[1]]$facet)
hasT = 'baseOption' %in% names(chart$x)
if (max(layout$ifacet) == 1) return(chart)
f.layout = layout[!duplicated(layout$ifacet),]
f.text = paste0(facet.name[1], ': ', f.layout$row)
if (!all(is.na(f.layout$col)))
f.text = paste(f.text, paste0(facet.name[2], ': ', f.layout$col),
sep=' | ')
f.layout$width = as.numeric(gsub('%', '', f.layout$width))
f.layout$left = as.numeric(gsub('%', '', f.layout$left))
lstTitle = lapply(unique(layout$ifacet), function(i){
list(text=f.text[i], meta='facet_title', top=f.layout$top[i],
left=paste0(f.layout$left[i] + f.layout$width[i]/2, '%'),
textAlign='center', backgroundColor='rgba(0,0,0,0.1)',
textStyle=list(fontSize = 12))
})
if (hasT){
chart$x$baseOption$title = append(
ifnull(chart$x$baseOption$title, list()), lstTitle)
}else{
chart$x$title = append(ifnull(chart$x$title, list()), lstTitle)
}
return(chart)
}
autoAxis = function(chart, hasSubAxis = TRUE, showMainAxis = TRUE, ...) {
stopifnot(inherits(chart, 'echarts'))
layout = getLayout(chart)
layout = layout[layout$coordSys == 'cartesian2d',]
hasT = 'baseOption' %in% names(chart$x)
meta = getMeta(if (hasT) chart$x$options[[1]] else chart)
xlab = if ('x' %in% names(meta[[1]])) names(meta[[1]]$x)[1] else
names(meta$x)[1]
ylab = if ('y' %in% names(meta[[1]])) names(meta[[1]]$y)[1] else
names(meta$y)[1]
if (nrow(layout) == 0) return(chart)
lstXAxis = lapply(unique(layout$xAxisIdx), function(x){
type = if (hasT) axisType(getMeta(chart)[[1]][[x+1]]$x[,1], 'x') else
axisType(getMeta(chart)[[x+1]]$x[,1], 'x')
if (type == 'category'){
idx = getLayout(chart)$i[getLayout(chart)$xAxisIdx == x]
data = getMeta(chart)[idx]
data = lapply(data, function(lst) data.frame(rownames=lst$rownames[,1],
x=lst$x[,1]))
data = do.call('rbind', data)
data = data[order(data$rownames),]
axisData = unique(as.character(data$x))
}else{
axisData = list()
}
list(gridIndex = x, show = showMainAxis, type = type, name = xlab,
axisLine = list(onZero=FALSE), scale = TRUE, data = axisData
)
})
if (hasSubAxis)
lstXAxis = append(lstXAxis, lapply(unique(layout$xAxisIdx), function(x){
list(gridIndex = x, show = FALSE, type = if (hasT)
axisType(getMeta(chart)[[1]][[x+1]]$x[,1], 'x') else
axisType(getMeta(chart)[[x+1]]$x[,1], 'x'),
axisLine = list(onZero=FALSE), scale = TRUE, data = list()
)
}))
lstYAxis = lapply(unique(layout$yAxisIdx), function(x){
type = if (hasT) axisType(getMeta(chart)[[1]][[x+1]]$y[,1], 'y') else
axisType(getMeta(chart)[[x+1]]$y[,1], 'y')
if (type == 'category'){
idx = getLayout(chart)$i[getLayout(chart)$yAxisIdx == x]
data = getMeta(chart)[idx]
data = lapply(data, function(lst) data.frame(rownames=lst$rownames[,1],
y=lst$y[,1]))
data = do.call('rbind', data)
data = data[order(data$rownames),]
axisData = unique(as.character(data$y))
}else{
axisData = list()
}
list(gridIndex = x, show = showMainAxis, type = type, name = ylab,
axisLine = list(onZero=FALSE), scale = TRUE, data = axisData
)
})
if (hasSubAxis)
lstYAxis = append(lstYAxis, lapply(unique(layout$yAxisIdx), function(x){
list(gridIndex = x, show = FALSE, type = if (hasT)
axisType(getMeta(chart)[[1]][[x+1]]$y[,1], 'y') else
axisType(getMeta(chart)[[x+1]]$y[,1], 'y'),
axisLine = list(onZero=FALSE), scale = TRUE, data = list()
)
}))
lstGrid = lapply(unique(layout$coordIdx), function(x){
rec = layout[layout$coordIdx == x,][1,]
return(list(top=rec$top, left=rec$left, width=rec$width, height=rec$height,
containLabel=TRUE))
})
# set axis
if (hasT){
chart$x$baseOption[c('xAxis', 'yAxis', 'grid')] = list(
lstXAxis, lstYAxis, lstGrid)
}else{
chart$x[c('xAxis', 'yAxis', 'grid')] = list(lstXAxis, lstYAxis, lstGrid)
}
return(chart)
}
#' @export
#' @rdname setAxis
setYAxis = function(chart, ...) { # set primary y axis
setAxis(chart, which = 'y', position = 'left', ...)
}
#' @export
#' @rdname setAxis
setY1Axis = function(chart, ...) { # set secondary y axis
setAxis(chart, which = 'y1', position = 'right', ...)
}
#' @export
#' @rdname setAxis
setXAxis = function(chart, ...) { # set primary x axis
setAxis(chart, which = 'x', position = 'bottom', ...)
}
#' @export
#' @rdname setAxis
setX1Axis = function(chart, ...) { # set secondary x axis
setAxis(chart, which = 'x1', position = 'top', ...)
}
#' @export
#' @rdname setAxis
setY2Axis = function(chart, ...) { # set secondary x axis
setAxis(chart, which = 'y2', position = 'right', offset = 20, ...)
}
axisType = function(data, which = c('x', 'y')) {
if (is.numeric(data) || is.null(data)) return('value')
if (is.factor(data) || is.character(data)) return('category')
if (inherits(data, c('Date', 'POSIXct', 'POSIXlt'))) return('time')
message('The structure of the ', which, ' variable:')
str(data)
stop('Unable to derive the axis type automatically from the ', which, ' variable')
}
flipAxis = function(chart, flip=NULL, ...){
# flip x|y-axis, and exchange x,y in data series
# flip: index of series
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
layout = getLayout(chart)
flip = intersect(flip, which(layout$coordSys == 'cartesian2d'))
if (length(flip) == 0) return(chart)
gridIdx = unique(layout$coordIdx[flip])
hasT = 'baseOption' %in% names(chart$x)
if (hasT){
if (all(c('xAxis', 'yAxis') %in% names(chart$x$baseOption))) {
lstAx = chart$x$baseOption[c('xAxis', 'yAxis')]
axes = sapply(lstAx, function(lst) sapply(lst, function(l) {
l$gridIndex}))
axes = data.table::melt(axes)
axes = axes[axes$value %in% gridIdx,]
if (nrow(axes) > 0){
xAxIdx = axes$Var1[axes$Var2=='xAxis']
yAxIdx = axes$Var1[axes$Var2=='yAxis']
tmp = list(chart$x$baseOption$xAxis[xAxIdx],
chart$x$baseOption$yAxis[yAxIdx])
for (i in xAxIdx) chart$x$xAxis[[i]] = tmp[[2]][[which(xAxIdx==i)]]
for (i in yAxIdx) chart$x$yAxis[[i]] = tmp[[1]][[which(yAxIdx==i)]]
}
for (t in seq_along(chart$x$options)){
for (s in flip){
if (is.list(chart$x$options[[t]]$series[[s]]$data)){
chart$x$options[[t]]$series[[s]]$data = lapply(
chart$x$options[[t]]$series[[s]]$data, function(l){
l[1:2] = l[2:1]
}
)
}else if (is.data.frame(chart$x$options[[t]]$series[[s]]$data) &&
ncol(chart$x$options[[t]]$series[[s]]$data) > 1){
chart$x$options[[t]]$series[[s]]$data[,1:2] =
chart$x$options[[t]]$series[[s]]$data[,2:1]
}
}
}
}
}else{
if (all(c('xAxis', 'yAxis') %in% names(chart$x))){
lstAx = chart$x[c('xAxis', 'yAxis')]
axes = sapply(lstAx, function(lst) sapply(lst, function(l) {
l$gridIndex}))
axes = data.table::melt(axes)
axes = axes[axes$value %in% gridIdx,]
if (nrow(axes) > 0){
xAxIdx = axes$Var1[axes$Var2=='xAxis']
yAxIdx = axes$Var1[axes$Var2=='yAxis']
tmp = list(chart$x$xAxis[xAxIdx], chart$x$yAxis[yAxIdx])
for (i in xAxIdx) chart$x$xAxis[[i]] = tmp[[2]][[which(xAxIdx==i)]]
for (i in yAxIdx) chart$x$yAxis[[i]] = tmp[[1]][[which(yAxIdx==i)]]
}
for (s in flip){
if (is.list(chart$x$series[[s]]$data)){
chart$x$series[[s]]$data = lapply(
chart$x$series[[s]]$data, function(l){
l[1:2] = l[2:1]
}
)
}else if (is.data.frame(chart$x$series[[s]]$data) &&
ncol(chart$x$series[[s]]$data) > 1){
chart$x$series[[s]]$data[,1:2] =
chart$x$series[[s]]$data[,2:1]
}
}
}
}
return(chart)
}
#' Set \code{grid} of Echarts Widgets And Pane
#'
#' When an echart object is generated, you can modify it by setting grid using
#' \code{\link{\%>\%}}. \cr
#' \strong{It is recommended to put \code{setGrid} at the end of the piped command.} \cr
#' When used for 'pane', it is only applicable for \code{scatter, point, bubble,
#' line, area, bar, histogram}. When used for 'timeline', it only take in params
#' \code{x, y, x2, y2}. When used for 'legend', 'title', 'dataZoom', 'dataRange',
#' 'toolbox', 'roamController', it only takes in params \code{x, y}.
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}}
#' @param widget Widget name to set. Could be \code{c('pane', 'timeline', 'legend',
#' 'title', 'dataZoom', 'dataRange', 'toolbox')}.
#' \describe{
#' \item{pane}{the area pane, takes in all the parameters}
#' \item{timeline}{timeline widget, only use \code{x, y, x2, y2}}
#' \item{legend, title, dataZoom, dataRange, toolbox, roamController}{other widgets,
#' only use \code{x, y}}
#' }
#' @param index Integer, index of the widget, if widget is 'pane'. Default 1.
#' @param left Left margin of the plot area. Default NULL ('auto').
#' @param top Top margin of the plot area. Default 60 px.
#' @param right Right margin of the plot area. Default '10\%'.
#' @param bottom Bottom margin of the plot area. Default 60 px.
#' @param width Width of the plot area. Default NULL (automatically configured)
#' @param height Height of the plot area. Default NULL (automatically configured)
#' @param containLabel Logical, whether grid area contains axis label. Default FALSE.
#' Set if TRUE when the chart is too small to show the axis label.
#' @param bgColor Background color of plot area. Default transparent ('rgba(0,0,0,0)').
#' @param borderColor Border color of the plot area. Default '#ccc'.
#' @param borderWidth Border width of the plot area. Default 0px (not shown).
#' @param shadowBlur Numeric, size of shadow blur. Only effective when \code{show} is TRUE.
#' @param shadowColor Color of the shadow. Only effective when \code{show} is TRUE.
#' @param shadowOffsetX Numeric, horizontal offset of the shadow. Only effective
#' when \code{show} is TRUE.
#' @param shadowOffsetY Numeric, vertical offset of the shadow. Only effective
#' when \code{show} is TRUE.
#' @param show Logical, if grid is shown. Default FALSE.
#' @param z Layer index of the widget. It does not create new canvas. Default 2.
#' @param zlevel Layer index of the canvas. Default 0.
#' @param ... Other arguments to pass to echarts object.
#'
#' @return A modified echarts object
#' @export
#' @seealso \code{\link{relocWidget}}
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~grid}
#' @examples
#' \dontrun{
#' g = iris %>% echartR(x=Sepal.Width, y=Petal.Width, series=Species)
#' g %>% setGrid(x=40, y=40, x2=70, y2=30, bgColor='gray90')
#' }
setGrid = function(chart, index=1, left=NULL, top=60, right='10%', bottom=60,
width=NULL, height=NULL, containLabel=FALSE,
bgColor=NULL, borderColor=NULL, borderWidth=1,
shadowBlur=NULL, shadowColor=NULL, shadowOffsetX=0,
shadowOffsetY=0, show=TRUE, z=2, zlevel=0,
widget=c('pane', 'timeline', 'legend', 'title', 'dataZoom',
'dataRange', 'toolbox'), ...){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
hasT = 'baseOption' %in% names(chart$x)
types = getSeriesPart(chart, 'type')
widget = match.arg(widget)
if (widget == 'pane') widget = 'grid'
lstGrid = list(left = left, top = top, right = right, bottom = bottom)
if (widget == 'grid') lstGrid = append(lstGrid, list(
width = width, height = height, borderWidth = borderWidth,
borderColor = borderColor, backgroundColor = getColors(bgColor)[1],
shadowBlur = shadowBlur, shadowColor = shadowColor,
shadowOffsetX = shadowOffsetX, shadowOffsetY = shadowOffsetY,
show = show, z = z, zlevel = zlevel
))
lstGrid = lstGrid[intersect(as.list(match.call())[-1], names(lstGrid))]
## wrap up
if (hasT){
if (widget == 'timeline'){
chart$x$timeline = mergeList(chart$x$timeline, lstGrid)
}else if((widget == 'grid') || widget %in% names(chart$x$baseOption)){
if (is.null(chart$x$baseOption[[widget]])){
chart$x$baseOption[[widget]] = list(lstGrid)
}else{
index = intersect(index, seq_along(chart$x$baseOption[[widget]]))
for (i in index){
chart$x$baseOption[[widget]][[i]] =
mergeList(chart$x$baseOption[[widget]][[i]], lstGrid)
}
}
}
}else{
if ((widget == 'grid') || widget %in% names(chart$x))
if (is.null(chart$x[[widget]])){
chart$x[[widget]] = list(lstGrid)
}else{
index = intersect(index, seq_along(chart$x[[widget]]))
for (i in index){
chart$x[[widget]][[i]] =
mergeList(chart$x[[widget]][[i]], lstGrid)
}
}
}
return(chart)
}
#' @export
#' @rdname setGrid
relocTitle = function(chart, ...){
setGrid(chart, widget='title', ...)
}
#' @export
#' @rdname setGrid
relocLegend = function(chart, ...){
setGrid(chart, widget='legend', ...)
}
#' @export
#' @rdname setGrid
relocDataZoom = function(chart, ...){
setGrid(chart, widget='dataZoom', ...)
}
#' @export
#' @rdname setGrid
relocDataRange = function(chart, ...){
setGrid(chart, widget='dataRange', ...)
}
#' @export
#' @rdname setGrid
relocTimeline = function(chart, ...){
setGrid(chart, widget='timeline', ...)
}
#' @export
#' @rdname setGrid
relocToolbox = function(chart, ...){
setGrid(chart, widget='toolbox', ...)
}
#' Re-locate Echarts Widgets (Position of Upper-left/Lower-right Point)
#'
#' @param chart Echarts object
#' @param widgets Vector or list, could be \code{'title', 'timeline', 'legend', 'toolbox',
#' 'dataRange', 'dataZoom'}
#' @param x Vector, x-coordinates of the widgets' upper-left point
#' @param y Vector, y-coordinates of the widgets' upper-left point
#' @param x2 Vector, x-coordinates of the widgets' lower-right point
#' @param y2 Vector, y-coordinates of the widgets' lower-right point
#' @note If \code{x, y, x2, y2} are shorter in length than the list \code{widgets},
#' the last element of \code{x, y, x2, y2} will be applied to cover the rest.
#' If \code{x, y, x2, y2} are longer in length than the list \code{widgets},
#' the redundent elements will be dropped.
#' @return A modified Echarts object
#' @export
#' @seealso \code{\link{setGrid}}
#' @examples
#' \dontrun{
#' g = echartR(iris, Sepal.Width, Petal.Width) %>% setDataZoom()
#' g %>% relocWidgets('dataZoom', x=150)
#' }
relocWidget = function(chart, widgets, x=NULL, y=NULL, x2=NULL, y2=NULL){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
stopifnot(all(widgets %in% c('title', 'timeline', 'legend', 'toolbox',
'dataRange', 'dataZoom', 'roamController')))
if (!missing(x)) if (!is.null(x)) x = if (length(x) < length(widgets))
c(x, rep(x[length(x)], length(widgets) - length(x))) else x[length(widgets)]
if (!missing(y)) if (!is.null(y)) y = if (length(y) < length(widgets))
c(y, rep(y[length(y)], length(widgets) - length(y))) else x[length(widgets)]
if (!missing(x2)) if (!is.null(x2)) x = if (length(x2) < length(widgets))
c(x2, rep(x2[length(x2)], length(widgets) - length(x2))) else x[length(widgets)]
if (!missing(y2)) if (!is.null(y2)) x = if (length(y2) < length(widgets))
c(y2, rep(y2[length(y2)], length(widgets) - length(y2))) else x[length(widgets)]
for (i in 1:length(widgets)){
chart = chart %>% setGrid(x[i], y[i], x2[i], y2[i], widget=widgets[i])
}
return(chart)
}
.getGridParam = function(chart, control, pos, size, horizontal=TRUE){
stopifnot(length(pos) == 4) ## x, y, x2, y2
stopifnot(length(size) == 2) ## height, width
hasT = 'baseOption' %in% names(chart$x)
if (hasT){
if (control == 'timeline') obj = chart$x$timeline
else obj = chart$x$baseOption[[control]]
}else{
obj = chart$x[[control]]
}
lst = lapply(c('x', 'y', 'x2', 'y2', 'orient', 'height', 'width'),
function(param){obj[[param]]})
lstDefault = c(as.list(pos), ifelse(horizontal, 'horizontal', 'vertical'),
as.list(size))
names(lst) = names(lstDefault) = c('x', 'y', 'x2', 'y2', 'orient',
'height', 'width')
if (!is.null(obj))
lst = unlist(mergeList(lstDefault, lst, keep.null=TRUE,
skip.merge.null=TRUE))
# x, y , orient
else return(rep(NA, 8))
# x, y, x2, y2, width, height
x = ifelse(lst['x'] %in% c('left', 'center', 'right'), lst['x'],
ifelse(grepl("document\\.getElementById", lst['x']), 'right',
suppressWarnings(as.numeric(lst['x']))))
if (is.numeric(x)) x = if (ifna(x, 0) < 80) 'left' else
if (ifna(x, 0) < 400) 'center' else 'right'
y = ifelse(lst['y'] %in% c('top', 'center', 'bottom'), lst['y'],
ifelse(grepl("document\\.getElementById", lst['y']), 'bottom',
suppressWarnings(as.numeric(lst['y']))))
if (is.numeric(y)) y = if (ifna(y, 0) < 60) 'top' else
if (ifna(y, 0) < 400) 'center' else 'bottom'
x2 = suppressWarnings(as.numeric(lst['x2']))
y2 = suppressWarnings(as.numeric(lst['y2']))
height = suppressWarnings(as.numeric(lst['height']))
width = suppressWarnings(as.numeric(lst['width']))
pos = ifelse(length(clockPos(x, y, lst['orient'])) == 0, 12,
clockPos(x, y, lst['orient']))
x = suppressWarnings(as.numeric(lst['x']))
y = suppressWarnings(as.numeric(lst['y']))
if (is.na(x)) x = ifnull(switch(lst['x'], left=0, center=0, right=NA), 0)
if (is.na(x2)) x2 = ifnull(switch(lst['x'], left=NA, center=0, right=0), 0)
if (is.na(y)) y = ifnull(switch(lst['y'], top=0, center=0, bottom=NA), 0)
if (is.na(y2)) y2 = ifnull(switch(lst['y'], top=NA, center=0, bottom=0), 0)
return(c(pos, x, y, x2, y2, height, width, unname(lst['orient']=='horizontal')))
}
#' @export
#' @importFrom data.table data.table dcast
tuneGrid = function(chart, ...){
# tune the grid of pane and widgets
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
types = getSeriesPart(chart, 'type')
hasT = 'baseOption' %in% names(chart$x)
# if not Cartesian Coord chart, skip out
controls = c('title', 'timeline', 'legend', 'toolbox', 'dataRange',
'dataZoom', 'roamController')
gridParam = c('pos', 'x', 'y', 'x2', 'y2', 'height', 'width', 'orient')
dfGrid = data.frame(matrix(ncol=length(gridParam), nrow=length(controls)))
colnames(dfGrid) = gridParam
rownames(dfGrid) = controls
#---------- get x, y, x1, y1 of each control --------------
dfGrid['title',] = .getGridParam(
chart, 'title', c('center', 'bottom', NA, NA), c(50, 50))
dfGrid['legend',] = .getGridParam(
chart, 'legend', c('left', 'top', NA, NA), c(50, 50))
dfGrid['dataRange',] = .getGridParam(
chart, 'dataRange', c('left', 'bottom', NA, NA), c(50, 120), FALSE)
dfGrid['dataZoom',] = .getGridParam(
chart, 'dataZoom', c('center', 'bottom', NA, NA), c(30, 30))
dfGrid['toolbox',] = .getGridParam(
chart, 'toolbox', c('right', 'top', NA, NA), c(50, 50))
dfGrid['timeline',] = .getGridParam(
chart, 'timeline', c('center', 'bottom', 80, 0), c(50, 50))
dfGrid['roamController',] = .getGridParam(
chart, 'roamController', c('right', 'top', NA, NA), c(80, 150), FALSE)
# remove all NA rows
dfGrid = dfGrid[!(apply(dfGrid, 1, function(row) all(is.na(row)))),]
#dfGrid <<- dfGrid
# browser()
sumGrid = dcast(data.table(dfGrid), orient + pos ~ ., fun=sum,
value.var=c("x", "y", "x2", "y2", "height", "width"))
uniqueGrid = dfGrid[!duplicated(paste(dfGrid$orient, dfGrid$pos)),]
uniqueGrid = uniqueGrid[order(uniqueGrid$orient, uniqueGrid$pos),]
sumGrid[,c('x_sum_.', 'y_sum_.', 'x2_sum_.', 'y2_sum_.')] =
uniqueGrid[, c('x', 'y', 'x2', 'y2')]
sumGrid$x = ifblank(
rowSums(sumGrid[,list(x_sum_., width_sum_.)], na.rm=TRUE), NA)
sumGrid$y = ifblank(
rowSums(sumGrid[,list(y_sum_., height_sum_.)], na.rm=TRUE), NA)
sumGrid$x2 = ifblank(
rowSums(sumGrid[, list(x2_sum_., width_sum_.)], na.rm=TRUE), NA)
sumGrid$y2 = ifblank(
rowSums(sumGrid[, list(y2_sum_., height_sum_.)], na.rm=TRUE), NA)
#uniqueGrid <<- uniqueGrid
#sumGrid <<- sumGrid
lstGrid = list()
if (length(sumGrid[pos %in% c(8, 9, 10), x]) > 0)
if (max(sumGrid[pos %in% c(8, 9, 10), x]) > 70)
lstGrid$x = unname(max(ifblank(sumGrid[pos == 9, x], 70)) + 20)
if (length(sumGrid[pos %in% c(11, 12, 1), y]) > 0)
if (max(sumGrid[pos %in% c(11, 12, 1), y]) > 50)
lstGrid$y = unname(max(ifblank(sumGrid[pos == 12, y], 50)) + 30)
if (length(sumGrid[pos %in% c(2, 3, 4), x2]) > 0)
if (max(sumGrid[pos %in% c(2, 3, 4), x2]) > 70)
lstGrid$x2 = unname(max(ifblank(sumGrid[pos == 3, x2], 70)) + 20)
if (length(sumGrid[pos %in% c(5, 6, 7), y2]) > 0)
if (max(sumGrid[pos %in% c(5, 6, 7), y2]) > 50)
lstGrid$y2 = unname(max(ifblank(sumGrid[pos == 6, y2], 50)) + 30)
## tune grid if there are duplicated pos
if (any(duplicated(dfGrid$pos))){
dupPos = table(dfGrid$pos)
dupPos = as.numeric(names(dupPos[dupPos > 1]))
for (i in dupPos){
dfDupGrid = dfGrid[dfGrid$pos == i,]
len = nrow(dfDupGrid)
widgets = row.names(dfDupGrid)[2:len]
widgetsNotTL = widgets[!widgets %in% 'timeline']
dfDupGrid$cumHeight = cumsum(dfDupGrid$height)
dfDupGrid$cumWidth = cumsum(dfDupGrid$width)
sizeParam = ifelse(i %in% c(1, 5, 6, 7, 11, 12), 'height', 'width')
if (i %in% c(11, 12, 1)){
cumSize = ifna(dfDupGrid[1, 'y'],0) +
dfDupGrid[1: (len - 1), c("cumHeight")]
w = 'y'
w2 = 'y2'
}else if (i %in% c(2, 3, 4)){
cumSize = ifna(dfDupGrid[1, 'x2'],0) +
dfDupGrid[1: (len - 1), c("cumWidth")]
w = 'x2'
w2 = 'x'
}else if (i %in% c(5, 6, 7)){
cumSize = ifna(dfDupGrid[1, 'y2'],0) +
dfDupGrid[1: (len - 1), c("cumHeight")]
w = 'y2'
w2 = 'y'
}else if (i %in% c(8, 9, 10)){
cumSize = ifna(dfDupGrid[1, 'x'],0) +
dfDupGrid[1: (len - 1), c("cumWidth")]
w = 'x'
w2 = 'x2'
}
names(cumSize) = widgets
if (hasT){
for (j in widgets){
if (j == 'timeline') chart$x[[j]][[w]] = unname(cumSize[j])
else {
chart$x$baseOption[[j]][[w]] = unname(cumSize[j])
#if (w %in% c('x2', 'y2'))
#FIXME!!!!
# chart$x$baseOption[[j]][[w2]] = JS(
# paste0(getJSElementSize(
# chart, ifelse(w == 'x2', 'width', "height")),
# " - ", dfGrid[j, sizeParam] +
# chart$x$baseOption[[j]][[w]]))
}
}
}else{
for (j in widgets) {
chart$x[[j]][[w]] = unname(cumSize[j])
#if (w %in% c('x2', 'y2'))
#FIXME!!!!!
# chart$x[[j]][[w2]] = JS(
# paste0(getJSElementSize(
# chart, ifelse(w == 'x2', 'width', "height")),
# " - ", dfGrid[j, sizeParam] +
# chart$x[[j]][[w]]))
}
}
}
}
## additional tuning
if ('dataZoom' %in% row.names(dfGrid))
if (dfGrid['dataZoom', 'orient'] == 1){
if (hasT) chart$x$baseOption$dataZoom$x = ifnull(lstGrid$x, 80)
else chart$x$dataZoom$x = ifnull(lstGrid$x, 80)
}else{
if (hasT) chart$x$baseOption$dataZoom$y = ifnull(lstGrid$y, 60)
else chart$x$dataZoom$y = ifnull(lstGrid$y, 60)
}
if ('timeline' %in% row.names(dfGrid)){
chart$x$timeline$x = ifnull(lstGrid$x, 80)
chart$x$timeline$x2 = ifnull(lstGrid$x2, 80)
}
## wrap up
# collect all grid features
if (all(types %in% c('scatter', 'line', 'bar', 'k', 'eventRiver')))
if (length(lstGrid) > 0){
if (hasT)
chart$x$baseOption[['grid']] = lstGrid
else
chart$x[['grid']] = lstGrid
}
return(chart)
}
autoPolar = function(chart, type){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
chartTypes = getSeriesPart(chart, 'type')
hasT = 'baseOption' %in% names(chart$x)
if (!all(chartTypes %in% c('radar'))) return(chart)
# get chart meta data
hasT = 'baseOption' %in% names(chart$x)
if (hasT){
data = lapply(chart$x$options, function(l) getMeta(l))
list.names = names(data[[1]])
data = lapply(list.names, function(v) {
do.call('rbind', lapply(data, function(l) l[[v]]))
})
names(data) = list.names
}else data = getMeta(chart)
dt = data.frame(x=data$x[,1], y=data$y[,1])
dt$idx = if (is.null(data$series)) 1 else data$series[,1]
index = as.character(unique(dt$idx))
dt$series = if (ncol(data$x) == 1) names(data$y)[1] else data$x[,2]
if (!is.null(data$t)) {
dt$t = data$t[,1]
dt = data.table::dcast(dt, idx + x + series + t ~., sum, value.var='y')
names(dt) = c('idx', 'x', 'series', 't', 'y')
}else{
dt = data.table::dcast(dt, idx + x + series ~., sum, value.var='y')
names(dt) = c('idx', 'x', 'series', 'y')
}
# layout
layouts = autoMultiPolarChartLayout(length(index), gap=1.5)
rows = layouts$rows
cols = layouts$cols
centers = layouts$centers
rownames(centers) = index
radius = layouts$radius
# build polar lists
obj = lapply(index, function(i){
dat = dt[dt$idx == i,]
o = list(center=paste0(centers[i, 1:2], '%'), radius=paste0(radius, '%'))
indicator = lapply(as.character(unique(dat$x)), function(x){
list(text=x, max=ifna(max(unname(dt[dt$x==x, 'y'])), 0) * 1.2)
})
o[['indicator']] = indicator
if (grepl('circle', type[which(index == i), 'misc']))
o[['type']] = 'circle'
return(o)
})
if (hasT){
chart$x$baseOption[['polar']] = obj
}else{
chart$x[['polar']] = obj
}
return(chart)
}
#' Set \code{polar} of Echarts (For Radar Charts)
#'
#' Set the \code{polar} coordinates of Echarts for radar charts. \cr
#' When an echart object is generated, you can modify it by setting aesthetics using
#' \code{\link{\%>\%}}.
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{
#' \link{echartR}}
#' @param polarIndex Integer vector. The index of the polar systems you want to set.
#' Default NULL.
#' @param center Vector of the x, y position of the polar center. Could be numeric
#' or character (percent form) vectors of length 2. Default c('50\%', '50\%').
#' @param radius The radius of the polar system, could be numeric or character (percent form).
#' Default '75\%'.
#' @param startAngle Numeric (-180 ~ 180). The start angle. Default 90.
#' @param splitNumber Numeric. The number of sections to divide. Default 5.
#' @param boundaryGap Numeric vector of length 2. The gapping policy of the axis.
#' Default c(0, 0).
#' @param scale Logical. Whether to ignore zero and zoom toward the range of _min and _max.
#' @param axisLine List. Axis line styles. You can set its \code{show, onZero, lineStyle}
#' features. Default \code{list(show=TRUE)}.
#' @param axisLabel List. Axis label styles. You can set its \code{show, rotate, margin,
#' clickable, formatter, textStyle} features. Default \code{list(show=FALSE)}.
#' @param splitLine List. Split line styles. You can set its \code{show, lineStyle}
#' features. Default \code{list(show=TRUE)}.
#' @param splitArea List. Split area styles. You can set its \code{show, onGap, areaStyle}
#' features. Default \code{list(show=TRUE)}.
#' @param type Character, 'polygon' or 'circle'. The type of the polar shape.
#' Default 'polygon'.
#' @param indicator List. The radar indicator and labels. The basic structure is \code{
#' list(list(text='...', min=..., max=..., axisLabel=list(...)), list(text='...', min=..., max=...),
#' list(...), ...)}. Default is empty.
#' @param axisName List. The name of the axis. You can set its \code{show, formatter,
#' textStyle} features. Default \code{list(show=TRUE, formatter=NULL, textStyle=
#' list(color='#333'))}.
#' @param ... Elipsis
#'
#' @return A modified echarts object
#' @export
#'
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~polar}
#' @examples
#' \dontrun{
#' cars = mtcars[c('Merc 450SE','Merc 450SL','Merc 450SLC'),
#' c('mpg','disp','hp','qsec','wt','drat')]
#' cars$model = rownames(cars)
#' cars = data.table::melt(cars, id.vars='model')
#' names(cars) = c('model', 'indicator', 'Parameter')
#' g = echartr(cars, indicator, Parameter, model, type='radar') %>%
#' setTitle('Merc 450SE vs 450SL vs 450SLC')
#' g %>% setPolar(c(1,3), type='circle') %>%
#' setPolar(2, splitArea=list(show=FALSE)) %>%
#' setPolar(3, axisName=list(textStyle=textStyle(color='red')))
#' }
#'
setPolar = function(chart, polarIndex=NULL, center=c('50%', '50%'), radius='75%',
startAngle=90, splitNumber=5, boundaryGap=c(0, 0),
scale=FALSE, axisLine=NULL, axisLabel=NULL, splitLine=NULL,
splitArea=NULL, type=c('polygon', 'circle'),
indicator=NULL, axisName=NULL,
...){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
chartTypes = getSeriesPart(chart, 'type')
if (!all(chartTypes=='radar')) return(chart)
hasT = 'baseOption' %in% names(chart$x)
if (hasT){
nIndex = length(chart$x$baseOption$series)
}else{
nIndex = length(chart$x$series)
}
if (is.null(polarIndex)) polarIndex = 1:nIndex else
if (!all(data.table::between(polarIndex, 1, nIndex)))
stop(paste('polarIndex is not valid. It should all be between 1 and', nIndex))
lstPolar = list()
if (!missing(center)) lstPolar[['center']] = center
if (!missing(radius)) lstPolar[['radius']] = radius
if (!missing(startAngle)) lstPolar[['startAngle']] = startAngle
if (!missing(splitNumber)) lstPolar[['splitNumber']] = splitNumber
if (!missing(boundaryGap)) lstPolar[['boundaryGap']] = boundaryGap
if (!missing(scale)) lstPolar[['scale']] = scale
if (!missing(axisLine)) lstPolar[['axisLine']] = axisLine
if (!missing(axisLabel)) lstPolar[['axisLabel']] = axisLabel
if (!missing(splitLine)) lstPolar[['splitLine']] = splitLine
if (!missing(splitArea)) lstPolar[['splitArea']] = splitArea
type = match.arg(type)
if (type != 'polygon') lstPolar[['type']] = type
if (!missing(indicator)) lstPolar[['indicator']] = indicator
if (!missing(axisName)) lstPolar[['name']] = axisName
for (i in polarIndex){
if (hasT){
chart$x$baseOption$polar[[i]] = mergeList(
chart$x$baseOption$polar[[i]], lstPolar)
}else{
chart$x$polar[[i]] = mergeList(
chart$x$polar[[i]], lstPolar)
}
}
return(chart)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.