R/options.R
In madlogos/recharts2: An R Interface to ECharts3
Defines functions
makeTitle
setTitle
makeToolbox
setToolbox
makeDataZoom
setDataZoom
makeDataRange
setDataRange
setLegend
setTheme
makeTooltip
determineFormatter
setTooltip
setTimeline
addGeoCoord
overideGeoCoord
addHeatmap
overideHeatmap
addNameMap
overideNameMap
addMarkLine
overideMarkLine
addMarkPoint
overideMarkPoint
setSeries
aesStyle
lineStyle
textStyle
areaStyle
chordStyle
nodeStyle
linkStyle
labelStyle
labelLineStyle
itemStyle
Documented in
addGeoCoord
addHeatmap
addMarkLine
addMarkPoint
addNameMap
aesStyle
areaStyle
chordStyle
itemStyle
labelLineStyle
labelStyle
lineStyle
linkStyle
nodeStyle
overideGeoCoord
overideHeatmap
overideMarkLine
overideMarkPoint
overideNameMap
setDataRange
setDataZoom
setLegend
setSeries
setTheme
setTimeline
setTitle
setToolbox
setTooltip
textStyle
makeTitle = function(title=NULL, subtitle=NULL, link=NULL, sublink=NULL,
pos=6, bgColor=NULL, borderColor=NULL,
borderWidth=NULL, textStyle=NULL, subtextStyle=NULL, ...){
# Work function for setTitle
lstTitle = list()
if (!is.null(title)){
if (grepl("^\\[.+\\]\\(.+\\)$", title)){
if (is.null(link)) link = gsub("^\\[(.+)\\]\\((.+)\\)$", "\\2", title)
title = gsub("^\\[(.+)\\]\\((.+)\\)$", "\\1", title)
}
lstTitle$text = title
if (!is.null(link)) lstTitle$link = link
}
if (!is.null(subtitle)){
if (grepl("^\\[.+\\]\\(.+\\)$", subtitle)){
if (is.null(sublink))
sublink = gsub("^\\[(.+)\\]\\((.+)\\)$", "\\2", subtitle)
subtitle = gsub("^\\[(.+)\\]\\((.+)\\)$", "\\1", subtitle)
}
lstTitle$subtext = subtitle
if (!is.null(sublink)) lstTitle$sublink = sublink
}
if (is.numeric(pos[[1]]) && pos[[1]] <= 12){
lstTitle[c('x', 'y', 'orient')] = vecPos(pos[[1]])
}else if (length(pos)==3 && tolower(pos[[1]]) %in%
c('left', 'right', 'center') &&
tolower(pos[[2]]) %in% c('top', 'center', 'bottom') &&
tolower(pos[[3]]) %in% c('vertical', 'horizontal')){
lstTitle[c('x', 'y', 'orient')] = pos
}
if (!is.null(bgColor)){
if (bgColor != 'rgba(0,0,0,0)')
lstTitle[['backgroundColor']] = getColors(bgColor)[1]
}
if (!is.null(borderColor)){
if (borderColor != '#ccc')
lstTitle[['borderColor']] = getColors(borderColor)[1]
}
if (!is.null(borderWidth)){
if (borderWidth > 0)
lstTitle[['borderWidth']] = borderWidth
}
if (!is.null(textStyle)){
if (!identical(textStyle, list(fontSize=18, fontWeight='bold', color='#333'))){
if (all(names(textStyle) %in% c('fontSize', 'fontWeight', 'fontStyle',
'color', 'fontFamily')))
lstTitle[['textStyle']] = textStyle
}
}
if (!is.null(subtextStyle)){
if (!identical(subtextStyle, list(color='#aaa'))){
if (all(names(subtextStyle) %in% c('fontSize', 'fontWeight', 'fontStyle',
'color', 'fontFamily')))
lstTitle[['subtextStyle']] = subtextStyle
}
}
return(lstTitle)
}
#' Set \code{title} (And Subtitle) of Echarts
#'
#' When an echart object is generated, you can modify it by setting title and
#' subtitles using \code{\link{\%>\%}}.
#'
#' In echarts with timeline, you can set \code{title, subtitle, link, sublink, bgColor,
#' borderColor, borderWidth} as vectors of the same length as \code{z}. For \code{textSytle,
#' subtextStyle}, you need to pack the user-defined lists in a list.
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{\link{echartR}}
#' @param title text of the title. If written in markdown format \code{[caption](url)},
#' then \code{caption} is passed to title, \code{url} is passed to link. If the length
#' of the title vector equals to the length of timeline slices, the title vector will
#' be used as slice-specific user-defined title.
#' @param link link of the title
#' @param subtitle text of the subtitle. If written in markdown format \code{[caption](url)},
#' then \code{caption} is passed to title, \code{url} is passed to link. If the length
#' of the subtitle vector equals to the length of timeline slices, the subtitle vector will
#' be used as slice-specific user-defined title.
#' @param sublink link of the subtitle
#' @param pos the clock-position of title (and subtitle), refer to \code{\link{vecPos}}. Or
#' define a vector \code{c(x, y, orient)} yourself.
#' @param bgColor background color of title. Default 'rgba(0,0,0,0)' (transparent)
#' @param borderColor border color of the title. Default '#ccc'.
#' @param borderWidth border width of the title. Default 0px (not shown).
#' @param textStyle You can place self-defined textStyle list of the title here. E.g., \code{list(
#' fontFamily='Arial|Verdana|sans-serif', fontSize=20, fontWeight='normal|bold|bolder|lighter|<numbers>',
#' fontStyle='normal|italic|oblique', color='red')}
#' @param subtextStyle You can place self-defined textStyle of the subtitle here.
#' @param show Logical. Whether to show the title. If you want to remove title from
#' the echarts object, set it NULL.
#' @param ... elipsis
#'
#' @return A modified echart object
#' @export
#'
#' @references
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#title~title}
#'
#' @examples
#' \dontrun{
#' ## simple echarts scatter plot
#' g = iris %>% echartR(x=Sepal.Width, y=Petal.Width, series=Species,
#' type='scatter')
#'
#' ## set simple titles
#' g %>% setTitle(title='Iris data set', subtitle='by: R. A. Fisher')
#'
#' ## set titles with links and textStyles
#' g %>% setTitle(
#' '[Iris data set](https://en.wikipedia.org/wiki/Iris_flower_data_set)',
#' '[R. A. Fisher](https://en.wikipedia.org/wiki/Ronald_Fisher)',
#' textStyle=textStyle(fontFamily='Courier New', fontSize=24, color='gold'),
#' subtextStyle=textStyle(color='silver'), bgColor='lightgreen')
#'
#'
#' ## echarts with timeline
#' g1 = iris %>% echartR(x=Sepal.Width, y=Petal.Width, t=Species, type='scatter')
#'
#' ## simple titles/subtitles
#' g1 %>% setTitle(
#' '[Iris data set](https://en.wikipedia.org/wiki/Iris_flower_data_set)',
#' '[R. A. Fisher](https://en.wikipedia.org/wiki/Ronald_Fisher)')
#'
#' ## user-defined titles/subtitles
#' titles = c(
#' '[Iris setosa](https://en.wikipedia.org/wiki/Iris_setosa)',
#' '[Iris versicolor](https://en.wikipedia.org/wiki/Iris_versicolor)',
#' '[Iris virginica](https://en.wikipedia.org/wiki/Iris_virginica)')
#'
#' g1 %>%
#' setTitle(
#' titles,
#' textStyle=list(
#' textStyle(fontFamily='Impact', color='red', fontStyle='normal'),
#' textStyle(fontFamily='Times New Roman', color='green'),
#' textStyle(fontFamily='Calibri', color='blue', fontStyle='oblique')
#' ),
#' bgColor='lightyellow')
#' ## textStyle is a list length 3, mapping 3 levels for timeline
#' }
setTitle = function(chart, title=NULL, subtitle=NULL, link=NULL, sublink=NULL,
pos=6, bgColor=NULL, borderColor=NULL, borderWidth=NULL,
textStyle=NULL, subtextStyle=NULL, show=TRUE, ...){
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)
if (!missing(title)) title = ifnull(title, "")
if (!missing(subtitle)) subtitle = ifnull(subtitle, "")
if (hasT){ # has a timeline
if (is.null(show)) {
for (i in 1:length(chart$x$options))
chart$x$options[[i]]$title = NULL
return(chart %>% tuneGrid())
}
if (!is.null(title)){
if (length(title) == length(chart$x$options)){
titles = unlist(title)
} else {
if (grepl("^\\[.+\\]\\(.+\\)$", title[1])){
link = gsub("^\\[(.+)\\]\\((.+)\\)$", "\\2", title[1])
title = gsub("^\\[(.+)\\]\\((.+)\\)$", "\\1", title[1])
}
titles = paste0(
rep(gsub("^\\[(.+)\\]\\((.+)\\)$", "\\1", title),
length(chart$x$options)), " (",
attr(chart$x$baseOption$timeline, 'sliceby'), ": ",
chart$x$baseOption$timeline$data, ")")
}
}else{
titles = rep(NULL, length(chart$x$options))
}
.dupicateThem = function(val){
if (!is.null(val)){
if ((is.list(val) && is.list(val[[1]])) || is.vector(val)){
if (length(val) == length(chart$x$options)){
return(val)
}else{
return(rep(val[1], length(chart$x$options)))
}
}else{
if (is.list(val))
return(rep(list(val[1]), length(chart$x$options)))
else
return(rep(val[1], length(chart$x$options)))
}
}else{
return(rep(NULL, length(chart$x$options)))
}
}
subtitles = .dupicateThem(subtitle)
links = .dupicateThem(link)
sublinks = .dupicateThem(sublink)
bgColors = .dupicateThem(bgColor)
borderColors = .dupicateThem(borderColor)
borderWidths = .dupicateThem(borderWidth)
textStyles = .dupicateThem(textStyle)
subtextStyles = .dupicateThem(subtextStyle)
if (! all(is.null(c(titles, subtitles, links, sublinks, bgColor, pos, show,
borderColor, borderWidth, textStyle, subtextStyle)))) {
for (i in seq_len(length(chart$x$options))){
lstTitle = makeTitle(
title=titles[i], subtitle=subtitles[i], link=links[i],
sublink=sublinks[i], pos=pos, bgColor=bgColors[i],
borderColor=borderColors[i], borderWidth=borderWidths[i],
textStyle=textStyles[[i]], subtextStyle=subtextStyles[[i]]
)
chart$x$options[[i]][['title']] <-
if (is.null(chart$x$options[[i]][['title']])) lstTitle else
mergeList(chart$x$options[[i]][['title']], lstTitle)
}
}
}else{ # do not have timeline
if (is.null(show)) {
chart$x$title = NULL
return(chart %>% tuneGrid)
}
if (! all(is.null(c(title, subtitle, link, sublink)))){
lstTitle = makeTitle(
title=title, subtitle=subtitle, link=link, sublink=sublink,
pos=pos, borderColor=borderColor, borderWidth=borderWidth,
bgColor=bgColor, textStyle=textStyle, subtextStyle=subtextStyle
)
chart$x$title = if (is.null(chart$x$title)) lstTitle else
mergeList(chart$x$title , lstTitle)
}
}
return(chart %>% tuneGrid())
}
makeToolbox = function(toolbox=c(TRUE,'cn'), type='auto',
show=c('mark', 'dataZoom', 'dataView', 'magicType',
'restore', 'saveAsImage'), pos=1,
bgColor='rgba(0,0,0,0)', borderColor='#ccc', borderWidth=0,
padding=5, itemGap=10, itemSize=16,
color=c("#1e90ff", "#22bb22", "#4b0082", "#d2691e"),
disableColor='#ddd', effectiveColor='red', showTitle=TRUE,
textStyle=NULL,
...){
# Work function for setToolbox
if (! is.null(show)) show = tolower(show)
if (toolbox[1]){
lstToolbox= list(
show = ifnull(as.logical(toolbox[1]), TRUE),
feature = list(
mark =list(show = ('mark' %in% show)),
dataZoom = list(show = ('datazoom' %in% show)),
dataView = list(show = ('dataview' %in% show),
readOnly = FALSE),
magicType = list(show = FALSE),
restore = list(show = ('restore' %in% show)),
saveAsImage = list(show = ('saveasimage' %in% show))
)
)
if (! missing(bgColor)) if (bgColor != 'rgba(0,0,0,0)')
lstToolbox$backgroundColor = bgColor
if (! missing(borderColor)) if (borderColor != '#ccc')
lstToolbox$borderColor = borderColor
if (! missing(borderWidth)) if (borderWidth > 0)
lstToolbox$borderWidth = borderWidth
if (! missing(padding)) if (padding != 5) lstToolbox$padding = padding
if (! missing(itemGap)) if (itemGap != 10)
lstToolbox$itemGap = itemGap
if (! missing(itemSize)) if (itemSize != 16) lstToolbox$itemSize = itemSize
if (! missing(color)) if (!identical(color, c("#1e90ff", "#22bb22", "#4b0082", "#d2691e")))
lstToolbox$color = color
if (! missing(disableColor)) if (disableColor != '#ddd')
lstToolbox$disableColor = disableColor
if (! missing(effectiveColor)) if (effectiveColor != 'red')
lstToolbox$effectiveColor = effectiveColor
if (! missing(showTitle)) if (! showTitle) lstToolbox$showTitle = showTitle
if (! missing(textStyle)) if (is.null(textStyle))
lstToolbox$textStyle = textStyle
if (tolower(toolbox[2]) != 'cn'){ # Enlish tooltips of the controls
lstToolbox[['feature']][['mark']][['title']] = list(
mark="Apply Auxiliary Conductor",
markUndo="Undo Auxiliary Conductor",
markClear="Clear Auxiliary Conductor")
lstToolbox[['feature']][['dataZoom']][['title']] = list(
dataZoom="Data Zoom",
dataZoomReset="Reset Data Zoom")
lstToolbox[['feature']][['dataView']][['title']] = "Data View"
lstToolbox[['feature']][['dataView']][['lang']] <-
c('Data View', 'Close', 'Refresh')
lstToolbox[['feature']][['restore']][['title']] = "Restore"
lstToolbox[['feature']][['saveAsImage']][['title']] = "Save As Image"
lstToolbox[['feature']][['saveAsImage']][['lang']] = 'Click to Save'
}
if (is.numeric(pos[[1]]) && pos[[1]] <= 12){
lstToolbox[c('x', 'y', 'orient')] = vecPos(pos[[1]])
}else if (length(pos)==3 && tolower(pos[[1]]) %in%
c('left', 'right', 'center') &&
tolower(pos[[2]]) %in% c('top', 'center', 'bottom') &&
tolower(pos[[3]]) %in% c('vertical', 'horizontal')){
lstToolbox[c('x', 'y', 'orient')] = pos
}
if (type[1] %in% c('auto', 'line', 'bar', 'k')){
lstToolbox[['feature']][['magicType']] <-
list(show=TRUE, type= c('line', 'bar', 'tiled', 'stack'))
}else if (type[1] %in% c('pie', 'funnel')){
lstToolbox[['feature']][['magicType']] <-
list(show=TRUE, type= c('pie', 'funnel'))
}else if (type[1] %in% c('force', 'chord')){
lstToolbox[['feature']][['magicType']] <-
list(show=TRUE, type= c('force', 'chord'))
lstToolbox[['feature']][['dataView']] = list(show=FALSE)
lstToolbox[['feature']][['dataZoom']] = list(show=FALSE)
}
if (lstToolbox$feature$magicType$show){
if (tolower(toolbox[2]) != 'cn'){
lstToolbox[['feature']][['magicType']][['title']] = list(
line = "Switch to Line Chart",
bar = "Switch to Bar Chart",
stack = "Stack",
tiled = "Tiled",
force = "Switch to Force Chart",
chord = "Switch to Chord Chart",
pie = "Switch to Pie Chart",
funnel = "Switch to Funnel Chart"
)
}
}
}else{
lstToolbox=list(show=FALSE)
}
return(lstToolbox)
}
#' Set \code{toolbox} of Echarts
#'
#' When an echart object is generated, you can modify it by setting toolbox using
#' \code{\link{\%>\%}}.
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{\link{echartR}}
#' @param show logical. Show the toolbox if TRUE. If you want to remove toolbox from
#' the echarts object, set it NULL.
#' @param language 'cn' or 'en', the language of the toolbox tooltips.
#' @param controls which widgets to show. Default \code{'mark', 'dataZoom', 'dataView', 'magicType',
#' 'restore', 'saveAsImage'}.
#' @param pos the clock-position of toolbox, refer to \code{\link{vecPos}}. Or you can
#' define a vector \code{c(x, y, orient)} yourself.#'
#' @param bgColor background color, default transparent ('rgba(0,0,0,0)').
#' @param borderColor border color, default '#ccc'.
#' @param borderWidth border width, default 0px (not shown).
#' @param padding Padding of the toolbox. Default 5px. Could also be a list assigning
#' padding of top, right, bottom and left.
#' @param itemGap Gap between the items. Default 10px.
#' @param itemSize Size of the items. Default 16px.
#' @param color Colors of the toolbox widgets (applied in loops). Default
#' c("#1e90ff", "#22bb22", "#4b0082", "#d2691e").
#' @param disableColor Color for disabled widgets. Default '#ddd'.
#' @param effectiveColor Color for widgets be triggered. Default 'red'.
#' @param showTitle Logical, if widgets title are shown. Default TRUE.
#' @param textStyle A list of the text style of the widgets. Default \code{
#' list(fontFamily=c('Arial, Verdana, sans-serif'), fontSize=12, fontStyle='normal',
#' fontWeight='normal')}
#' @param ... elipsis
#'
#' @return A modified echart object
#' @export
#'
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~toolbox}
#' @examples
#' \dontrun{
#' g = iris %>% echartR(x=Sepal.Width, y=Petal.Width, series=Species, type='scatter')
#' g %>% setToolbox(TRUE, 'en')
#' }
setToolbox = function(chart, show=TRUE, language='cn',
controls=c('mark', 'dataZoom', 'dataView', 'magicType',
'restore', 'saveAsImage'), pos=1,
bgColor='rgba(0,0,0,0)', borderColor='#ccc', borderWidth=0,
padding=5, itemGap=10, itemSize=16,
color=c("#1e90ff", "#22bb22", "#4b0082", "#d2691e"),
disableColor='#ddd', effectiveColor='red', showTitle=TRUE,
textStyle=NULL,
...){
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)
if (hasT){
if (is.null(show)) {
chart$x$options[[1]]$toolbox = NULL
return(chart %>% tuneGrid())
}
type = chart$x$options[[1]]$series[[1]]$type
chart$x$options[[1]]$toolbox = makeToolbox(
toolbox=c(show, language), type, controls, pos, bgColor,
borderColor, borderWidth, padding, itemGap, itemSize, color,
disableColor, effectiveColor, showTitle, textStyle)
}else{
if (is.null(show)) {
chart$x$toolbox = NULL
return(chart %>% tuneGrid())
}
type = chart$x$series[[1]]$type
chart$x$toolbox = makeToolbox(
toolbox=c(show, language), type, controls, pos, bgColor,
borderColor, borderWidth, padding, itemGap, itemSize, color,
disableColor, effectiveColor, showTitle, textStyle)
}
return(chart %>% tuneGrid())
}
makeDataZoom = function(show=FALSE, pos=6, range=NULL, width=30,
fill='rgba(144,197,237,0.2)',
handle='rgba(70,130,180,0.8)',
bgColor = 'rgba(0,0,0,0)',
dataBgColor = '#eee', showDetail=TRUE, realtime=FALSE,
zoomLock=FALSE,
...){
# Work function for setDataZoom
if (is.numeric(pos[1])) pos = vecPos(pos)
if (!is.null(show)) {
lstdataZoom = list(show=show)
if (! missing(fill)) if (fill != 'rgba(144,197,237,0.2)')
lstdataZoom$fillerColor = fill
if (! missing(handle)) if (handle != 'rgba(70,130,180,0.8)')
lstdataZoom$handleColor = handle
if (! missing(bgColor)) if (bgColor != 'rgba(0,0,0,0)')
lstdataZoom$backgroundColor = bgColor
if (! missing(dataBgColor)) if (dataBgColor != '#eee')
lstdataZoom$dataBackgroundColor = dataBgColor
if (! missing(showDetail)) if (!showDetail)
lstdataZoom$showDetail = showDetail
if (! missing(realtime)) if (realtime)
lstdataZoom$realtime = realtime
if (! missing(zoomLock)) if (zoomLock)
lstdataZoom$zoomLock = zoomLock
if (pos[[3]] == 'vertical'){
lstdataZoom[['y']] = 60
if (pos[[1]]=='left') lstdataZoom[['x']] = 0
if (pos[[1]]=='right') lstdataZoom[['x']] = dev.size('px')[1] - 80
}else{
if (! (pos[[1]] == 'center' && pos[[2]] == 'bottom')){
lstdataZoom[['x']] = 80
if (pos[[2]]=='top') lstdataZoom[['y']] = 0
}
}
lstdataZoom[['orient']] = pos[[3]]
if (lstdataZoom$orient == 'horizontal') lstdataZoom[['height']] = width
if (lstdataZoom$orient == 'vertical') lstdataZoom[['width']] = width
if (!is.null(range))
range = c(range[1], ifelse(length(range) == 1, range[1], range[2]))
if (all(is.numeric(range[1:2]))){
if (any(! range >= 0 | ! range <= 100)){
stop("dataZoom should be between 0 and 100")
}else{
lstdataZoom[['start']] = min(range[1:2])
lstdataZoom[['end']] = max(range[1:2])
}
}
} else {
lstdataZoom = list(show=FALSE)
}
return(lstdataZoom)
}
#' Set \code{dataZoom} Bar of Echarts
#'
#' When an echart object is generated, you can modify it by setting dataZoom using
#' \code{\link{\%>\%}}.
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{\link{echartR}}
#' @param show logical. Show the dataZoom control if TRUE. If you want to remove
#' dataZoom from the echarts object, set it NULL.
#' @param pos the clock-position of dataZoom, refert to \code{\link{vecPos}}. You can
#' define a vector \code{c(x, y, orient)} yourself.
#' @param range A vector of \code{c(min, max)}. Cannot be out of the frame c(0, 100)
#' @param width The width of the dataZoom bar. Default 20px.
#' @param fill fillerColor of the dataZoom bar, in character \code{'rgba(red, green,
#' blue, alpha)'} format. Default 'rgba(144,197,237,0.2)' ("#90C5ED33").
#' @param handle handleColor of the dataZoom bar, in character \code{'rgba(red, green,
#' blue, alpha)'} format. Default 'rgba(70,130,180,0.8)' ("#4682B4CC").
#' @param bgColor background color. Default transparent ('rgba(0,0,0,0)')
#' @param dataBgColor background color of the data thumbnail (1st series). Default
#' '#eee'.
#' @param showDetail Logical, if show the details when zooming. Defaul TRUE.
#' @param realtime Logical, if realtime display the changes when zooming. Default FALSE.
#' @param zoomLock Logical, if the zoom range is locked. Deafult FALSE.
#' @param ... Elipsis
#' @return A modified echart object
#' @export
#'
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~dataZoom}
#' @examples
#' \dontrun{
#' g = iris %>% echartR(x=Sepal.Width, y=Petal.Width, series=Species, type='scatter')
#' g %>% setDataZoom(fill=rgba(c(col2rgb('gold'), 0.3)),
#' handle=rgba(c(col2rgb('gold'), 1)))
#'
#' g1 = iris %>% echartR(x=Sepal.Width, y=Petal.Width, t=Species, type='scatter')
#' g1 %>% setDataZoom(fill=rgba(c(col2rgb('lightgreen'), 0.2)),
#' handle=rgba(c(col2rgb('darkgreen'), 0.5)))
#' }
setDataZoom = function(chart, show=TRUE, pos=6, range=NULL, width=30,
fill='rgba(144,197,237,0.2)',
handle='rgba(70,130,180,0.8)', bgColor = 'rgba(0,0,0,0)',
dataBgColor = '#eee', showDetail=TRUE, realtime=FALSE,
zoomLock=FALSE, ...){
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)
if (hasT){
if (is.null(show)) {
chart$x$options[[1]]$dataZoom = NULL
return(chart %>% tuneGrid())
}
chart$x$options[[1]][['dataZoom']] = makeDataZoom(
show=show, pos=pos, range=range, fill=fill, handle=handle,
backgroundColor=bgColor, dataBackgroundColor=dataBgColor,
showDetail=showDetail, realtime=realtime, zoomLock=zoomLock
)
}else{
if (is.null(show)) {
chart$x$dataZoom = NULL
return(chart %>% tuneGrid())
}
chart$x[['dataZoom']] = makeDataZoom(
show=show, pos=pos, range=range, fill=fill, handle=handle,
backgroundColor=bgColor, dataBackgroundColor=dataBgColor,
showDetail=showDetail, realtime=realtime, zoomLock=zoomLock)
}
return(chart %>% tuneGrid())
}
makeDataRange = function(show=FALSE, pos=8, min=NULL, max=NULL, splitNumber=5,
itemGap=5, labels=NULL, calculable=FALSE,
borderColor='#ccc', borderWidth=0,
selectedMode=list(TRUE, 'single', 'multiple'),
color=c("#1e90ff", "#f0ffff"),
splitList=NULL, initialRange=NULL,
...){
# Work function for setDataRange
## color must be color vector
## splitList must be list(list(start=m, end=n, label=x, color=hex), ...)
## initialRange must be list(start=m, end=n)
if (is.null(show)) {
lstdataRange = NULL
} else {
if (! show){
lstdataRange = NULL
}else{
if (splitNumber == 0) calculable = TRUE
if (calculable) splitNumber = 0
lstdataRange = list(
show=show, calculable=calculable,
itemWidth=6, selectedMode=selectedMode[[1]]
)
if (is.numeric(pos[[1]]) && pos[[1]] <= 12){
lstdataRange[c('x', 'y', 'orient')] = vecPos(pos[[1]])
}else if (length(pos)==3 && tolower(pos[[1]]) %in%
c('left', 'right', 'center') &&
tolower(pos[[2]]) %in% c('top', 'center', 'bottom') &&
tolower(pos[[3]]) %in% c('vertical', 'horizontal')){
lstdataRange[c('x', 'y', 'orient')] = pos
}
if (!missing(color)) lstdataRange[['color']] = color
if (!missing(borderColor)) lstdataRange[['borderColor']] = borderColor
if (!missing(borderWidth)) lstdataRange[['borderWidth']] = borderWidth
if (!missing(labels)) {
if (length(labels) == 1) lstdataRange[['text']] = c(labels, "")
else lstdataRange[['text']] = labels[1:2]
}
if (!missing(min)) lstdataRange[['min']] = as.numeric(min)
if (!missing(max)) lstdataRange[['max']] = as.numeric(max)
if (!missing(splitList)) {
if (is.list(splitList) &&
all(names(splitList[[1]]) %in% c('start', 'end', 'label', 'color'))){
lstdataRange[['splitList']] = splitList
lstdataRange[['itemGap']] = itemGap
}
}else{
if (splitNumber > 0) {
lstdataRange[['itemGap']] = itemGap
lstdataRange[['splitNumber']] = splitNumber
}
}
if (calculable && !is.null(initialRange)){
if (is.list(initialRange) &&
all(names(initialRange) %in% c('start', 'end'))){
lstdataRange[['range']] = initialRange
lstdataRange$calculable = TRUE
}
}
}
}
return(lstdataRange)
}
#' Set \code{dataRange} Bar of Echarts
#'
#' When an echart object is generated, you can modify it by setting dataRange using
#' \code{\link{\%>\%}}.
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{\link{echartR}}
#' @param show logical. Show the dataRange control if TRUE. If you want to remove
#' dataRange from the echarts object, set it NULL.
#' @param pos the clock-position of dataRange, default 8. Refer to \code{\link{vecPos}}.
#' Or you can define the position vector \code{c(x, y, orient)} yourself.
#' @param valueRange The range of the dataRange bar in form of \code{c(min, max)}.
#' If NULL, echarts default will be used.
#' @param splitNumber How many discrete sections will the dataRange bar be divided into.
#' Default 5. Set it to 0 to set the bar continuous and calculable will be accordingly set TRUE.
#' @param itemGap The gap between itmes in pixels. Default 10px.
#' @param labels The labels to the ends the dataRange bar in form \code{c('high end',
#' 'low end')}. Default NULL, the min, max values will be used.
#' @param borderColor The border color of the dataRange bar. Default '#333'.
#' @param borderWidth The border width of the dataRange bar. Default 0px (not shown).
#' @param calculable Logical. If echart calculable feature is open. Default FALSE. If set
#' calculable TRUE, splitNumber will be set 0.
#' @param selectedMode The mode of the dataRange bar, default TRUE. You can also
#' set it 'single' or 'multiple'.
#' @param color The hex vector of colors used for dataRange bar. Default c("#1e90ff", "#f0ffff").
#' @param splitList A list for user-defined value split in the form of
#' \code{list(list(start=m, end=n, label=x, color=hex), ...)}. If a valid splitList is set,
#' splitNumber will be disabled.
#' @param initialRange Initial selected value range in the form of \code{list(start=m, end=n)}
#' @param ... Elipsis
#'
#' @return A modified echarts object
#' @export
#'
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~dataRange}
#' @examples
#' \dontrun{
#' g = iris %>% echartR(x=Sepal.Width, y=Petal.Width, series=Species, type='scatter')
#' g %>% setDataRange()
#'
#' g1 = iris %>% echartR(x=Sepal.Width, y=Petal.Width, t=Species, type='scatter')
#' g1 %>% setDataRange(valueRange=c(0, 2.5))
#' }
setDataRange = function(
chart, show=TRUE, pos=8, valueRange=NULL, splitNumber=5, itemGap=5,
labels=NULL, calculable=FALSE, borderColor='#ccc', borderWidth=0,
selectedMode=list(TRUE, 'single', 'multiple'),
color=c("#1e90ff", "#f0ffff"), splitList=NULL, initialRange=NULL,
...){
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)
if (! is.null(valueRange[1])) {
if (is.numeric(valueRange) && length(valueRange) > 1){
min = range(valueRange)[1]
max = range(valueRange)[2]
}else{
min = max = NULL
}
}else{
min = range(getYFromEChart(chart))[1]
max = range(getYFromEChart(chart))[2]
}
lst = makeDataRange(
show=show, pos=pos, min=min, max=max, splitNumber=splitNumber,
itemGap=itemGap, labels=labels, calculable=calculable,
borderColor=borderColor, borderWidth=borderWidth, selectedMode=selectedMode,
color=color, splitList=splitList, initialRange=initialRange
)
if (!is.null(lst)){
if (hasT){
if (is.null(show)) {
chart$x$options[[1]]$dataRange = NULL
return(chart %>% tuneGrid())
}
chart$x$options[[1]][['dataRange']] = lst
} else {
if (is.null(show)) {
chart$x$dataZoom = NULL
return(chart %>% tuneGrid())
}
chart$x[['dataRange']] = lst
}
}
return(chart %>% tuneGrid())
}
#' Set \code{legend} of Echarts
#'
#' When an echart object is generated, you can modify it by setting legend using
#' \code{\link{\%>\%}}.
#' You can modify the legend of the echarts object using this function.
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{\link{echartR}}
#' @param show Logical. Show the legend or not. Default TRUE. If you want to remove
#' legend from the echarts object, set it NULL.
#' @param pos Clock position of the legend. Default 11. Refer to \code{\link{vecPos}}.
#' Or you can define the position vector \code{c(x, y, orient)} yourself.
#' @param selected A vector of series names that are selected on load. If you assign 'none',
#' then none of the series will be selected in the beginning.
#' @param itemGap The gap between legend items. Default 5px.
#' @param borderColor The border color of the legend. Default '#ccc'.
#' @param borderWidth The border width of the legend. Default 0px (not shown).
#' @param textStyle A list of textStyle definition to decorate the text. E.g.,
#' \code{list(color='#444')} or \code{list(color='auto')}.
#' @param formatter A named formatter template or a string containing javascript codes.
#' E.g., \code{'{name}'}.
#' @param overideData A list of data to overide the legend text. E.g.,
#' \code{list(list(name='Series 1', icon='image://../asset/ico/favicon.png',
#' textStyle=list(color='#bbb')))}
#' @param ... Elipsis.
#'
#' @return A modified echarts object.
#' @export
#'
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~legend}
#' @examples
#' \donrun{
#' # No timeline
#' g = iris %>% echartR(x=Sepal.Width, y=Petal.Width, series=Species,
#' type='scatter')
#' g %>% setLegend(selected="versicolor")
#' g %>% setLegend(selected=levels(iris$Species)[1:2],
#' textStyle=textStyle(fontFamily='Times New Roman', color='purple',
#' fontWeight='bold', fontSize=16))
#'
#' # With Timeline
#' g1 = iris %>% echartR(x=Sepal.Width, y=Petal.Width, t=Species, type='scatter')
#' g1 %>% setLegend(pos=12, selected='none',
#' textStyle=list(fontFamily='Courier New', fontSize=16))
#' }
setLegend = function(
chart, show=TRUE, pos=11, selected=NULL, itemGap=5, borderColor='#ccc',
borderWidth=0, textStyle=list(color='auto'), formatter=NULL, overideData=NULL,
...){
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)
series = getSeriesPart(chart, 'category', fetch.all=TRUE)
if (!is.null(dim(series))) series = series[,1]
series = series[ifna(series, '') !='']
# get series name vector from echarts object
lstLegend = list(show=show, data=as.list(unique(series)))
if (is.numeric(pos[[1]]) && pos[[1]] <= 12){
lstLegend[c('x', 'y', 'orient')] = vecPos(pos[[1]])
}else if (length(pos)==3 && tolower(pos[[1]]) %in%
c('left', 'right', 'center') &&
tolower(pos[[2]]) %in% c('top', 'center', 'bottom') &&
tolower(pos[[3]]) %in% c('vertical', 'horizontal')){
lstLegend[c('x', 'y', 'orient')] = pos
}
if (!is.null(selected)){
unselected = unique(series[! series %in% selected])
lstLegend[['selected']] = emptyList()
for (item in unselected){
lstLegend[['selected']][[item]] = FALSE
}
if (length(selected) != length(series)){
if (length(unselected) == length(unique(series))-1)
lstLegend[['selectedMode']] = 'single'
else lstLegend[['selectedMode']] = 'multiple'
}
}
if (!missing(itemGap)) lstLegend[['itemGap']] = itemGap
if (!missing(borderColor)) lstLegend[['borderColor']] = borderColor
if (!missing(borderWidth)) lstLegend[['borderWidth']] = borderWidth
if (is.list(textStyle) && !identical(textStyle, list(color='auto')))
if (all(names(textStyle) %in% c('fontFamily', 'color', 'fontSize',
'fontStyle', 'fontWeight')))
lstLegend[['textStyle']] = textStyle
if (!missing(formatter)) lstLegend[['formatter']] = formatter
if (!missing(overideData))
if (all(names(overideData) %in% c('name', 'textStyle', 'icon')))
lstLegend[['data']] = overideData
if (! is.null(show)) {
if (hasT){
if (is.null(show)) {
chart$x$options[[1]]$legend = NULL
return(chart %>% tuneGrid())
}
chart$x$options[[1]][['legend']] = lstLegend
}else{
if (is.null(show)) {
chart$x$legend = NULL
return(chart %>% tuneGrid())
}
chart$x[['legend']] = lstLegend
}
}
return(chart %>% tuneGrid())
}
#' Set Theme Or Misc Aesthetics (color, background, animation, border effects) of Echarts
#'
#' Set the entire theme of Echarts. You can use a pre-installed theme or define
#' you own themes. \cr \cr
#' You can also set aesthetics of Echarts separately, including \code{color, bgColor,
#' animation, calculable, borderColor, borderWidth}.\cr \cr
#' When an echart object is generated, you can modify it by setting aesthetics using
#' \code{\link{\%>\%}}.
#'
#' @section Self-defined Themes (UDT):
#' You can design your prefered themes using
#' \url{http://echarts.baidu.com/echarts2/doc/example/themeDesigner.html}.\cr
#' \cr The UDTs in \code{echarts} are JS objects. You can write it in a list form
#' and \code{setTheme} will parse it into JSON string for process. \cr \cr
#' A typical theme JS looks like: \cr
#' \code{{\cr
#' color: ['#ff7f50','#87cefa','#da70d6','#32cd32','#6495ed'], \cr
#' title: {x: 'left', y: 'top'}, \cr
#' legend: {orient: 'horizontal'} \cr
#' }} \cr \cr
#' You should write in the format below: \cr
#' \code{list(color=c('#ff7f50','#87cefa','#da70d6','#32cd32','#6495ed'), \cr
#' title=list(x='left', y='top'), legend=list(orient='horizontal'))}
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{
#' \link{echartR}}
#' @param theme \describe{
#' \item{Pre-installed themes}{\code{'default', 'macarons', 'infographic', 'blue',
#' 'dark', 'gray', 'green', 'helianthus', 'macarons2', 'mint', 'red', 'roma',
#' 'sakura', 'shine', 'vintage'}}
#' \item{User-defined themes}{E.g., \code{list(color=c('#ff7f50', '#87cefa',
#' '#da70d6','#32cd32','#6495ed'), \cr
#' title=list(x='left', y='top'), legend=list(orient='horizontal'))}}
#' }
#' @param palette name of the palette or a color vector. Default NULL to get echarts default.
#' It could be:
#' \describe{
#' \item{\code{asis}}{keep the color palette applied in current echarts object}
#' \item{Echarts theme palette}{"_default", "_macarons", "_infographic",
#' "_blue", "_dark", "_gray", "_green", "_helianthus", "_macarons2", "_mint",
#' "_red", "_roma", "_sakura", "_shine", "_vintage"}
#' \item{\link{RColorBrewer} palettes}{Including 'BrBG', 'PiYG', 'PRGn', 'PuOr', 'RdBu',
#' 'RdGy', 'RdYlBu', 'RdYlGn', 'Spectral', 'Accent', 'Dark2', 'Paired', 'Pastel1',
#' 'Pastel2', 'Set1', 'Set2', 'Set3', 'Blues', 'BuGn', 'BuPu', 'GnBu', 'Greens',
#' 'Greys', 'Oranges', 'OrRd', 'PuBu', 'PuBuGn', 'PuRd', 'Purples', 'RdPu', 'Reds',
#' 'YlGn', 'YlGnBu', 'YlOrBr', 'YlOrRd'}
#' \item{\link{ggthemes} palettes}{'calc', 'economist', 'economist_white', 'economist_stata',
#' 'excel', 'exel_fill', 'excel_line', 'excel_new', 'few', 'fivethirtyeight', '538', 'manyeyes',
#' 'gdocs', 'pander', 'tableau', 'stata', 'stata1','stata1r','statamono', 'ptol',
#' 'tableau20', 'tableau10medium', 'tableaugray', 'tableauprgy', 'tableaublrd',
#' 'tableaugnor', 'tableaucyclic', 'tableau10light', 'tableaublrd12', 'tableauprgy12',
#' 'tableaugnor12','hc','darkunica', 'solarized','solarized_red', 'solarized_yellow',
#' 'solarized_orange', 'solarized_magenta', 'solarized_violet', 'solarized_blue',
#' 'solarized_cyan', 'solarized_green', 'wsj', 'wsj_rgby', 'wsj_red_green',
#' 'wsj_black_green', 'wsj_dem_rep', 'colorblind', 'trafficlight'}
#' \item{Aetna official palettes}{Including 'aetnagreen', 'aetnablue', 'aetnaviolet',
#' 'aetnaorange', 'aetnateal', 'aetnacranberry'}
#' \item{Other palettes}{'rainbow', 'terrain', 'topo', 'heat', 'cm'}
#' }
#' \strong{Usage:} \cr
#' \itemize{
#' \item If the value is not set, and the function defaults will be loaded \cr
#' \item Set palette=NULL to use Echarts defaults \cr
#' \item Set palette=palette name to assign any palette listed above \cr
#' \item Set palette=\code{palette name(number)} to restrict number of colors within the
#' palette (e.g., \code{palette='calc(3)'} picks 3 colors out of 'calc' \strong{RANDOMLY}) \cr
#' \item Set palette=\code{c(color1, color2, color3, ...)} to define a palette vector,
#' made of which either color names or Hex expressions. Use \code{\link{colors}()} to check
#' available color names and check the effects using \code{demo(colors)}.
#' }
#' @param bgColor Color name/value of the background. Default is transparent
#' (\code{'rgba(0,0,0,0)'})
#' @param renderAsImage Logical. If TRUE, the interactive effects are disabled. Default FALSE.
#' @param calculable Logical. If TRUE, the chart is re-calculated after drag. Default FALSE.
#' @param calculableColor The border color of the tooltip during \code{calculable} effect.
#' Default 'rgba(255,165,0,0.6)'.
#' @param calculableHolderColor The color of \code{calculableHolder}. Default '#ccc'.
#' @param animation Logical. If TRUE, the animation is on at initiation. Default TRUE.
#' For IE8, it is recommended to set FALSE.
#' @param animationEasing The slight moving effect of major elements. Default 'ExponentialOut'.
#' Other choices: 'Linear', 'QuadraticIn', 'QuadraticOut', 'QuadraticInOut', 'CubicIn',
#' 'CubicOut', 'CubicInOut', 'QuarticIn', 'QuarticOut', 'QuarticInOut', 'QuinticIn',
#' 'QuinticOut', 'QuinticInOut', 'SinusoidalIn', 'SinusoidalOut', 'SinusoidalInOut',
#' 'ExponentialIn', 'ExponentialInOut', 'CircularIn', 'CircularOut', 'CircularInOut',
#' 'ElasticIn', 'ElasticOut', 'ElasticInOut', 'BackIn', 'BackOut', 'BackInOut',
#' 'BounceIn', 'BounceOut', 'BounceInOut'
#' @param animationDuration The duration into animation. Default 2000 (ms).
#' @param width Width (px) of the whole chart.
#' @param height Height (px) of the whole chart.
#' @param ... Elipsis
#'
#' @return A modified echarts object
#' @importFrom jsonlite toJSON
#' @export
#'
#' @seealso \code{\link{brewer.pal}}, \code{\link{colors}}
#' @references
#' \code{theme} \cr
#' \url{http://echarts.baidu.com/echarts2/doc/example/theme.html} \cr \cr
#' \code{backgroundColor} \cr
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#title~backgroundColor} \cr \cr
#' \code{colors} \cr
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#title~color} \cr
#' \url{http://colorbrewer2.org} \cr \cr
#' \code{other features} \cr
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#title~renderAsImage} \cr
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#title~calculable} \cr
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#title~animation} \cr
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#title~calculableColor} \cr
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#title~calculableHolderColor}
#' @examples
#' \dontrun{
#' g = echartR(iris, Sepal.Width, Petal.Width, series=Species)
#'
#' # Set themes
#' ## pre-installed themes
#' g %>% setTheme("infographic")
#' g %>% setTheme("blue")
#' g %>% setTheme("dark")
#' g %>% setTheme("gray")
#' g %>% setTheme("green")
#' g %>% setTheme("helianthus")
#' g %>% setTheme("macarons2")
#' g %>% setTheme("mint")
#' g %>% setTheme("red")
#' g %>% setTheme("sakura")
#' g %>% setTheme("shine")
#' g %>% setTheme("vintage")
#'
#' ## self-defined themes
#' theme = list(color=c("#7AC143", "#7D3F98", "#F47721", "#D20962", "#00A78E",
#' "#00BCE4", "#B8D936", "#EE3D94"), backgroundColor="#fef8ef")
#' g %>% setTheme(theme)
#'
#' ## Misc aethetics
#' g = echartR(iris, x=Sepal.Width, y=Petal.Width, series=Species, type='scatter')
#' g %>% setTheme(palette='hc')
#' g %>% setTheme(palette=c('red', 'gold', 'deepskyblue'), 'gray95',
#' animationHoldColor='red', animationEasing='CircularOut',
#' animationDuration=10000)
#' }
setTheme = function(
chart, theme=c(
'asis', 'default', 'macarons', 'infographic', 'blue', 'dark', 'gray', 'green',
'helianthus', 'macarons2', 'mint', 'red', 'roma', 'sakura', 'shine', 'vintage'),
palette='asis', bgColor=NULL, renderAsImage=FALSE, calculable=FALSE,
calculableColor=NULL, calculableHolderColor=NULL, animation=TRUE,
animationEasing=NULL, animationDuration=NULL, width=NULL, height=NULL,
...){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
## pass theme in
if (is.list(theme)){
theme = toJSON(theme)
}else{
theme = match.arg(theme)
}
if (!identical(theme, 'asis')) chart$x[['theme']] = theme
if (missing(theme) || is.null(theme)) chart$x[['theme']] = NULL
hasT = 'baseOption' %in% names(chart$x)
## set colors
### get color
if (is.list(theme)){
colors = if ('color' %in% names(theme)) theme$color else NULL
}else{
colors = getColors(paste0(theme, 'theme'))
}
### set color
if (hasT){
nSeries = sapply(chart$x$options, function(lst) {
return(length(lst$series))
})
nSeries = max(unlist(nSeries))
if (!missing(palette)) if (!identical(palette, 'asis')) {
lstColor = as.list(getColors(palette, n=nSeries))
chart$x$options[[1]][['color']] = lstColor[1:nSeries]
}
lsts = chart$x$options
lst = chart$x$options[[1]]
}else{
nSeries = length(getSeriesPart(chart, 'category', fetch.all=TRUE))
if (nSeries == 0) nSeries = 1
if (!missing(palette)) if (!identical(palette, 'asis')) {
lstColor = as.list(getColors(palette, n=nSeries))
chart$x[['color']] = lstColor[1:nSeries]
}
lst = chart$x
}
if (!missing(palette)) if (!identical(palette, 'asis'))
colors = getColors(palette)
### special chart type, special color setting
### if wordCloud, change itemStyle one by one
if (any('wordCloud' %in% getSeriesPart(chart, 'type'))){
if (hasT){
for (iZ in seq_along(lsts)){
vecS = seq_along(lsts[[iZ]]$series)
vWC = sapply(vecS, function(i) lsts[[iZ]]$series[[i]]$type)
iWC = which(vWC=='wordCloud')
if (length(iWC) >0)
for (iS in iWC) {
colorMeta = getMeta(lsts[[iZ]]$series[[iS]]$data)
itemCol = if (!is.null(colorMeta)){
colors = rep(
colors, ceiling(nlevels(colorMeta)/length(colors)))
colors = colors[1:nlevels(colorMeta)]
}else NULL
lapply(seq_along(lsts[[iZ]]$series[[iS]]$data),
function(i){
lsts[[iZ]]$series[[iS]]$data[[i]]$itemStyle$normal$color <<-
if (is.null(itemCol)) sample(colors, 1) else
itemCol[as.numeric(colorMeta)[i]]
})
lst = lsts[[1]]
}
}
}else{
vecS = seq_along(lst$series)
vWC = sapply(vecS, function(i) lst$series[[i]]$type)
iWC = which(vWC=='wordCloud')
if (length(iWC) >0)
lapply(iWC, function(iS){
colorMeta = getMeta(lst$series[[iS]]$data)
itemCol = if (!is.null(colorMeta)){
colors = rep(
colors, ceiling(nlevels(colorMeta)/length(colors)))
colors = colors[1:nlevels(colorMeta)]
}else NULL
lapply(seq_along(lst$series[[iS]]$data), function(i){
lst$series[[iS]]$data[[i]]$itemStyle$normal$color <<-
if (is.null(itemCol)) sample(colors, 1) else
itemCol[as.numeric(colorMeta[i])]
})
})
}
}
## set the rest elements
if (!missing(bgColor)) {
lst[['backgroundColor']] = ifelse(
grepl("^rgba\\(", bgColor), bgColor, getColors(bgColor))
if (grepl("^rgba\\(", bgColor)){
backColor = as.numeric(unlist(strsplit(bgColor,
"[\\(,\\)]"))[2:5])
contrastColor = c(rep(255, 4) - backColor)
contrastColor = paste0('rgba(', paste(contrastColor, collapse=","),
')')
}else if (grepl("^#", bgColor)){
cColor = c(rep(255, 4) - col2rgb(bgColor, TRUE))
contrastColor = rgb(cColor[1], cColor[2], cColor[3], max=255)
}
}
if (!missing(renderAsImage)) lst[['renderAsImage']] = renderAsImage
if (!missing(calculable)) lst[['calculable']] = calculable
if (!missing(calculableColor))
lst[['calculableColor']] = ifelse(
grepl("^rgba\\(", calculableColor), calculableColor,
getColors(calculableColor))
if (!missing(calculableHolderColor))
lst[['calculableHolderColor']] = ifelse(
grepl("^rgba\\(", calculableHolderColor), calculableHolderColor,
getColors(calculableHolderColor))
if (!missing(animation)) lst[['animation']] = FALSE
if (!missing(animationEasing))
if (animationEasing %in%
c('Linear', 'QuadraticIn', 'QuadraticOut', 'QuadraticInOut',
'CubicIn', 'CubicOut', 'CubicInOut', 'QuarticIn', 'QuarticOut',
'QuarticInOut', 'QuinticIn', 'QuinticOut', 'QuinticInOut',
'SinusoidalIn', 'SinusoidalOut', 'SinusoidalInOut', 'ExponentialIn',
'ExponentialInOut', 'CircularIn', 'CircularOut', 'CircularInOut',
'ElasticIn', 'ElasticOut', 'ElasticInOut', 'BackIn', 'BackOut',
'BackInOut', 'BounceIn', 'BounceOut', 'BounceInOut'))
lst[['animationEasing']] = animationEasing
if (!missing(animationDuration)){
lst[['animationDuration']] = animationDuration
if (hasT) chart$x$baseOption$timeline[['playInterval']] = animationDuration
}
## merge list back to echarts object
if (hasT) {
chart$x$baseOption = mergeList(chart$x$baseOption, lst)
chart$x$options = lsts
}else chart$x = lst
## width and height
if (!is.null(width)) chart[['width']] = width
if (!is.null(height)) chart[['height']] = height
return(chart)
}
makeTooltip = function(type, trigger=NULL, formatter=NULL,
islandFormatter='{a} < br/>{b} : {c}',
position=NULL, enterable=FALSE, axisPointer=NULL,
textStyle=NULL, showDelay=20, hideDelay=100,
transitionDuration=0.4, bgColor='rgba(0,0,0,0.7)',
borderColor='#333', borderWidth=0, borderRadius=4,
show=TRUE, keepDefault=FALSE, timeIndex=NULL, ...){
if (!ifnull(show, TRUE)) {
lstTooltip = list(show=FALSE)
}else{
if (is.null(trigger)){
trigger = ifelse(
type %in% c('pie', 'funnel', 'map', 'wordcloud', 'radar', 'chord',
'force', 'gauge', 'eventRiver', 'tree', 'treemap'),
'item', 'axis')
}else{
trigger = match.arg(trigger, c('item', 'axis'))
}
lstTooltip = list(show = ifnull(show, TRUE), trigger = trigger)
## fetch default features
lstTooltip[c('axisPointer', 'textStyle')] <-
list(list(
type=ifelse(type %in% c('line'), 'line',
ifelse(type %in% c('bar'), 'shadow',
ifelse(type %in% c('scatter', 'map', 'heatmap'),
'cross', 'none'))),
crossStyle=list(type='dashed'),
lineStyle=list(type='solid', width=1),
shadowStyle=list(color='rgba(150,150,150,0.3)', width='auto',
type='default')
),
list(color='#fff')
)
if (keepDefault){
lstTooltip[c('islandFormatter', 'enterable', 'showDelay', 'hideDelay',
'transitionDuration', 'backgroundColor', 'borderWidth')] <-
list('{a} < br/>{b} : {c}', FALSE, 20, 100, 0.4, '#333', 0)
}
## fetch features
if (!is.null(position)) lstTooltip[['position']] = position
if (!is.null(formatter)) lstTooltip[['formatter']] = formatter
if (!is.null(islandFormatter))
lstTooltip[['islandFormatter']] = islandFormatter
if (!is.null(enterable)) lstTooltip[['enterable']] = enterable
if (!is.null(axisPointer)) {
if (all(names(axisPointer) %in% c('type', 'lineStyle', 'crossStyle',
'shadowStyle', 'textStyle'))){
lstTooltip[['axisPointer']] = axisPointer
}
else warning(paste(
"axisPointer must be a list containing any of the below:\n",
"'type', 'lineStyle', 'crossStyle', 'shadowStyle', 'textStyle'."))
}
if (!is.null(textStyle)) {
if (all(names(textStyle) %in% c(
'color', 'decoration', 'align', 'baseline', 'fontFamily',
'fontSize', 'fontStyle', 'fontWeight')))
lstTooltip[['textStyle']] = textStyle
else warning(paste(
"textStyle must be a list containing any of the below:\n",
"'color', 'decoration', 'align', 'baseline', 'fontFamily',",
"'fontSize','fontStyle', 'fontWeight'."))
}
if (!is.null(showDelay)) lstTooltip[['showDelay']] = showDelay
if (!is.null(hideDelay)) lstTooltip[['hideDelay']] = hideDelay
if (!is.null(transitionDuration))
lstTooltip[['transitionDuration']] = transitionDuration
if (!is.null(bgColor))
lstTooltip[['backgroundColor']] = getColors(bgColor)[1]
if (!is.null(borderColor))
lstTooltip[['borderColor']] = getColors(borderColor)[1]
if (!is.null(borderWidth)) lstTooltip[['borderWidth']] = borderWidth
if (!is.null(borderRadius))
lstTooltip[['borderRadius']] = borderRadius
}
return(lstTooltip)
}
determineFormatter = function(type){
if (type %in% c('scatter')){
formatter = tooltipJS('scatter')
}else if (type %in% c('scatter_time')){
formatter = tooltipJS('scatter_time')
}else if (type %in% c('pie')){
formatter = tooltipJS('pie')
}else if (type %in% c('pie')){
formatter = tooltipJS('pie')
}else if (type %in% c('chord', 'force')){
# if (length(getSeriesPart(chart, 'name')) == 1){
# formatter = tooltipJS('chord_mono')
# }else{
formatter = tooltipJS('chord_multi')
# }
}else if (type == 'k'){
formatter = tooltipJS('k')
}else if (type %in% c('bar', 'line')){
formatter = tooltipJS('line')
}else if (type %in% c('bar_time', 'line_time')){
formatter = tooltipJS('line_time')
}else if (type == 'histogram'){
formatter = tooltipJS('hist')
}else{
formatter = NULL # use default
}
return(formatter)
}
#' Set \code{tooltip} of Echarts
#'
#' Set tooltip of Echarts, at various levels (entire chart, specific series) with
#' various formats. \cr
#' When an echart object is generated, you can modify it by setting tooltip using
#' \code{\link{\%>\%}}.
#' @note Note that the \code{tooltip} feature is inheritable in terms of timeline.
#' \code{setTooltip} automatically breaks the inheritability by resetting tooltip
#' formats in the timeslots following the timeslots whose tooltip format are changed.
#' .
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{\link{echartR}}
#' @param series A vector of series indices or names. e.g., \code{c('setosa', 'virginica')}
#' or \code{1:2}
#' @param timeslots A vector of time slices indices or names, e.g., \code{c(1990, 1992)}
#' or \code{c(1,3)}. You can also use \code{t} as a short form of \code{timeslots}.
#' @param trigger Type of trigger, \code{'item'}, or \code{'axis'}.
#' @param formatter The format of the tooltip content.
#' \describe{
#' \item{string(template)}{
#' \itemize{
#' \item \{a\} | \{a0\}
#' \item \{b\} | \{b0\}
#' \item \{c\} | \{c0\}
#' \item \{d\} | \{d0\} (not applicable for some types)
#' \item \{e\} | \{e0\} (not applicable for some types)
#' }}
#' \item{function}{the JS list is in the form \code{[params, ticket, callback]}.}
#' }
#' \strong{Meanings of \{a\}, \{b\}, \{c\}, \{d\}...}
#' \tabular{ll}{
#' line, bar, k \tab \code{a} (series name), \code{b} (category name), \code{c} (value) \cr
#' scatter \tab \code{a} (series name), \code{b} (data name), \code{c} (value array) \cr
#' map \tab\code{a}(series name), \code{b} (area name), \code{c} (combined value) \cr
#' pie, radar, gauge, funnel \tab \code{a} (series names), \code{b}(data item name),
#' \code{c} (value), \code{d} (pie:percent|radar:indicator) \cr
#' force, chord \tab \itemize{
#' \item nodes: \code{a} (series name), \code{b} (node name), \code{c} (node value),
#' \code{d} (node type index);
#' \item links: \code{a} (series name), \code{b} (link name), \code{c} (link value),
#' \code{d} (big node name/index), \code{e} (small node/index)
#' }
#' }
#' \strong{JS Function Param Template...}
#' \tabular{ll}{
#' \code{seriesIndex} \tab 0, 1, 2, ... \cr
#' \code{seriesName} \tab 'Monday', 'Tuesday', ... \cr
#' \code{name} \tab 'day1', 'day2', ... \cr
#' \code{dataIndex} \tab 0, 1, 2, ... \cr
#' \code{data} \tab data \cr
#' \code{value} \tab value \cr
#' \code{percent} \tab special //pie \cr
#' \code{indicator} \tab special //radar, force, chord \cr
#' \code{value2} \tab special2 //force, chord \cr
#' \code{indicator2} \tab special2 //force, chord
#' }
#' @param islandFormatter Formatter of data island for calcualable effect. Can be
#' string (default \code{'{a} <br/>{b} : {c}'}) or JS function.
#' @param position Can be fixed position array \code{c(x, y)} or a JS function, e.g.,
#' \code{JS('function([x, y]) {return [newX, newY]}')}. Default NULL.
#' @param enterable If users can click into the tooltip for interacions. Default FALSE.
#' @param axisPointer The pointer formatter of axis. Default is a list \code{
#' list(type = "line", \cr
#' lineStyle = list(color = "#48b", width = 2, type = "solid"), \cr
#' crossStyle = list(color = "#1e90ff", width = 1, type = "dashed"), \cr
#' shadowStyle = list(color = "rgba(150,150,150,0.3)", width = "auto", type = "default") \cr
#' )}.
#' @param textStyle text style of the tooltip. In a list form. Default \code{list(color
#' ="#fff")}. The list coud contain elements of \code{color, decoration, fontSize,
#' fontFamily, fontStyle, fontWeight, align, baseline}.
#' @param showDelay Delayed time at show (ms). Default 20ms.
#' @param hideDelay Delayed time at hide (ms). Default 100ms.
#' @param transitionDuration The time spent at animation exchange. Default 0.4. Set
#' if 0 if you want real-time interaction.
#' @param bgColor Background color of tooltips. Default 'rgba(0,0,0,0.7)' (
#' semi-transparent dark gray).
#' @param borderColor Borderline color of the tooltips. Default '#333'.
#' @param borderWidth Border width of the tooltips. Default 0 (not shown).
#' @param borderRadius Border radius of the tooltips. Default 4px.
#' @param show Logical. If the tooltips are shown. Default TRUE.
#' @param ... Elipsis
#'
#' @return A modified echarts object
#' @export
#'
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~tooltip}
#' @examples
#' \dontrun{
#' g = echartR(iris, Sepal.Width, Petal.Width, series=Species)
#'
#' ## global tooltip
#' g %>% setTooltip(trigger='item', bgColor='rgba(0,0,200,0.7)')
#'
#' ## series-specific tooltip
#' bg = sapply(c('orange', 'deepskyblue', 'violet'), col2rgb)
#' bg = rbind(bg, 0.7) # extend the color matrix with alpha 0.7
#' bgCol = unname(apply(bg, 2, rgba)) # get rgba colors with alpha
#' g %>% setTooltip(series='setosa', bgColor=bgCol[1]) %>%
#' setTooltip(series=2, bgColor=bgCol[2]) %>%
#' setTooltip(series=3, bgColor=bgCol[3])
#'
#' ## series-and-timeline-specific tooltip
#' bg = sapply(c('orange', 'deepskyblue', 'violet'), col2rgb)
#' bg = rbind(bg, 0.7) # extend the color matrix with alpha 0.7
#' bgCol = unname(apply(bg, 2, rgba)) # get rgba colors with alpha
#' iris$tag = 1 + as.integer(row.names(iris)) %% 3
#' iris = iris[order(iris$tag),]
#' g1 = echartR(iris, Sepal.Width, Petal.Width, series=Species, t=tag)
#' g1 %>% setTooltip(series='setosa', bgColor=bgCol[1]) %>%
#' setTooltip(series=2, bgColor=bgCol[2]) %>%
#' setTooltip(series=3, bgColor=bgCol[3]) %>%
#' setTooltip(t=1, borderColor='red', borderWidth=3) %>%
#' setTooltip(t=2, borderColor='gold', borderWidth=3) %>%
#' setTooltip(t=3, borderColor='green', borderWidth=3)
#'
#' g1 %>% setTooltip(series=2, t=2, bgColor='blue')
#' # tooltip format of series 2 in the 2nd timeslot is changed to bg blue,
#' # while it in the 3rd timeslot is reset to default
#' }
setTooltip = function(chart, series=NULL, timeslots=NULL, trigger=NULL,
formatter=NULL, islandFormatter='{a} < br/>{b} : {c}',
position=NULL, enterable=FALSE, axisPointer=NULL, textStyle=NULL,
showDelay=20, hideDelay=100, transitionDuration=0.4,
bgColor='rgba(0,0,0,0.7)', borderColor='#333',
borderWidth=0, borderRadius=4, show=TRUE,
...){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
if ('t' %in% names(list(...))) timeslots = list(...)[['t']]
chartTypes = getSeriesPart(chart, 'type')
if ('eventRiver' %in% chartTypes) enterable = TRUE
if (is.null(dim(chartTypes))) chartTypes = as.matrix(chartTypes, ncol=1)
uniSeries = getSeriesPart(chart, 'category', fetch.all=TRUE)
if (!is.null(dim(uniSeries))) uniSeries = uniSeries[,1]
hasT = 'baseOption' %in% names(chart$x)
timeXAxis = FALSE
if (! hasT) {
timeslots = NULL
if ('xAxis' %in% names(chart$x)) if (chart$x$xAxis[[1]]$type == 'time'){
trigger = 'item'
timeXAxis = TRUE
}
}else{
timeslotsIndex = seq_len(length(chart$x$baseOption$timeline$data))
if (!is.null(timeslots)){
if (all(is.numeric(timeslots))){
vecZ = timeslots[timeslots %in% timeslotsIndex]
}else{
vecZ = which(timeslotsIndex %in% timeslots)
}
}
if ('xAxis' %in% names(chart$x$options[[1]]))
if (chart$x$options[[1]]$xAxis[[1]]$type == 'time') {
trigger = 'item'
timeXAxis = TRUE
}
}
if (length(chartTypes) == 1) {
series = NULL
}else{
seriesIndex = seq_len(length(uniSeries))
if (!is.null(series)){
if (all(is.numeric(series))){
vecS = series[series %in% seriesIndex]
}else{
vecS = which(uniSeries %in% series)
}
}
}
setAlongSZ = c(!is.null(series), !is.null(timeslots))
## By default, do not set tooltip along series or t
if (ifnull(show, TRUE)){
if (hasT){
if (is.null(chart$x$options[[1]][['tooltip']]))
chart$x$options[[1]][['tooltip']] = list(show=TRUE)
else
chart$x$options[[1]][['tooltip']][['show']]=TRUE
}else{
if (is.null(chart$x[[1]][['tooltip']]))
chart$x[['tooltip']] = list(show=TRUE)
else
chart$x[['tooltip']][['show']]=TRUE
}
}
fixedPart = "makeTooltip(
trigger=trigger, islandFormatter=islandFormatter, position=position,
enterable=enterable, axisPointer=axisPointer, textStyle=textStyle,
showDelay=showDelay, hideDelay=hideDelay,
transitionDuration=transitionDuration,
bgColor=bgColor, borderColor=borderColor,
borderWidth=borderWidth, borderRadius=borderRadius,
show=show, formatter=ifnull(formatter, determineFormatter('"
defaultPart = "makeTooltip(keepDefault=TRUE, type='"
if (identical(setAlongSZ, c(FALSE, FALSE))){ # global set
lhs = ifelse(hasT, "chart$x$options[[1]][['tooltip']]",
"chart$x[['tooltip']]")
rhs = paste0(fixedPart, chartTypes[[1]],
ifelse(timeXAxis, "_time'", "'"), ")), type='",
chartTypes[[1]], "')")
}else if (identical(setAlongSZ, c(TRUE, FALSE))){ # set along series
if (hasT) lhs = paste0("chart$x$options[[1]]$series[[",
vecS, "]][['tooltip']]")
else lhs = paste0("chart$x$series[[", vecS, "]][['tooltip']]")
rhs = paste0(fixedPart, chartTypes[vecS, 1],
ifelse(timeXAxis, "_time'", "'"), ")), type='",
chartTypes[vecS, 1], "')")
}else if (identical(setAlongSZ, c(FALSE, TRUE))){ # set along timeline
if (hasT) { # if not hasT, this senario fails
lhs = paste0("chart$x$options[[", vecZ, "]][['tooltip']]")
rhs = paste0(fixedPart, chartTypes[1, vecZ],
ifelse(timeXAxis, "_time'", "'"), "')), type='",
chartTypes[1, vecZ], "')")
# the following item to vecZ be reset to default
vecZ1 = vecZ + 1
if (any(vecZ1 > length(chart$x$baseOption$timeline$data))){
vecZ1[length(vecZ1)] = min(timeslotsIndex[!timeslotsIndex %in%
c(vecZ, vecZ1)])
}
lhs1 = paste0("chart$x$options[[", vecZ1, "]][['tooltip']]")
rhs1 = paste0(defaultPart, chartTypes[1, vecZ1], "')")
lhs = c(lhs, lhs1)
rhs = c(rhs, rhs1)
}
}else{ # set along s and t
vecZS = as.matrix(expand.grid(vecZ, vecS))
vecZ1 = vecZ + 1
if (any(vecZ1 > length(chart$x$baseOption$timeline$data))){
vecZ1[length(vecZ1)] = min(timeslotsIndex[!timeslotsIndex %in%
c(vecZ, vecZ1)])
}
vecZS1 = as.matrix(expand.grid(vecZ1, vecS))
if (hasT) {
lhs = paste0("chart$x$options[[", vecZS[,1], "]]$series[[",
vecZS[,2], "]][['tooltip']]")
lhs1 = paste0("chart$x$options[[", vecZS1[,1], "]]$series[[",
vecZS1[,2], "]][['tooltip']]")
}else{
lhs = paste0("chart$x[[", vecZS[,1], "]]$series[[", vecZS[,2],
"]][['tooltip']]")
lhs1 = paste0("chart$x[[", vecZS1[,1], "]]$series[[", vecZS1[,2],
"]][['tooltip']]")
}
rhs = paste0(fixedPart, chartTypes[vecZS],
ifelse(timeXAxis, "_time'", "'"), "')), type='",
chartTypes[vecZS], "')")
rhs1 = paste0(defaultPart, chartTypes[vecZS1], "')")
lhs = c(lhs, lhs1)
rhs = c(rhs, rhs1)
}
eval(parse(text=paste(lhs, "<-", rhs)))
return(chart)
}
#' @export
#' @rdname setTooltip
setTT = setTooltip
#' Set \code{timeline} of Echarts
#'
#' Set timeline of Echarts when the echarts object contains timeline slices (t). \cr
#' When an echart object is generated, you can modify it by setting tooltip using
#' \code{\link{\%>\%}}.
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{\link{echartR}}
#' @param show Logical. If or not the timeline is shown. Default TRUE. If you want
#' to remove timeline from the echarts object, set if NULL.
#' @param type 'time' or 'number' format of the timeline. Default 'time'.
#' @param realtime Logical. If or not the changes take effect in realtime manner.
#' Default TRUE.
#' @param x x coordinate of the upper left point of the timeline bar. Default 80.
#' @param y y coordinate of the upper left point of the timeline bar. Default NULL
#' (automatic).
#' @param x2 x coordinate of the upper left point of the timeline bar. Default 80.
#' @param y2 y coordinate of the upper left point of the timeline bar. Default 0.
#' @param width Width of the timeline. Could be a number or a character in percent
#' form. Default NULL.
#' @param height Height of the timeline. Default 50 (px).
#' @param bgColor Background color of the timeline. Default "rgba(0,0,0,0)" (transparent).
#' @param borderColor Border color of the timeline. Default "#ccc".
#' @param borderWidth Border width of the timeline. Default 0 (px) (not shown).
#' @param controlPosition Position of the control of the timeline. Could be 'left',
#' 'right' or 'none'. Default 'left'.
#' @param autoPlay Logical. If or not the timeline auto displays. Default FALSE.
#' @param loop Logical. If or not the timeline displays in loop mode. Default TRUE.
#' @param playInterval Interval when displays each timeslice. Default 2000 (ms).
#' @param lineStyle A list. Line style of the timeline. Default value: \cr
#' \code{list(color="#666", width=1, type="dashed")}. \cr Supports features of \code{'color',
#' 'width', 'type', 'shadowColor', 'shadowBlur', 'shadowOffsetX', 'shadowOffsetY'}
#' @param label A list. Label style of the timeline. Default value: \cr
#' \code{list(show=TRUE, interval="auto", rotate=0, formatter=NULL, \cr
#' textStyle=list(color="#333"))}. \cr Supports features of \code{'show', 'interval',
#' 'rotate', 'formatter', 'textStyle'}.
#' @param checkpointStyle A list. Checkpoint style of the timeline. Default value: \cr
#' \code{list(symbol="auto", symbolSize="auto", color="auto", \cr
#' borderColor="auto", borderWidth="auto", \cr
#' label=list(show=FALSE, textStyle=list(color="auto")))}. \cr
#' Supports features of \code{'symbol', 'symbolSize', 'color', 'borderColor',
#' 'borderWidth', 'label'}.
#' @param controlStyle A list. Control style of the timeline. Default value: \cr
#' \code{list(itemSize=15, itemGap=5, normal=list(color="#333"),
#' emphasis=list(color="#1e90ff"))}. \cr
#' Supports features of \code{'itemSize', 'itemGap', 'normal', 'emphasis'}.
#' @param symbol Character. The symbol used in timeline. Default 'emptyDiamond'.
#' You can use symbols in \code{\link{setSymbols}}.
#' @param symbolSize The size of the symbols. Default 4.
#' @param currentIndex The current index position, in correspondance with \code{t}.
#' It is used to show specific timeline slices. Default 0.
#' @param data The data list of the timeline, also used as timeline data label.
#' Default NULL.
#' @param ... Elipsis
#'
#' @return A modified echarts object
#' @export
#'
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~timeline}
#' @examples
#' \dontrun{
#' ## type = "number"
#' iris$tag = 1 + as.integer(row.names(iris)) %% 3
#' iris = iris[order(iris$tag),]
#' g = echartR(iris, Sepal.Width, Petal.Width, series=Species, t=tag)
#' g %>% setTimeline(y2=30, symbol='emptyCircle',
#' autoPlay=FALSE, data=c('tag 1', 'tag 2', 'tag 3'))
#'
#' ## type = "time"
#' ### You have to use a js function to reformat the label if you want to change
#' ### the label text
#' iris$date = as.Date(paste0("2013-1-", 1 + as.integer(row.names(iris)) %% 5))
#' iris = iris[order(iris$date),]
#' g = echartR(iris, Sepal.Width, Petal.Width, series=Species, t=date)
#' g %>% setTimeline(y2=30, symbol='emptyCircle', autoPlay=FALSE, label=list(
#' formatter=JS(paste('function(s) {return s.slice(8,10) + "\u65e5";}'))))
#' }
#'
setTimeline = function(chart, show=TRUE, type=c('time', 'number'), realtime=TRUE,
x=80, y=NULL, x2=80, y2=0, width=NULL, height=50,
bgColor='rgba(0,0,0,0)', borderColor='#ccc',
borderWidth=0, controlPosition=c('left', 'right', 'none'),
autoPlay=FALSE, loop=TRUE, playInterval=2000,
lineStyle=NULL, label=NULL, checkpointStyle=NULL,
controlStyle=NULL, symbol='emptyDiamond', symbolSize=4,
currentIndex=0, data=NULL,
...){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
if (! 'baseOption' %in% names(chart$x)) return(chart)
else if (is.null(show)) {
chart$x$baseOption$timeline = NULL
return(chart %>% tuneGrid())
}
lst = chart$x$baseOption$timeline
type = match.arg(type)
if (inherits(getMeta(chart$x$options[[1]])$t[,1],
c("Date", "POSIXct", "POSIXlt"))){
type = 'time'
}else{
type = 'number'
}
controlPosition = match.arg(controlPosition)
if (! tolower(symbol) %in% tolower(validSymbols)){
symbol = 'emptyDiamond'
}else{
symbol = validSymbols[which(tolower(validSymbols) %in% tolower(symbol))]
}
## default params
if (! ifnull(show, TRUE)) lst$show = show
if (! ifnull(type, 'time') == 'time') lst$type = type
if (! ifnull(realtime, TRUE)) lst$realtime = realtime
if (! ifnull(x, 80) == 80) lst$x = x
if (! is.null(y)) lst$y = y
if (! ifnull(x2, 80) == 80) lst$x2 = x2
if (! ifnull(y2, 0) == 0) lst$y2 = y2
if (! is.null(width)) lst$width = width
if (! ifnull(height, 50) == 50) lst$height = height
if (! ifnull(bgColor, 'rgba(0,0,0,0)') == 'rgba(0,0,0,0)')
lst$backgroundColor = getColors(bgColor)
if (! ifnull(borderColor, '#ccc') == '#ccc') lst$borderColor = borderColor
if (! ifnull(borderWidth, 0) == 0) lst$borderWidth = borderWidth
if (! ifnull(controlPosition, 'left') == 'left')
lst$controlPosition = controlPosition
if (ifnull(autoPlay, FALSE)) lst$autoPlay = autoPlay
if (! ifnull(loop, TRUE)) lst$loop = loop
if (! ifnull(playInterval, 2000) == 2000) lst$playInterval = playInterval
if (! identical(ifnull(lineStyle, list(color="#666", width=1, type="dashed")),
list(color="#666", width=1, type="dashed"))){
validLineStyleFeature = c('color', 'width', 'type', 'shadowColor',
'shadowBlur', 'shadowOffsetX', 'shadowOffsetY')
if (! all(names(lineStyle) %in% validLineStyleFeature))
stop(paste("Only supports lineStyle features as below:\n",
validLineStyleFeature))
lst$lineStyle = lineStyle
}
defaultLabel = list(show=TRUE, interval="auto", rotate=0,
formatter=NULL, textStyle=list(color="#333"))
if (! identical(ifnull(label, defaultLabel), defaultLabel)){
validLabelFeature = c('show', 'interval', 'rotate', 'formatter',
'textStyle')
if (! all(names(label) %in% validLabelFeature))
stop(paste("Only supports label features as below:\n",
validLabelFeature))
lst$label = label
}
defaultCheckpoint = list(symbol="auto", symbolSize="auto", color="auto",
borderColor="auto", borderWidth="auto",
label=list(show=FALSE, textStyle=list(color="auto")))
if (! identical(ifnull(checkpointStyle, defaultCheckpoint),
defaultCheckpoint)){
validCheckpointFeature = c('symbol', 'symbolSize', 'color', 'borderColor',
'borderWidth', 'label')
if (! all(names(checkpointStyle) %in% validCheckpointFeature))
stop(paste("Only supports checkpointStyle features as below:\n",
validCheckpointFeature))
lst$checkpointStyle = checkpointStyle
}
defaultControl = list(itemSize=15, itemGap=5, normal=list(color="#333"),
emphasis=list(color="#1e90ff"))
if (! identical(ifnull(controlStyle, defaultControl), defaultControl)){
validControlFeature = c('itemSize', 'itemGap', 'normal', 'emphasis')
if (! all(names(controlStyle) %in% validControlFeature))
stop(paste("Only supports controlStyle features as below:\n",
validControlFeature))
lst$controlStyle = controlStyle
}
if (! ifnull(symbol, "emptyDiamond") == "emptyDiamond")
lst$symbol = symbol
if (! ifnull(symbolSize, 4) == 4) lst$symbolSize = symbolSize
if (! ifnull(currentIndex, 0) == 0) lst$currentIndex = currentIndex
if (! is.null(data)) lst$data = data
chart$x$baseOption$timeline = lst
return(chart %>% tuneGrid())
}
#' Add \code{geoCoord} to An Echarts Object
#'
#' Add \code{geoCoord} object to echarts object. It is used for maps. \cr \cr
#' For maps with a timeline, \code{geoCoord} object is added to \code{options[[1]]$series[[1]]},
#' while for those without a timeline, it is added to \code{series[[1]]}.
#' @param chart chart \code{echarts} object generated by \code{\link{echart}} or
#' \code{\link{echartR}}
#' @param geoCoord Two mode: \cr
#' \describe{
#' \item{list}{A typical geoCoord list should be: \code{list(place1=c(lng1, lat1), ...)}}
#' \item{data.frame}{A data.frame of 3 columns: \code{place}, \code{longitude}, \code{latitude}}
#' }
#' @param mode 'add' or 'overide' \code{geoCoord} to the echarts object. Default 'add'.
#' You can use \code{\link{overideGeoCoord}} to overide existing \code{geoCoord}.
#'
#' @return A modified echarts object
#' @export
#'
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~series-i(map).geoCoord}
#' @examples
#' \dontrun{
#'
#' }
addGeoCoord = function(chart, geoCoord=NULL, mode=c('add', 'overide')){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
mode = match.arg(mode)
if (is.null(geoCoord)) return(chart)
hasT = 'baseOption' %in% names(chart$x)
if (is.data.frame(geoCoord)){
if (ncol(geoCoord) < 3) stop('geoCoord must contain place, lng, lat!')
nameGeoCoord = as.character(geoCoord[,1])
geoCoord = unname(apply(geoCoord, 1, function(row){
as.list(as.numeric(row[2:3]))
}))
names(geoCoord) = nameGeoCoord
lstGeoCoord = geoCoord
if (hasT){
if (chart$x$options[[1]]$series[[1]]$type == 'map')
if (mode == 'add')
if ('geoCoord' %in% names(chart$x$options[[1]]$series[[1]]))
lstGeoCoord = mergeList(
chart$x$options[[1]]$series[[1]]$geoCoord, geoCoord)
chart$x$options[[1]]$series[[1]]$geoCoord = lstGeoCoord
}else{
if (chart$x$series[[1]]$type == 'map')
if (mode == 'add')
if ('geoCoord' %in% names(chart$x$series[[1]]))
lstGeoCoord = mergeList(
chart$x$series[[1]]$geoCoord, geoCoord)
chart$x$series[[1]]$geoCoord = lstGeoCoord
}
}else if (is.list(geoCoord)){
if (is.null(names(geoCoord))) stop('geoCoord list must be named with places!')
if (hasT){
if (chart$x$options[[1]]$series[[1]]$type == 'map')
if (mode == 'add')
if ('geoCoord' %in% names(chart$x$options[[1]]$series[[1]]))
lstGeoCoord = mergeList(
chart$x$options[[1]]$series[[1]]$geoCoord, geoCoord)
chart$x$options[[1]]$series[[1]]$geoCoord = lstGeoCoord
}else{
if (chart$x$series[[1]]$type == 'map')
if (mode == 'add')
if ('geoCoord' %in% names(chart$x$series[[1]]))
lstGeoCoord = mergeList(
chart$x$series[[1]]$geoCoord, geoCoord)
chart$x$series[[1]]$geoCoord = lstGeoCoord
}
}
return(chart)
}
#' @export
#' @rdname addGeoCoord
overideGeoCoord = function(chart, geoCoord=NULL){
return(addGeoCoord(chart, geoCoord, mode='overide'))
}
#' Add \code{heatmap} to Echarts Object
#'
#' Add heatmap object to an Echarts object. (applicable for map)
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}} or
#' \code{\link{echartR}}.
#' @param series Vector. Specify which series you want to insert heatmap. Could be
#' numeric (index of the series) or string (series name). If NULL, then apply to all.
#' Default NULL.
#' @param timeslots Vector. Specify which timeslots (t) you want to insert heatmap.
#' Could be numeric (index of the timeslot) or string (timeslot name).
#' If NULL, then apply to all. Default NULL. You could use \code{t} for short.
#' @param data The heatmap source data. Two modes:
#' \describe{
#' \item{data.frame or matrix}{A data.frame or matrix of 3 columns: lng (-180 ~ 180),
#' lat (-90 ~ 90) and heat value (0-1). If heat value is out of the range [0,1],
#' then it will be normalized.}
#' \item{list}{A list in the form: \code{list(c(<lng1>, <lat1>, <value1>),
#' c(<lng2>, <lat2>, <value2>), ...)}}
#' }
#' @param gradientColors Color palette of heat visualization. Three mode:
#' \describe{
#' \item{vector}{A vector of colors (hex, name, or rgba string)}
#' \item{data.frame or matrix}{A data.frame or matrix of 2 columns: offset (0-1),
#' and color (hex, name or rgba string). }
#' \item{list}{A list in the form: \code{list(list(offset=0.2, color='red'),
#' list(offset=0.5, color='green'), ...)}}
#' } \cr
#' Default c('blue', 'cyan', 'lime', 'yellow', 'orange', 'red').
#' @param blurSize Size of blur. Default 30.
#' @param minAlpha Minimal alpha value which any opacity value below this threshold
#' will be set \code{minAlpha} in order to prevent over-transparency. Default 0.05.
#' @param valueScale Numeric. Scale of value that all the heat value will be multiplied
#' by this value before plotting. Default 1.
#' @param opacity Numeric 0-1. Degree of opacity. Default 1.
#' @param mode 'add' or 'overide' \code{heatmap} to the echarts object. Default 'add'.
#' You can use \code{\link{overideHeatmap}} to overide existing \code{heatmap}.
#' @param ... Elipsis
#'
#' @return A modified echarts object
#' @export
#'
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~series-i(map).heatmap}
#' @examples
#' \dontrun{
#'
#' }
addHeatmap = function(chart, series=NULL, timeslots=NULL, data=NULL,
gradientColors=list(
'blue', 'cyan', 'limegreen', 'yellow', 'orange', 'red'),
blurSize=30, minAlpha=0.05,
valueScale=1, opacity=1, mode=c('add', 'overide'),
...){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
mode = match.arg(mode)
if ('t' %in% names(list(...))) timeslots = list(...)[['t']]
hasT = 'baseOption' %in% names(chart$x)
if (is.null(data)) {
return(chart)
}else{
if (is.data.frame(data) || is.matrix(data)){
if (ncol(data) < 3)
stop('data must be a matrix/data.frame ',
'with the columns lng, lat, heat (0-1) in order!')
if (! all (data.table::between(data[,3], 0, 1)))
data[,3] = (data[,3]-min(data[,3], na.rm=TRUE))/
(max(data[,3], na.rm=TRUE)-min(data[,3], na.rm=TRUE))
if (! all(data.table::between(data[,1], -180, 180)))
stop('data[,1] (lng) must be between -180 and 180')
if (! all(data.table::between(data[,2], -90, 90)))
stop('data[,2] (lat) must be between -90 and 90')
data = asEchartData(unname(data[,1:3]))
}else{
stopifnot(is.list(data))
}
}
# construct lstHeatmap
lstHeatmap = list(
data=unname(data), gradientColors=gradientColors, blurSize=blurSize,
minAlpha=minAlpha, valueScale=valueScale, opacity=opacity)
# define series and t
if (hasT){
if (is.null(timeslots))
timeslots = seq_along(chart$x$options)
else
if (is.numeric(timeslots)){
timeslots = intersect(timeslots, seq_along(chart$x$options))
}else{
timeslots = which(chart$x$baseOption$timeline$data %in% timeslots)
}
}else{
timeslots = NULL
}
mapType = getSeriesPart(chart, 'mapType')
if (length(unique(mapType)) == 1){ # map mode is 'series'
series = 1
}else{ # map mode is 'split'
if (is.null(series)){
series = if (hasT)
seq_len(max(sapply(chart$x$options, function(l) {
length(l$series)}))) else
seq_len(length(chart$x$series))
}else{
if (is.numeric(series)){
series = intersect(series, seq_along(getSeriesPart(
chart, 'category', fetch.all=TRUE)))
}else{
series = which(getSeriesPart(chart, 'category', fetch.all=TRUE) %in%
intersect(getSeriesPart(chart, 'category', fetch.all=TRUE),
series))
}
}
}
# insert lstHeatmap
if (is.null(timeslots)){ # no timeline
for (s in ifnull(series, 1)){ # series is null, mono series
lData = chart$x$series[[s]]$heatmap$data
chart$x$series[[s]]$heatmap = lstHeatmap
if (mode == 'add') if ('heatmap' %in% names(chart$x$series[[s]]))
chart$x$series[[s]]$heatmap$data = append(
lData, chart$x$series[[s]]$heatmap$data)
}
}else{ # with timeline
for (t in timeslots){
for (s in ifnull(series, 1)){ # series is null: mono series
lData = chart$x$options[[t]]$series[[s]]$heatmap$data
chart$x$options[[t]]$series[[s]]$heatmap = lstHeatmap
if (mode == 'add')
if ('heatmap' %in% names(chart$x$options[[t]]$series[[s]]))
chart$x$options[[t]]$series[[s]]$heatmap$data = append(
lData, chart$x$options[[t]]$series[[s]]$heatmap$data)
}
}
}
return(chart)
}
#' @export
#' @rdname addHeatmap
overideHeatmap = function(chart, ...){
return(addHeatmap(chart, mode='overide', ...))
}
#' Add \code{nameMap} to Echarts Object
#'
#' For map charts, you can add \code{nameMap} to translate the place names from one to another.
#' The \code{nameMap} object will be inserted to the first series of the echarts object.
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}} or
#' \code{\link{echartR}}.
#' @param nameMap Two modes: \cr
#' \describe{
#' \item{data.frame/matrix}{A data.frame or matrix comprising of 2 columns: \code{nameToTranslate &
#' nameTranslatedTo}. E.g., You can load a preinstalled Chinese-English geographic
#' dictionary using \code{recharts:::geoNameMap}.}
#' \item{list}{The nameMap in list should follow the structure: \code{list(list(
#' `United States of America`='USA'), list('United Kingdom'='GB'), ...)}}
#' }
#' @param mode 'add' or 'overide' \code{nameMap} to the echarts object. Default 'add'.
#' You can use \code{\link{overideNameMap}} to overide existing \code{nameMap}.
#'
#' @return A modified echarts object
#' @export
#' @seealso \code{data(geoNameMap)}
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~series-i(map).nameMap}
#' @examples
#' \dontrun{
#' }
addNameMap = function(chart, nameMap, mode=c('add', 'overide')){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
mode = match.arg(mode)
if (is.data.frame(nameMap) || is.matrix(nameMap)){
stopifnot(ncol(nameMap) > 1)
if (! (is.character(nameMap[,1]) && is.character(nameMap[,2])))
stop('nameMap[,1] and nameMap[,2] must both be characters.')
lstNameMap = asEchartData(nameMap[,2])
names(lstNameMap) = nameMap[,1]
}else if (is.list(nameMap)){
stopifnot(length(unlist(nameMap)) == length(nameMap))
if (is.null(names(nameMap)))
stop('list nameMap must be named with the names you want to translate!')
lstNameMap = nameMap
}
hasT = 'baseOption' %in% names(chart$x)
if(hasT){
if (mode == 'add')
if ('nameMap' %in% names(chart$x$options[[1]]$series[[1]]))
lstNameMap = mergeList(
chart$x$options[[1]]$series[[1]]$nameMap, lstNameMap)
chart$x$options[[1]]$series[[1]]$nameMap = lstNameMap
}else{
if (mode == 'add')
if ('nameMap' %in% names(chart$x$series[[1]]))
lstNameMap = mergeList(
chart$x$series[[1]]$nameMap, lstNameMap)
chart$x$series[[1]]$nameMap = lstNameMap
}
return(chart)
}
#' @export
#' @rdname addNameMap
overideNameMap = function(chart, ...){
return(addNameMap(chart, mode='overide', ...))
}
#' Add \code{markLine} to An Echarts Object
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{\link{echartR}}
#' @param series Numeric (series index) or character (series name), numeric preferred.
#' If set NULL, then apply the \code{markPoint} to all the series.
#' @param timeslots Numeric (timeslot index) or character (timeslot name), numeric is preferred.
#' If set NULL, then apply the \code{markPoint} to all the timeslots. You can use \code{t}
#' for short.
#' @param data Data.frame, the data of the \code{markLine}s. It must contain the
#' following columns: \code{\strong{name1}}, \code{name2, value | type} and/or
#' \code{x1 | xAxis1, y1 | yAxis1, x2 | xAxis2, y2 | yAxis2} and/or \code{series}. \cr \cr
#' When series is given, it must be cooresponding to the \code{series} argument.
#' \describe{
#' \item{generic}{generic form is columns \code{[name1, name2, value, x1, y1, x2, y2]}.
#' The minimum form is \code{[name1, x1, y1, x2, y2]}}
#' \item{scatter, line, bar}{\code{[name1, name2, value, x1, y1, x2, y2]} or
#' \code{[name1, type]} (type can only be 'max', 'min' or 'average') or
#' \code{[name1, name2, value, xAxis1, yAxis1, xAxis2, yAxis2]}}
#' \item{k, eventRiver}{\code{[name1, name2, value, x1, y1, x2, y2]} or
#' \code{[name1, name2, value, xAxis1, yAxis1, xAxis2, yAxis2]}}
#' \item{map}{\code{[name1, name2, value]}. \strong{You need to pass in \code{
#' [name1, lng1, lat1], [name2, lng2, lat2]} using \code{\link{addGeoCoord}}} separately.}
#' }
#' @param clickable Logical, if the graphs are clickable. Default TRUE.
#' @param symbol Symbol vector of the markLines, refer to \code{recharts:::validSymbols}.
#' Default \code{c('circle', 'arrow')}.
#' @param symbolSize Numeric vector or \code{JS} function defining the size of the
#' the beginning symbol and the end symbol of the marklines. Default \code{c(2, 4)}.
#' @param symbolRotate Numeric -180 ~ 180. Default NULL.
#' @param large Logical if large effect is on. Default FALSE.
#' @param effect List. effect configurator of markLines. Default NULL, which is
#' \code{list(show=FALSE, loop=TRUE, period=15, scaleSize=2, color=NULL,
#' shadowColor=NULL, shadowBlur=0)}
#' @param itemStyle List. It is a list with the structure \code{list(normal=list(...),
#' emphasis=list(...))}. Default NULL.
#' @param mode 'add' or 'overide' the data part of \code{markLine} to the echarts
#' object. Default 'add'.
#' You can use \code{\link{overideMarkLine}} to overide the data of the existing
#' \code{markLine}.
#' @param ... Elipsis
#' @export
#'
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#tooltip-line1~series-i(line).markLine}
#' @examples
#' \dontrun{
#' g = echartr(iris, Sepal.Width, Petal.Width, Species)
#' g %>% addML(c('setosa', 'versicolor'), data=data.frame(name1=rep('mean', 2),
#' type=rep('average', 2), series=c('setosa', 'versicolor')))
#' }
#'
addMarkLine = function(
chart, series=NULL, timeslots=NULL, data=NULL, clickable=TRUE,
symbol=c('circle', 'arrow'), symbolSize=c(2,4), symbolRotate=NULL,
large=FALSE, smooth=FALSE, smoothness=0.2, precision=2,
bundling=list(enable=FALSE, maxTurningAngle=45),
effect=list(show=FALSE), itemStyle=NULL, mode=c('add', 'overide'),
...){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
if ('t' %in% names(list(...))) timeslots = list(...)[['t']]
hasT = 'baseOption' %in% names(chart$x)
# data validation
if (is.null(data)) {
return(chart)
}else{
if (is.data.frame(data)){
names(data) = tolower(names(data))
data = data[, intersect(names(data), c(
'name1', 'name2', 'value', 'type', 'x1', 'y1', 'xaxis1', 'yaxis1',
'x2', 'y2', 'xaxis2', 'yaxis2', 'series'))]
if (! 'name1' %in% names(data))
stop('`data` must be a data.frame with the columns: ',
'name1 and/or name2, and/or value|type, and/or x1|xAxis1, ',
'y1|yAxis1, x2|xAxis2, y2|yAxis2 and/or series!')
stopifnot(all(tolower(data$type) %in% c(NA, 'min', 'max', 'average')))
data = data[!is.na(data$name1),]
names(data) = tolower(names(data))
}else{
stop('`data` must be a data.frame.')
}
}
# other params
if (!missing(symbol)) {
intersectSymbols = symbol[tolower(symbol) %in% tolower(validSymbols)]
iSymbol = sapply(intersectSymbols, function(symbol) {
return(which(tolower(validSymbols) == tolower(symbol)))
})
symbol = as.vector(validSymbols[unlist(iSymbol)])
}
# define t
if (hasT){
if (is.null(timeslots))
timeslots = seq_along(chart$x$options)
else
if (is.numeric(timeslots)){
timeslots = intersect(timeslots, seq_along(chart$x$options))
}else{
timeslots = which(chart$x$baseOption$timeline$data %in% timeslots)
}
}else{
timeslots = NULL
}
# define series
lstAnalyzeSeries = analyzeSeries(chart, series)
series = lstAnalyzeSeries$numSeries
lvlseries = lstAnalyzeSeries$strSeries
allSeries = lstAnalyzeSeries$allnumSeries
lvlSeries = lstAnalyzeSeries$allStrSeries
newSeries = lstAnalyzeSeries$strNewSeries
# construct base lstMarkline
lstMark = list(
data=list(), clickable=clickable, symbol=symbol, smooth=smooth,
symbolSize=symbolSize, large=large, effect=effect, smoothness=smoothness,
precision=precision, bundling=bundling)
if (!is.null(symbolRotate)) if (symbolRotate <= 180 && symbolRotate >= -180)
lstMark$symbolRotate = symbolRotate
if (!is.null(itemStyle))
if (is.list(itemStyle)){
lstMark$itemStyle = itemStyle[names(itemStyle) %in% c('normal', 'emphasis')]
if (! all(names(itemStyle) %in% c('normal', 'emphasis')))
warning('itemStyle must be comprised of list(normal) and/or list(emphasis)')
}
.mkMLbyRow = function(row, type){
o = list(list(name=unname(row['name1'])), list())
if (!is.null(row['name2'])) o[[2]]$name = ifna(unname(row['name2']), '')
if (!is.null(row['value'])) o[[1]]$value = ifna(unname(row['value']), '')
if (!is.null(row['x1'])) o[[1]]$x = ifna(as.numeric(row['x1']), '-')
if (!is.null(row['y1'])) o[[1]]$y = ifna(as.numeric(row['y1']), '-')
if (!is.null(row['x2'])) o[[2]]$x = ifna(as.numeric(row['x2']), '-')
if (!is.null(row['y2'])) o[[2]]$y = ifna(as.numeric(row['y2']), '-')
if (type %in% c('scatter', 'line', 'bar', 'k', 'eventRiver')){
if (!is.null(row['xaxis1']))
if (!is.na(row['xaxis1'])){
o[[1]]$xAxis = ifna(as.numeric(row['xaxis1']),
unname(row['xaxis1']))
o[[1]]$x = NULL
}
if (!is.null(row['yaxis1']))
if (!is.na(row['yaxis1'])){
o[[1]]$yAxis = ifna(as.numeric(row['yaxis1']),
unname(row['yaxis1']))
o[[1]]$y = NULL
}
if (!is.null(row['xaxis2']))
if (!is.na(row['xaxis2'])){
o[[2]]$xAxis = ifna(as.numeric(row['xaxis2']),
unname(row['xaxis2']))
o[[2]]$x = NULL
}
if (!is.null(row['yaxis2']))
if (!is.na(row['yaxis2'])){
o[[2]]$yAxis = ifna(as.numeric(row['yaxis2']),
unname(row['yaxis2']))
o[[2]]$y = NULL
}
if (type %in% c('scatter', 'line', 'bar'))
if (!is.null(row['type'])) if (!is.na(row['type'])){
o = list(
name=unname(ifna(row['name1'], ifna(row['name2'], ''))),
type=unname(row['type']))
}
}else if (type %in% c('map')){
o = list(list(name=unname(row['name1'])),
list(name=unname(row['name2'])))
if (!is.na(row['value'])) o[[1]]$value = as.numeric(row['value'])
}else{
}
return(o)
}
# insert lstMarkline
lstML = lstMark
if (is.null(timeslots)){ # no timeline
if (length(series) > 0)
for (s in unlist(series)){ # series is null, mono series
if ('series' %in% names(data)){
dt = data[data$series == lvlseries[which(series==s)],]
}else dt = data
lstML$data = unname(apply(dt, 1, .mkMLbyRow,
type=chart$x$series[[s]]$type))
if ('markLine' %in% names(chart$x$series[[s]]))
lstML$data = append(
chart$x$series[[s]]$markLine$data, lstML$data)
chart$x$series[[s]]$markLine = lstML
}
if (length(newSeries) > 0){
for (ns in seq_along(newSeries)){
chart$x$series = append(chart$x$series, list(list(
name=newSeries[ns], type=chart$x$series[[1]]$type,
data=list(list('-')))))
idxNew = length(chart$x$series)
dt = if ('series' %in% names(data))
data[data$series==newSeries[ns],] else data
lstML$data = unname(apply(dt, 1, .mkMLbyRow,
type=chart$x$series[[ns]]$type))
chart$x$series[[idxNew]]$markLine = lstML
chart$x$legend$data = append(
chart$x$legend$data, newSeries[ns]
)
if (chart$x$series[[1]]$type == 'map')
chart$x$series[[idxNew]]$mapType = chart$x$series[[1]]$mapType
}
}
}else{ # with timeline
for (t in timeslots){
if (length(series) >0)
for (s in series[[t]]){
# series is null, mono series
dt = if ('series' %in% names(data))
data[data$series==allSeries[[t]][which(series==s)],] else data
lstML$data = unname(apply(
dt, 1, .mkMLbyRow,
type=chart$x$options[[t]]$series[[s]]$type))
if ('markLine' %in% names(chart$x$options[[t]]$series[[s]]))
lstML$data = append(
chart$x$options[[t]]$series[[s]]$markLine$data,
lstML$data)
chart$x$options[[t]]$series[[s]]$markLine = lstML
}
if (length(newSeries) > 0){
for (ns in seq_along(newSeries)){
chart$x$options[[t]]$series <-
append(chart$x$options[[t]]$series, list(list(
name=newSeries[ns], data=list(list('-')),
type=chart$x$options[[t]]$series[[1]]$type)))
dt = if ('series' %in% names(data))
data[data$series==newSeries[ns],] else data
lstML$data = unname(apply(
dt, 1, .mkMLbyRow,
type=chart$x$options[[t]]$series[[ns]]$type))
idxNew = length(chart$x$options[[t]]$series)
chart$x$options[[t]]$series[[idxNew]]$markLine = lstML
chart$x$options[[1]]$legend$data = append(
chart$x$options[[1]]$legend$data, newSeries[ns]
)
if (chart$x$options[[t]]$series[[1]]$type == 'map')
chart$x$options[[t]]$series[[idxNew]]$mapType <-
chart$x$options[[t]]$series[[1]]$mapType
}
}
}
}
return(chart)
}
#' @export
#' @rdname addMarkLine
addML = addMarkLine
#' @export
#' @rdname addMarkLine
addMarkline = addMarkLine
#' @export
#' @rdname addMarkLine
overideMarkLine = function(chart, ...){
return(addMarkLine(chart, mode='overide', ...))
}
#' @export
#' @rdname addMarkLine
overideMarkline = overideMarkLine
#' @export
#' @rdname addMarkLine
overideML <-overideMarkLine
#' Add \code{markPoint} to An Echarts Object
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{\link{echartR}}
#' @param series Numeric (series index) or character (series name), numeric preferred.
#' If set NULL, then apply the \code{markPoint} to all the series.
#' @param timeslots Numeric (timeslot index) or character (timeslot name), numeric preferred.
#' If set NULL, then apply the \code{markPoint} to all the timeslots. You can use \code{t}
#' for short.
#' @param data Data.frame, the data of the \code{markPoint}s. It must contain the
#' following columns: \code{\strong{name}}, and/or \code{value | type} and/or
#' \code{x | xAxis, y | yAxis} and/or \code{series}. \cr \cr
#' When series is given, it must be corresponding to the \code{series} argument.
#' \describe{
#' \item{generic}{generic form is columns \code{[name, x, y]} or \code{[name, value,
#' x, y]}}
#' \item{scatter, line, bar}{\code{[name, value, x, y]} or \code{[name, type]}
#' (type can only be 'max' or 'min') or \code{[name, value, xAxis, yAxis]}}
#' \item{k, eventRiver}{\code{[name, value, x, y]} or \code{[name, value, xAxis, yAxis]}}
#' \item{map}{\code{[name, value]}. \strong{You need to pass in \code{[name, lng, lat]}
#' using \code{\link{addGeoCoord}}} separately.}
#' }
#' Note that markLine dataset is compatible with \code{addMarkPoint}.
#' \itemize{
#' \item \code{x1, x2} are treated as \code{x} (keep the first detected one only)
#' \item \code{y1, y2} are treated as \code{y} (keep the first detected one only)
#' \item \code{xAxis1, xAxis2} are treated as \code{xAxis} (keep the first detected
#' one only)
#' \item \code{yAxis1, yAxis2} are treated as \code{yAxis} (keep the first detected
#' one only
#' }
#' @param clickable Logical, if the points are clickable. Default TRUE.
#' @param symbol Symbol of the markpoints, refer to \code{recharts:::validSymbols}.
#' Default 'pin'.
#' @param symbolSize Numeric or vector \code{c(height, width)} or JS function. Default 10.
#' @param symbolRotate Numeric -180 ~ 180. Default NULL.
#' @param large Logical if large effect is on. Default FALSE.
#' @param effect List. effect configurator of markPoints. Default NULL, which is
#' \code{list(show=FALSE, type='scale', loop=TRUE, period=15, scaleSize=2,
#' bounceDistance=10, color=NULL, shadowColor=NULL, shadowBlur=0)}
#' @param itemStyle List. It is a list with the structure \code{list(normal=list(...),
#' emphasis=list(...))}. Default NULL.
#' @param mode 'add' or 'overide' the data part of \code{markPoint} to the echarts
#' object. Default 'add'.
#' You can use \code{\link{overideMarkPoint}} to overide the data of the existing
#' \code{markPoint}.
#' @param ... Elipsis
#'
#' @export
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#tooltip-line1~series-i(line).markPoint}
#' @seealso \code{\link{addMarkLine}} \code{\link{addMarkline}}
#' @examples
#' \dontrun{
#' g = echartr(iris, Sepal.Width, Petal.Width, Species)
#' g %>% addMP(c('setosa', 'versicolor'), data=data.frame(name=c('max', 'min'),
#' type=c('max', 'min'), series=c('setosa', 'versicolor')))
#' }
#'
addMarkPoint = function(
chart, series=NULL, timeslots=NULL, data=NULL, clickable=TRUE, symbol='pin',
symbolSize=10, symbolRotate=NULL, large=FALSE, effect=list(show=FALSE),
itemStyle=NULL, ...){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
if ('t' %in% names(list(...))) timeslots = list(...)[['t']]
hasT = 'baseOption' %in% names(chart$x)
# data validation
if (is.null(data)) {
return(chart)
}else{
if (is.data.frame(data)){
names(data) = tolower(names(data))
if (! 'name' %in% names(data))
names(data) = sub('name\\d*', 'name', names(data))
if (! 'x' %in% names(data))
names(data) = sub('x\\d*', 'x', names(data))
if (! 'y' %in% names(data))
names(data) = sub('y\\d*', 'y', names(data))
if (! 'xaxis' %in% names(data))
names(data) = sub('xaxis\\d*', 'xaxis', names(data))
if (! 'yaxis' %in% names(data))
names(data) = sub('yaxis\\d*', 'yaxis', names(data))
data = data[, intersect(names(data), c(
'name', 'value', 'type', 'x', 'y', 'xaxis', 'yaxis', 'series'))]
if (! 'name' %in% names(data))
stop('`data` must be a data.frame with the columns: ',
'name, and/or value|type, and/or x|xAxis, y|yAxis and/or series!')
stopifnot(all(tolower(data$type) %in% c(NA, 'min', 'max')))
data = data[!is.na(data$name),]
names(data) = tolower(names(data))
}else{
stop('`data` must be a data.frame.')
}
}
# other params
if (!missing(symbol)) {
intersectSymbols = symbol[tolower(symbol) %in% tolower(validSymbols)]
iSymbol = sapply(intersectSymbols, function(symbol) {
return(which(tolower(validSymbols) == tolower(symbol)))
})
symbol = as.vector(validSymbols[unlist(iSymbol)])
}
# define t
if (hasT){
if (is.null(timeslots))
timeslots = seq_along(chart$x$options)
else
if (is.numeric(timeslots)){
timeslots = intersect(timeslots, seq_along(chart$x$options))
}else{
timeslots = which(chart$x$baseOption$timeline$data %in% timeslots)
}
}else{
timeslots = NULL
}
# define series
lstAnalyzeSeries = analyzeSeries(chart, series)
series = lstAnalyzeSeries$numSeries
lvlseries = lstAnalyzeSeries$strSeries
allSeries = lstAnalyzeSeries$allnumSeries
lvlSeries = lstAnalyzeSeries$allStrSeries
newSeries = lstAnalyzeSeries$strNewSeries
# construct base lstMarkpoint
lstMark = list(
data=list(), clickable=clickable, symbol=symbol,
symbolSize=symbolSize, large=large, effect=effect)
if (!is.null(symbolRotate)) if (symbolRotate <= 180 && symbolRotate >= -180)
lstMark$symbolRotate = symbolRotate
if (!is.null(itemStyle))
if (is.list(itemStyle)){
lstMark$itemStyle = itemStyle[names(itemStyle) %in% c('normal', 'emphasis')]
if (!all(names(itemStyle) %in% c('normal', 'emphasis')))
warning('itemStyle must be comprised of list(normal) and/or list(emphasis)')
}
.mkMPbyRow = function(row, type){
o = list()
if (type %in% c('scatter', 'line', 'bar', 'k', 'eventRiver')){
if (type %in% c('scatter', 'line', 'bar')){
if (!is.na(row['type'])) o = as.list(row[c('name', 'type')])
}
if (!is.null(row['xaxis'])){
if (!is.na(row['xaxis']))
o$xAxis = ifna(as.numeric(row['xaxis']), unname(row['xaxis']))
}else if (!is.null(row['x'])){
if (!is.na(row['x'])) o$x = ifna(as.numeric(row['x']), unname(row['x']))
}
if (!is.null(row['yaxis'])){
if (!is.na(row['yaxis']))
o$yAxis = ifna(as.numeric(row['yaxis']), unname(row['yaxis']))
}else if (!is.null(row['y'])){
if (!is.na(row['y'])) o$y = ifna(as.numeric(row['y']), unname(row['y']))
}
}else if (type %in% c('map')){
o = as.list(row[c('name', 'value')])
o$value = ifna(as.numeric(o$value), '-')
}else{
o = list(name=unname(row['name']),
value=ifna(as.numeric(row['value']), '-'),
x=ifna(as.numeric(row['x']), '-'),
y=ifna(as.numeric(row['y']), '-'))
}
return(o)
}
# insert lstMarkpoint
lstMP = lstMark
if (is.null(timeslots)){ # no timeline
if (length(series) >0)
for (s in unlist(series)){ # series is null, mono series
if ('series' %in% names(data)){
dt = data[data$series == lvlseries[which(series==s)],]
}else dt = data
lstMP$data = unname(apply(dt, 1, .mkMPbyRow,
type=chart$x$series[[s]]$type))
if ('markPoint' %in% names(chart$x$series[[s]]))
lstMP$data = append(
chart$x$series[[s]]$markPoint$data, lstMP$data)
chart$x$series[[s]]$markPoint = lstMP
}
if (length(newSeries) > 0){
for (ns in seq_along(newSeries)){
chart$x$series = append(chart$x$series, list(list(
name=newSeries[ns], type=chart$x$series[[1]]$type,
data=list(list('-')))))
dt = if ('series' %in% names(data))
data[data$series==newSeries[ns],] else data
lstMP$data = unname(apply(dt, 1, .mkMPbyRow,
type=chart$x$series[[ns]]$type))
idxNew = length(chart$x$series)
chart$x$series[[idxNew]]$markPoint = lstMP
chart$x$legend$data = append(
chart$x$legend$data, newSeries[ns])
if (chart$x$series[[1]]$type == 'map')
chart$x$series[[idxNew]]$mapType = chart$x$series[[1]]$mapType
}
}
}else{ # with timeline
for (t in timeslots){
if (length(series) >0)
for (s in series[[t]]){ # series is null, mono series
dt = if ('series' %in% names(data))
data[data$series==allSeries[[t]][which(series==s)],] else data
lstMP$data = unname(apply(
dt, 1, .mkMPbyRow,
type=chart$x$options[[t]]$series[[s]]$type))
if ('markPoint' %in% names(chart$x$options[[t]]$series[[s]]))
lstMP$data = append(
chart$x$options[[t]]$series[[s]]$markPoint$data,
lstMP$data)
chart$x$options[[t]]$series[[s]]$markPoint<- lstMP
}
if (length(newSeries) > 0){
for (ns in seq_along(newSeries)){
chart$x$options[[t]]$series = append(
chart$x$options[[t]]$series, list(list(
name=newSeries[ns], data=list(list('-')),
type=chart$x$options[[t]]$series[[1]]$type)))
dt = if ('series' %in% names(data))
data[data$series==newSeries[ns],] else data
lstMP$data = unname(apply(
dt, 1, .mkMPbyRow,
type=chart$x$options[[t]]$series[[ns]]$type))
idxNew = length(chart$x$options[[t]]$series)
chart$x$options[[t]]$series[[idxNew]]$markPoint = lstMP
chart$x$options[[1]]$legend$data = append(
chart$x$options[[1]]$legend$data, newSeries[ns]
)
if (chart$x$options[[t]]$series[[1]]$type == 'map')
chart$x$options[[t]]$series[[idxNew]]$mapType <-
chart$x$options[[t]]$series[[1]]$mapType
}
}
}
}
return(chart)
}
#' @export
#' @rdname addMarkPoint
addMP = addMarkPoint
#' @export
#' @rdname addMarkPoint
addMarkpoint = addMarkPoint
#' @export
#' @rdname addMarkPoint
overideMarkPoint = function(chart, ...){
return(addMarkPoint(chart, mode='overide', ...))
}
#' @export
#' @rdname addMarkPoint
overideMarkpoint = overideMarkPoint
#' @export
#' @rdname addMarkPoint
overideMP = overideMarkPoint
#' Set `series` Element by Element
#'
#' The basic framework of making Echarts object is Step 1 \code{echart} => Step 2
#' \code{set[Widgets]} => Step 3 \code{set[Aesthetics]}. Step 1 makes the structure
#' of the Echarts object, step 2 creates/modifies its widgets, and step 3 modifies
#' the params of the widgets. But what if you want to modify the details inside
#' \code{series} list? -- You may want \code{setSeries}.\cr \cr
#' \code{setSeries} is a bit low-level, compared to other \code{set[Widgets]} functions.
#' It directly pass the param list on to an Echarts object and may lead to unexpected
#' results. So you are suggested to get more familiar with Echarts structure before
#' you decide to \code{setSeries}.
#'
#' @param chart chart \code{echarts} object generated by \code{\link{echart}} or
#' \code{\link{echartR}}
#' @param timeslots vector of timeslots, either name or index of timeline variable
#' \code{t}.
#' @param series series, could be the name or the index of the series. When the string
#' is not in the existing series list, it will be treated as new
#' @param ... The params to pass to the echarts object for modification. \cr
#' The generic params include:
#' \tabular{ll}{
#' \code{type} \tab chart type. 'line', 'bar', 'scatter', 'k', 'pie', 'radar',
#' 'chord', 'force', 'map'... If NULL, the series will not display. \cr
#' \code{name} \tab name of the series. \cr
#' \code{tooltip} \tab \code{\link{setTooltip}} \cr
#' \code{data} \tab the \code{data} part of \code{\link{echartR}} \cr
#' \code{itemStyle} \tab \code{\link{itemStyle}} \cr
#' \code{markPoint} \tab \code{\link{addMarkPoint}} \cr
#' \code{markLine} \tab \code{\link{addMarkLine}} \cr
#' \code{clickable} \tab whether the data graph is clickable, default TRUE. \cr
#' \code{z} \tab level-2 layer control, default 2. \cr
#' \code{zlevel} \tab level-1 layer control, default 0.
#' } \cr
#' The type-specific params include:
#' \describe{
#' \item{line}{
#' \tabular{ll}{
#' \code{stack} \tab TRUE|FALSE \cr
#' \code{xAxisIndex} \tab 0|1, default 0 (main axis) \cr
#' \code{yAxisIndex} \tab 0|1, default 0 (main axis) \cr
#' \code{symbol} \tab \code{\link{setSymbols}} \cr
#' \code{symbolSize} \tab numeric or \code{\link{JS}} function \cr
#' \code{symbolRotate} \tab -180 ~ 180 \cr
#' \code{showAllSymbol} \tab TRUE|FALSE, default FALSE\cr
#' \code{smooth} \tab TRUE|FALSE, default FALSE \cr
#' \code{dataFilter} \tab only for line charts. 'nearest'|'min'|'max'|'average', default 'nearest'. \cr
#' \code{legendHoverLink} \tab TRUE|FALSE, default TRUE.
#' }}
#' \item{bar}{
#' \tabular{ll}{
#' \code{stack} \tab TRUE|FALSE \cr
#' \code{xAxisIndex} \tab 0|1, default 0 (main axis) \cr
#' \code{yAxisIndex} \tab 0|1, default 0 (main axis) \cr
#' \code{barGap} \tab percent or numeric, default '30\%'. \cr
#' \code{barCategoryGap} \tab percent or numeric, default '20\%'. \cr
#' \code{barMinHeight} \tab numeric, default 0. \cr
#' \code{barWidth} \tab numeric, default automatic. \cr
#' \code{barMaxWidth} \tab numeric, default automatic. \cr
#' \code{legendHoverLink} \tab TRUE|FALSE, default TRUE.
#' }}
#' \item{scatter}{
#' \tabular{ll}{
#' \code{xAxisIndex} \tab 0|1, default 0 (main axis) \cr
#' \code{yAxisIndex} \tab 0|1, default 0 (main axis) \cr
#' \code{symbol} \tab \code{\link{setSymbols}} \cr
#' \code{symbolSize} \tab numeric or \code{\link{JS}} function \cr
#' \code{symbolRotate} \tab -180 ~ 180 \cr
#' \code{large} \tab TRUE|FALSE, default FALSE. \cr
#' \code{largeThreshold} \tab numeric, default 2000. \cr
#' \code{legendHoverLink} \tab TRUE|FALSE, default TRUE.
#' }}
#' \item{pie}{
#' \tabular{ll}{
#' \code{legendHoverLink} \tab TRUE|FALSE, default TRUE. \cr
#' \code{center} \tab percent or numeric, default c('50\%', '50\%') \cr
#' \code{radius} \tab percent or numeric, default c(0, '75\%') \cr
#' \code{startAngle} \tab numeric -360 ~ 360, default 90 for pie, 225 for gauge. \cr
#' \code{minAngle} \tab numeric, default 0. \cr
#' \code{clockWise} \tab TRUE|FALSE, default TRUE. \cr
#' \code{roseType} \tab 'radius'|'area'. \cr
#' \code{selectedOffset} \tab numeric, default 10. \cr
#' \code{selectedMode} \tab NULL|'single'|'multiple', default NULL.
#' }}
#' \item{radar}{
#' \tabular{ll}{
#' \code{symbol} \tab \code{\link{setSymbols}} \cr
#' \code{symbolSize} \tab numeric or \code{\link{JS}} function \cr
#' \code{symbolRotate} \tab -180 ~ 180 \cr
#' \code{legendHoverLink} \tab TRUE|FALSE, default TRUE. \cr
#' \code{polarIndex} \tab numeric. Index of the polar system to host the series.
#' }}
#' \item{chord}{
#' \tabular{ll}{
#' \code{symbol} \tab \code{\link{setSymbols}} \cr
#' \code{symbolSize} \tab numeric or \code{\link{JS}} function \cr
#' \code{clockWise} \tab TRUE|FASLE, default FALSE. \cr
#' \code{categories} \tab character vector \cr
#' \code{links} \tab list of links \cr
#' \code{matrix} \tab matrix data \cr
#' \code{minRadius} \tab numeric, default 10. \cr
#' \code{maxRadius} \tab numeric, default 20. \cr
#' \code{ribbonType} \tab TRUE|FALSE, default TRUE. \cr
#' \code{showScale} \tab TRUE|FALSE, default FALSE. \cr
#' \code{showScaleText} \tab TRUE|FALSE, default FALSE \cr
#' \code{padding} \tab numeric, default 2. \cr
#' \code{sort} \tab 'none'|'ascending'|'descending', default 'none'. \cr
#' \code{sortSub} \tab 'none'|'ascending'|'descending', default 'none'. \cr
#' \code{nodes} \tab nodes list
#' }}
#' \item{force}{
#' \tabular{ll}{
#' \code{symbol} \tab \code{\link{setSymbols}} \cr
#' \code{symbolSize} \tab numeric or \code{\link{JS}} function. \cr
#' \code{large} \tab TRUE|FALSE, default FALSE. \cr
#' \code{center} \tab percent or numeric, default c('50\%', '50\%'). \cr
#' \code{roam} \tab TRUE|FALSE|'scale'|'move', default FALSE. \cr
#' \code{categories} \tab character vector \cr
#' \code{links} \tab links list \cr
#' \code{matrix} \tab data matrix \cr
#' \code{size} \tab percent or numeric, default '100\%' \cr
#' \code{minRadius} \tab numeric, default 10. \cr
#' \code{maxRadius} \tab numeric, default 20. \cr
#' \code{linkSymbol} \tab vector of symbol characters, default c('none', 'arrow') \cr
#' \code{linkSymbolSize} \tab numeric verctor, default c(10, 15) \cr
#' \code{scaling} \tab numeric, default 1 \cr
#' \code{gravity} \tab numeric, default 1 \cr
#' \code{draggable} \tab TRUE|FALSE, default TRUE \cr
#' \code{useWorker} \tab TRUE|FALSE, default FALSE \cr
#' \code{steps} \tab numeric, default 1 \cr
#' \code{nodes} \tab nodes list
#' }}
#' \item{map}{
#' \tabular{ll}{
#' \code{selectedMode} \tab NULL|'single'|'multiple', default NULL \cr
#' \code{mapType} \tab 'china'|'world', default 'china' \cr
#' \code{hoverable} \tab TRUE|FALSE, default TRUE \cr
#' \code{dataRangeHoverLink} \tab TRUE|FALSE, default TRUE \cr
#' \code{mapLocation} \tab list{x=.., y=.., width=.., height=..}, default
#' list(x='center', y='center') \cr
#' \code{mapValueCalculation} \tab 'sum'|'average', default 'sum' \cr
#' \code{mapValuePrecision} \tab integer, default 0 \cr
#' \code{showLegendSymbol} \tab TRUE|FALSE, default TRUE \cr
#' \code{roam} \tab TRUE|FALSE|'scale'|'move', default FALSE \cr
#' \code{scaleLimit} \tab numeric list(max=.., min=..), default NULL \cr
#' \code{nameMap} \tab \code{\link{addNameMap}} \cr
#' \code{textFixed} \tab list, e.g., list(China=c(10, -10)), default NULL \cr
#' \code{geoCoord} \tab \code{\link{addGeoCoord}} \cr
#' \code{heatmap} \tab \code{\link{addHeatMap}}
#' }}
#' \item{gauge}{
#' \tabular{ll}{
#' \code{legendHoverLink} \tab TRUE|FALSE, default TRUE. \cr
#' \code{center} \tab percent or numeric vector, default c('50\%', '50\%') \cr
#' \code{radius} \tab percent or numeric vector, default c(0, '75\%') \cr
#' \code{startAngle} \tab numeric -360 ~ 360, default 225 \cr
#' \code{endAngle} \tab numeric -360 ~ 360, default -45 \cr
#' \code{min} \tab numeric, default 0 \cr
#' \code{max} \tab numeric, default 100 \cr
#' \code{splitNumber} \tab numeric, default 10 \cr
#' \code{axisLine} \tab list, default \code{list(
#' show=TRUE, lineStyle=list(
#' color=list(list(0.2, '#228b22'), list(0.8, '#48b'), list(1, '#ff4500')),
#' width=30))} \cr
#' \code{axisTick} \tab list, default \code{list(
#' show=TRUE, splitNumber=5, length=8, lineStyle=list(
#' color='#eee', width=1, type='solid'))} \cr
#' \code{axisLabel} \tab list, default \code{list(show=TRUE, formatter=NULL,
#' textStyle=list(color='auto'))} \cr
#' \code{splitLine} \tab list, default \code{list(show=TRUE,
#' length=30, lineStyle=list(
#' color='#eee', width=2, type='solid'))} \cr
#' \code{pointer} \tab list, default \code{list(length='80\%', width=8,
#' color='auto')} \cr
#' \code{title} \tab list, default \code{list(show=TRUE, offsetCenter=list(0, '40\%'),
#' textStyle=list(color='#333', fontSize=15))} \cr
#' \code{detail} \tab list, default \code{list(show=TRUE, backgroundColor='rgba(0,0,0,0)',
#' borderWidth=0, borderColor='#ccc', width=100, height=40, offsetCenter=list(0, '40\%'),
#' formatter=NULL, textStyle=list(color='auto', fontSize=30))}
#' }}
#' \item{funnel}{
#' \tabular{ll}{
#' \code{legendHoverLink} \tab TRUE|FALSE, default TRUE. \cr
#' \code{sort} \tab 'ascending'|'descending', default 'descending' \cr
#' \code{min} \tab numeric, default 0 \cr
#' \code{max} \tab numeric, default 100 \cr
#' \code{x} \tab numeric, default 80 \cr
#' \code{y} \tab numeric, default 60 \cr
#' \code{x2} \tab numeric, default 80 \cr
#' \code{y2} \tab numeric, default 60 \cr
#' \code{width} \tab percent or numeric, default NULL \cr
#' \code{height} \tab percent or numeric, default NULL \cr
#' \code{funnelAlign} \tab 'left'|'right'|'center', default 'center' \cr
#' \code{minSize} \tab percent, default '0\%' \cr
#' \code{maxSize} \tab percent, default '100\%' \cr
#' \code{gap} \tab numeric, default 0
#' }}
#' \item{eventRiver}{
#' \tabular{ll}{
#' \code{xAxisIndex} \tab 0|1, default 0 (main axis) \cr
#' \code{legendHoverLink} \tab TRUE|FALSE, default TRUE. \cr
#' \code{weight} \tab numeric, default 1
#' }}
#' \item{treemap}{
#' \tabular{ll}{
#' \code{center} \tab percent or numeric vector, default c('50\%', '50\%') \cr
#' \code{size} \tab percent or numeric vector, default c('80\%', '80\%') \cr
#' \code{root} \tab name of the root displayed currently
#' }}
#' \item{tree}{
#' \tabular{ll}{
#' \code{symbol} \tab \code{\link{setSymbols}} \cr
#' \code{symbolSize} \tab numeric or \code{\link{JS}} function. \cr
#' \code{roam} \tab TRUE|FALSE|'scale'|'move', default FALSE \cr
#' \code{rootLocation} \tab list, could be list(x='center' | 'left' | 'right' | 'x\%' | {number},
#' y='center' | 'top' | 'bottom' | 'y\%' | {number}) \cr
#' \code{layerPadding} \tab numeric, default 100 \cr
#' \code{nodePadding} \tab numeric, default 30 \cr
#' \code{orient} \tab 'vertical' | 'horizontal' | 'radial', default 'vertical' \cr
#' \code{direction} \tab "" or "inverse", default ""
#' }}
#' \item{wordCloud}{
#' \tabular{ll}{
#' \code{center} \tab percent or numeric vector, default c('50\%', '50\%') \cr
#' \code{size} \tab percent or numeric vector, default c('80\%', '80\%') \cr
#' \code{textRotation} \tab vector, -90 ~ 90, default c(0, 90) \cr
#' \code{autoSize} \tab list, default \code{list(enable=TRUE, minSize=12)}
#' }}
#' \item{heatmap}{
#' \tabular{ll}{
#' \code{blurSize} \tab numeric, default 30 \cr
#' \code{gradientColors} \tab \code{list(offset=.., color=..)} or color vector.
#' default \code{list('blue', 'cyan', 'limegreen', 'yellow', 'red')} \cr
#' \code{minAlpha} \tab numeric, default 0.05 \cr
#' \code{valueScale} \tab numeric, default 1 \cr
#' \code{opacity} \tab numeric, default 1
#' }}
#' }
#' @references
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#title~series-i}
#' @return A modified echarts object
#' @export
#'
#' @examples
#' \dontrun{
#' g = echartr(iris, Sepal.Width, Petal.Width, Species)
#' g %>% setSeries(series=3, symbol='emptyCircle')
#' }
setSeries = function(chart, series=NULL, timeslots=NULL, ...){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
validTypes = c(
'line', 'bar', 'scatter', 'pie', 'radar', 'chord','force', 'map', 'gauge',
'funnel', 'eventRiver', 'treemap', 'tree', 'wordCloud', 'heatmap')
hasT = 'baseOption' %in% names(chart$x)
lst = list(...)
# define t
if (hasT){
if (is.null(timeslots))
timeslots = seq_along(chart$x$options)
else
if (is.numeric(timeslots)){
timeslots = intersect(timeslots, seq_along(chart$x$options))
}else{
timeslots = which(chart$x$baseOption$timeline$data %in% timeslots)
}
}else{
timeslots = NULL
}
# define series
lstAnalyzeSeries = analyzeSeries(chart, series)
series = lstAnalyzeSeries$numSeries
lvlseries = lstAnalyzeSeries$strSeries
allSeries = lstAnalyzeSeries$allnumSeries
lvlSeries = lstAnalyzeSeries$allStrSeries
newSeries = lstAnalyzeSeries$strNewSeries
# mergeList
if (is.null(timeslots)){ # no timeline
if (length(series) >0)
for (s in unlist(series)){ # series is null, mono series
if (! 'type' %in% names(lst))
type = chart$x$series[[s]]$type
else
type = match.arg(lst$type, validTypes)
chart$x$series[[s]] = mergeList(
chart$x$series[[s]], filterSeriesParts(lst, type)
)
}
if (length(newSeries) > 0){
for (ns in seq_along(newSeries)){
if ('type' %in% names(lst)){
type = match.arg(lst$type, validTypes)
chart$x$series = append(chart$x$series, list(
filterSeriesParts(lst, type)
))
}
}
}
}else{ # with timeline
for (t in timeslots){
if (length(series) >0)
for (s in series[[t]]){ # series is null, mono series
if (! 'type' %in% names(lst))
type = chart$x$options[[t]]$series[[s]]$type
else
type = match.arg(lst$type, validTypes)
chart$x$options[[t]]$series[[s]] = mergeList(
chart$x$options[[t]]$series[[s]],
filterSeriesParts(lst, type)
)
}
if (length(newSeries) > 0){
for (ns in seq_along(newSeries)){
if ('type' %in% names(lst)){
type = match.arg(lst$type, validTypes)
chart$x$options[[t]]$series = append(
chart$x$options[[t]]$series, list(
filterSeriesParts(lst, type)
))
}
}
}
}
}
return(chart)
}
#' Define Aesthetic Elements of Echarts Object
#'
#' An Echarts object uses \code{itemStyle} heavily. You can use \code{itemStyle}
#' to compose an itemStyle list. \cr \cr
#' Contained in an itemStyle object are \cr
#' \describe{
#' \item{atomic features}{'color', 'borderColor', 'borderWidth', 'barBorderColor',
#' 'barBorderRadius', 'barBorderWidth', which you can directly assign values}
#' \item{object features}{'lineStyle', 'textStyle','areaStyle', 'chordStyle',
#' 'nodeStyle', 'linkStyle', which you can yield by \code{aesStyle} function family}
#' \item{mixed object features}{'label' and 'labelLine', which contains other
#' object features, such as 'lineStyle', 'textStyle'}
#' } \cr
#' You can use \code{aesStyle} function family (\code{
#' lineStyle, textStyle, areaStyle, aesChordSytle, labelStyle, labelLineStyle})
#' to compose basic feature objects, and then group them into label or labelLine
#' using \code{labelStyle / labelLineStyle}, and finally pack them into an itemStyle
#' object using \code{itemStyle}.
#'
#' @param element String, could be 'text', 'line', 'area', 'chord', 'node', or 'link',
#' corresponding to \code{textStyle, lineStyle, areaStyle, chordStyle, nodeStyle,
#' linkStyle}
#' @param ... The params to form an aesthetic element \cr
#' The element-specific params list:
#' \describe{
#' \item{\strong{itemStyle} (normal|emphasis)}{
#' \tabular{ll}{
#' \code{color} \tab color vector, 'rgba', hex color, or color names. \cr
#' \code{lineStyle} \tab for line, k charts and markLine, \code{\link{lineStyle}} \cr
#' \code{textStyle} \tab \code{\link{textStyle}} \cr
#' \code{areaStyle} \tab for stacked line chart and map, \code{\link{areaStyle}} \cr
#' \code{chordStyle} \tab for chord chart, \code{\link{chordStyle}} \cr
#' \code{nodeStyle} \tab for force chart, \code{\link{nodeStyle}} \cr
#' \code{linkStyle} \tab for force chart, \code{\link{linkStyle}} \cr
#' \code{borderColor} \tab color vector, 'rgba', hex color, or color names. \cr
#' \code{borderWidth} \tab for symbol, symbole, pie chart, map and markPoint, numeric \cr
#' \code{barBorderColor} \tab for symbol, symbole, pie chart, map and markPoint, numeric \cr
#' \code{barBorderRadius} \tab numeric vector length 1 or 4 (right-bottom-left-top), default 0 \cr
#' \code{barBorderWidth} \tab numeric vector length 1 or 4 (right-bottom-left-top), default 00 \cr
#' \code{label} \tab for line, bar, k, scatter, pie, map, force, funnel charts
#' and markPoint, markLine, \code{\link{labelStyle}} \cr
#' \code{labelLine} \tab for pie and funnel chart, \code{\link{labelLineStyle}}
#' }}
#' \item{\emph{label}}{
#' \tabular{ll}{
#' \code{show} \tab TRUE|FALSE, default TRUE \cr
#' \code{position} \tab \itemize{
#' \item for pie, 'outer'|'inner'; \cr
#' \item for funnel, 'inner'|'left'|'right'; \cr
#' \item for line, bar, k, scatter, 'top'|'right'|'inside'|'left'|'bottom'; \cr
#' \item for bar, additionally 'insideLeft' | 'insideRight' | 'insideTop' | 'insideBottom'} \cr
#' \code{rotate} \tab chord chart only. TRUE|FALSE, default FALSE \cr
#' \code{distance} \tab chord and pie chart only. numeric, default 10 \cr
#' \code{formatter} \tab \code{\link{setTooltip}} \cr
#' \code{textStyle} \tab \code{\link{textStyle}} \cr
#' \code{x} \tab treemap only, numeric \cr
#' \code{y} \tab treemap only, numeric
#' }}
#' \item{\emph{labelLine}}{
#' \tabular{ll}{
#' \code{show} \tab TRUE|FALSE, default TRUE \cr
#' \code{length} \tab numeric or 'auto', default 40 \cr
#' \code{lineStyle} \tab \code{\link{lineStyle}}
#' }}
#' \item{textStyle}{
#' \tabular{ll}{
#' \code{color} \tab color vector, 'rgba', hex color, or color names. \cr
#' \code{decoration} \tab only for tooltip. string, default 'none' \cr
#' \code{align} \tab 'left' | 'right' | 'center' \cr
#' \code{baseline} \tab 'top' | 'bottom' | 'middle' \cr
#' \code{fontFamily} \tab valid font family name \cr
#' \code{fontSize} \tab numeric, default 12 \cr
#' \code{fontStyle} \tab 'normal' | 'italic' | 'oblique', default 'normal' \cr
#' \code{fontWeight} \tab 'normal' | 'bold' | 'bolder' | 'lighter' or numeric,
#' default 'normal'
#' }}
#' \item{lineStyle}{
#' \tabular{ll}{
#' \code{color} \tab color vector, 'rgba', hex color, or color names. \cr
#' \code{type} \tab 'solid' | 'dotted' | 'dashed', for tree, additionally
#' 'curve' | 'broken'. Default 'solid' \cr
#' \code{width} \tab numeric \cr
#' \code{shadowColor} \tab color vector, 'rgba', hex color, or color names. \cr
#' \code{shadowBlur} \tab numeric, default 5 \cr
#' \code{shadowOffsetX} \tab numeric, default 3 \cr
#' \code{shadowOffsetY} \tab numeric, default 3
#' }}
#' \item{areaStyle}{
#' \tabular{ll}{
#' \code{color} \tab color vector, 'rgba', hex color, or color names. \cr
#' \code{type} \tab only 'default'
#' }}
#' \item{chordStyle}{
#' \tabular{ll}{
#' \code{width} \tab numeric, default 1 \cr
#' \code{color} \tab color vector, 'rgba', hex color, or color names. \cr
#' \code{borderWidth} \tab numeric, default 1 \cr
#' \code{borderColor} \tab color vector, 'rgba', hex color, or color names.
#' }}
#' \item{nodeStyle}{
#' \tabular{ll}{
#' \code{color} \tab color vector, 'rgba', hex color, or color names. \cr
#' \code{borderWidth} \tab numeric, default 1 \cr
#' \code{borderColor} \tab color vector, 'rgba', hex color, or color names.
#' }}
#' \item{linkStyle}{
#' \tabular{ll}{
#' \code{type} \tab 'curve'|'line' \cr
#' \code{color} \tab color vector, 'rgba', hex color, or color names. default '#5182ab' \cr
#' \code{width} \tab numeric, default 1
#' }}
#' }
#'
#' @return A list
#' @export
#'
#' @examples
#' \dontrun{
#' lab = labelStyle(show=TRUE, position='inside',
#' textStyle=textStyle(color='red'))
#' styLine = lineStyle(color='#fff', width=4, shadowBlur=5)
#' itemStyle = list(normal=itemStyle(lineStyle=styLine, label=lab),
#' emphasis=itemStyle(lineStyle=styLine, label=lab)
#' )
#' }
aesStyle = function(element=c('text', 'line', 'area', 'chord', 'node', 'link'),
...){
lst = list(...)
element = match.arg(element)
validParts = switch(
element,
text=c('color', 'decoration', 'align', 'baseline', 'fontFamily',
'fontSize', 'fontStyle', 'fontWeight'),
line=c('color', 'type', 'width', 'shadowColor', 'shadowBlur',
'shadowOffsetX', 'shadowOffsetY'),
area=c('color', 'type'),
chord=c('width', 'color', 'borderWidth', 'borderColor'),
node=c('color', 'borderWidth', 'borderColor'),
link=c('type', 'color', 'width'))
lst = lst[intersect(names(lst), validParts)]
if ('align' %in% names(lst))
lst$align = match.arg(lst$align, c('left', 'center', 'right'))
if ('baseline' %in% names(lst)) lst$baseline = match.arg(lst$baseline, c(
'top', 'middle', 'bottom'))
if ('type' %in% names(lst)) lst$type = match.arg(lst$type, c(
'solid', 'dotted', 'dashed', 'broken', 'curve', 'line', 'default'))
if ('fontStyle' %in% names(lst)) lst$fontStyle = match.arg(lst$fontStyle, c(
'normal', 'italic', 'oblique'))
if ('fontWeight' %in% names(lst)) stopifnot(
is.numeric(lst$fontWeight) || lst$fontWeight %in% c(
'normal', 'bold', 'bolder', 'lighter'))
if ('width' %in% names(lst)) stopifnot(is.numeric(lst$width))
if ('shadowBlur' %in% names(lst)) stopifnot(is.numeric(lst$shadowBlur))
if ('shadowOffsetX' %in% names(lst)) stopifnot(is.numeric(lst$shadowOffsetX))
if ('shadowOffsetY' %in% names(lst)) stopifnot(is.numeric(lst$shadowOffsetY))
if ('borderWidth' %in% names(lst)) stopifnot(is.numeric(lst$borderWidth))
if ('fontSize' %in% names(lst)) stopifnot(is.numeric(lst$fontSize))
return(lst)
}
#' @export
#' @rdname aesStyle
lineStyle = function(...) aesStyle('line', ...)
#' @export
#' @rdname aesStyle
textStyle = function(...) aesStyle('text', ...)
#' @export
#' @rdname aesStyle
areaStyle = function(...) aesStyle('area', ...)
#' @export
#' @rdname aesStyle
chordStyle = function(...) aesStyle('chord', ...)
#' @export
#' @rdname aesStyle
nodeStyle = function(...) aesStyle('node', ...)
#' @export
#' @rdname aesStyle
linkStyle = function(...) aesStyle('link', ...)
#' @export
#' @rdname aesStyle
labelStyle = function(...){
lst = list(...)
validParts = c(
'show', 'position', 'rotate', 'distance', 'formatter', 'textStyle', 'x', 'y')
if ('show' %in% names(lst)) stopifnot(is.logical(lst$show))
if ('position' %in% names(lst)) lst$position = match.arg(lst$position, c(
'outer', 'inner', 'left', 'right', 'top', 'inside', 'bottom', 'insideLeft',
'insideRight', 'insideTop', 'insdieBottom'
))
if ('rotate' %in% names(lst)) stopifnot(is.logical(lst$rotate))
if ('textStyle' %in% names(lst)) stopifnot(is.list(lst$textStyle))
return(lst)
}
#' @export
#' @rdname aesStyle
labelLineStyle = function(...){
lst = list(...)
validParts = c(
'show', 'length', 'lineStyle')
if ('show' %in% names(lst)) stopifnot(is.logical(lst$show))
if ('length' %in% names(lst)) stoifnot(
is.numeric(lst$length) || lst$length=='auto')
if ('lineStyle' %in% names(lst)) stopifnot(is.list(lst$lineStyle))
return(lst)
}
#' @export
#' @rdname aesStyle
itemStyle = function(...){
lst = list(...)
validParts = c(
'color', 'lineStyle', 'textStyle', 'areaStyle', 'chordStyle', 'nodeStyle',
'linkStyle', 'borderColor', 'borderWidth', 'barBorderColor', 'barBorderRadius',
'barBorderWidth', 'label', 'labelLine')
lst = lst[intersect(names(lst), validParts)]
return(lst)
}
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 makeTitle setTitle makeToolbox setToolbox makeDataZoom setDataZoom makeDataRange setDataRange setLegend setTheme makeTooltip determineFormatter setTooltip setTimeline addGeoCoord overideGeoCoord addHeatmap overideHeatmap addNameMap overideNameMap addMarkLine overideMarkLine addMarkPoint overideMarkPoint setSeries aesStyle lineStyle textStyle areaStyle chordStyle nodeStyle linkStyle labelStyle labelLineStyle itemStyle
Documented in addGeoCoord addHeatmap addMarkLine addMarkPoint addNameMap aesStyle areaStyle chordStyle itemStyle labelLineStyle labelStyle lineStyle linkStyle nodeStyle overideGeoCoord overideHeatmap overideMarkLine overideMarkPoint overideNameMap setDataRange setDataZoom setLegend setSeries setTheme setTimeline setTitle setToolbox setTooltip textStyle
makeTitle = function(title=NULL, subtitle=NULL, link=NULL, sublink=NULL,
pos=6, bgColor=NULL, borderColor=NULL,
borderWidth=NULL, textStyle=NULL, subtextStyle=NULL, ...){
# Work function for setTitle
lstTitle = list()
if (!is.null(title)){
if (grepl("^\\[.+\\]\\(.+\\)$", title)){
if (is.null(link)) link = gsub("^\\[(.+)\\]\\((.+)\\)$", "\\2", title)
title = gsub("^\\[(.+)\\]\\((.+)\\)$", "\\1", title)
}
lstTitle$text = title
if (!is.null(link)) lstTitle$link = link
}
if (!is.null(subtitle)){
if (grepl("^\\[.+\\]\\(.+\\)$", subtitle)){
if (is.null(sublink))
sublink = gsub("^\\[(.+)\\]\\((.+)\\)$", "\\2", subtitle)
subtitle = gsub("^\\[(.+)\\]\\((.+)\\)$", "\\1", subtitle)
}
lstTitle$subtext = subtitle
if (!is.null(sublink)) lstTitle$sublink = sublink
}
if (is.numeric(pos[[1]]) && pos[[1]] <= 12){
lstTitle[c('x', 'y', 'orient')] = vecPos(pos[[1]])
}else if (length(pos)==3 && tolower(pos[[1]]) %in%
c('left', 'right', 'center') &&
tolower(pos[[2]]) %in% c('top', 'center', 'bottom') &&
tolower(pos[[3]]) %in% c('vertical', 'horizontal')){
lstTitle[c('x', 'y', 'orient')] = pos
}
if (!is.null(bgColor)){
if (bgColor != 'rgba(0,0,0,0)')
lstTitle[['backgroundColor']] = getColors(bgColor)[1]
}
if (!is.null(borderColor)){
if (borderColor != '#ccc')
lstTitle[['borderColor']] = getColors(borderColor)[1]
}
if (!is.null(borderWidth)){
if (borderWidth > 0)
lstTitle[['borderWidth']] = borderWidth
}
if (!is.null(textStyle)){
if (!identical(textStyle, list(fontSize=18, fontWeight='bold', color='#333'))){
if (all(names(textStyle) %in% c('fontSize', 'fontWeight', 'fontStyle',
'color', 'fontFamily')))
lstTitle[['textStyle']] = textStyle
}
}
if (!is.null(subtextStyle)){
if (!identical(subtextStyle, list(color='#aaa'))){
if (all(names(subtextStyle) %in% c('fontSize', 'fontWeight', 'fontStyle',
'color', 'fontFamily')))
lstTitle[['subtextStyle']] = subtextStyle
}
}
return(lstTitle)
}
#' Set \code{title} (And Subtitle) of Echarts
#'
#' When an echart object is generated, you can modify it by setting title and
#' subtitles using \code{\link{\%>\%}}.
#'
#' In echarts with timeline, you can set \code{title, subtitle, link, sublink, bgColor,
#' borderColor, borderWidth} as vectors of the same length as \code{z}. For \code{textSytle,
#' subtextStyle}, you need to pack the user-defined lists in a list.
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{\link{echartR}}
#' @param title text of the title. If written in markdown format \code{[caption](url)},
#' then \code{caption} is passed to title, \code{url} is passed to link. If the length
#' of the title vector equals to the length of timeline slices, the title vector will
#' be used as slice-specific user-defined title.
#' @param link link of the title
#' @param subtitle text of the subtitle. If written in markdown format \code{[caption](url)},
#' then \code{caption} is passed to title, \code{url} is passed to link. If the length
#' of the subtitle vector equals to the length of timeline slices, the subtitle vector will
#' be used as slice-specific user-defined title.
#' @param sublink link of the subtitle
#' @param pos the clock-position of title (and subtitle), refer to \code{\link{vecPos}}. Or
#' define a vector \code{c(x, y, orient)} yourself.
#' @param bgColor background color of title. Default 'rgba(0,0,0,0)' (transparent)
#' @param borderColor border color of the title. Default '#ccc'.
#' @param borderWidth border width of the title. Default 0px (not shown).
#' @param textStyle You can place self-defined textStyle list of the title here. E.g., \code{list(
#' fontFamily='Arial|Verdana|sans-serif', fontSize=20, fontWeight='normal|bold|bolder|lighter|<numbers>',
#' fontStyle='normal|italic|oblique', color='red')}
#' @param subtextStyle You can place self-defined textStyle of the subtitle here.
#' @param show Logical. Whether to show the title. If you want to remove title from
#' the echarts object, set it NULL.
#' @param ... elipsis
#'
#' @return A modified echart object
#' @export
#'
#' @references
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#title~title}
#'
#' @examples
#' \dontrun{
#' ## simple echarts scatter plot
#' g = iris %>% echartR(x=Sepal.Width, y=Petal.Width, series=Species,
#' type='scatter')
#'
#' ## set simple titles
#' g %>% setTitle(title='Iris data set', subtitle='by: R. A. Fisher')
#'
#' ## set titles with links and textStyles
#' g %>% setTitle(
#' '[Iris data set](https://en.wikipedia.org/wiki/Iris_flower_data_set)',
#' '[R. A. Fisher](https://en.wikipedia.org/wiki/Ronald_Fisher)',
#' textStyle=textStyle(fontFamily='Courier New', fontSize=24, color='gold'),
#' subtextStyle=textStyle(color='silver'), bgColor='lightgreen')
#'
#'
#' ## echarts with timeline
#' g1 = iris %>% echartR(x=Sepal.Width, y=Petal.Width, t=Species, type='scatter')
#'
#' ## simple titles/subtitles
#' g1 %>% setTitle(
#' '[Iris data set](https://en.wikipedia.org/wiki/Iris_flower_data_set)',
#' '[R. A. Fisher](https://en.wikipedia.org/wiki/Ronald_Fisher)')
#'
#' ## user-defined titles/subtitles
#' titles = c(
#' '[Iris setosa](https://en.wikipedia.org/wiki/Iris_setosa)',
#' '[Iris versicolor](https://en.wikipedia.org/wiki/Iris_versicolor)',
#' '[Iris virginica](https://en.wikipedia.org/wiki/Iris_virginica)')
#'
#' g1 %>%
#' setTitle(
#' titles,
#' textStyle=list(
#' textStyle(fontFamily='Impact', color='red', fontStyle='normal'),
#' textStyle(fontFamily='Times New Roman', color='green'),
#' textStyle(fontFamily='Calibri', color='blue', fontStyle='oblique')
#' ),
#' bgColor='lightyellow')
#' ## textStyle is a list length 3, mapping 3 levels for timeline
#' }
setTitle = function(chart, title=NULL, subtitle=NULL, link=NULL, sublink=NULL,
pos=6, bgColor=NULL, borderColor=NULL, borderWidth=NULL,
textStyle=NULL, subtextStyle=NULL, show=TRUE, ...){
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)
if (!missing(title)) title = ifnull(title, "")
if (!missing(subtitle)) subtitle = ifnull(subtitle, "")
if (hasT){ # has a timeline
if (is.null(show)) {
for (i in 1:length(chart$x$options))
chart$x$options[[i]]$title = NULL
return(chart %>% tuneGrid())
}
if (!is.null(title)){
if (length(title) == length(chart$x$options)){
titles = unlist(title)
} else {
if (grepl("^\\[.+\\]\\(.+\\)$", title[1])){
link = gsub("^\\[(.+)\\]\\((.+)\\)$", "\\2", title[1])
title = gsub("^\\[(.+)\\]\\((.+)\\)$", "\\1", title[1])
}
titles = paste0(
rep(gsub("^\\[(.+)\\]\\((.+)\\)$", "\\1", title),
length(chart$x$options)), " (",
attr(chart$x$baseOption$timeline, 'sliceby'), ": ",
chart$x$baseOption$timeline$data, ")")
}
}else{
titles = rep(NULL, length(chart$x$options))
}
.dupicateThem = function(val){
if (!is.null(val)){
if ((is.list(val) && is.list(val[[1]])) || is.vector(val)){
if (length(val) == length(chart$x$options)){
return(val)
}else{
return(rep(val[1], length(chart$x$options)))
}
}else{
if (is.list(val))
return(rep(list(val[1]), length(chart$x$options)))
else
return(rep(val[1], length(chart$x$options)))
}
}else{
return(rep(NULL, length(chart$x$options)))
}
}
subtitles = .dupicateThem(subtitle)
links = .dupicateThem(link)
sublinks = .dupicateThem(sublink)
bgColors = .dupicateThem(bgColor)
borderColors = .dupicateThem(borderColor)
borderWidths = .dupicateThem(borderWidth)
textStyles = .dupicateThem(textStyle)
subtextStyles = .dupicateThem(subtextStyle)
if (! all(is.null(c(titles, subtitles, links, sublinks, bgColor, pos, show,
borderColor, borderWidth, textStyle, subtextStyle)))) {
for (i in seq_len(length(chart$x$options))){
lstTitle = makeTitle(
title=titles[i], subtitle=subtitles[i], link=links[i],
sublink=sublinks[i], pos=pos, bgColor=bgColors[i],
borderColor=borderColors[i], borderWidth=borderWidths[i],
textStyle=textStyles[[i]], subtextStyle=subtextStyles[[i]]
)
chart$x$options[[i]][['title']] <-
if (is.null(chart$x$options[[i]][['title']])) lstTitle else
mergeList(chart$x$options[[i]][['title']], lstTitle)
}
}
}else{ # do not have timeline
if (is.null(show)) {
chart$x$title = NULL
return(chart %>% tuneGrid)
}
if (! all(is.null(c(title, subtitle, link, sublink)))){
lstTitle = makeTitle(
title=title, subtitle=subtitle, link=link, sublink=sublink,
pos=pos, borderColor=borderColor, borderWidth=borderWidth,
bgColor=bgColor, textStyle=textStyle, subtextStyle=subtextStyle
)
chart$x$title = if (is.null(chart$x$title)) lstTitle else
mergeList(chart$x$title , lstTitle)
}
}
return(chart %>% tuneGrid())
}
makeToolbox = function(toolbox=c(TRUE,'cn'), type='auto',
show=c('mark', 'dataZoom', 'dataView', 'magicType',
'restore', 'saveAsImage'), pos=1,
bgColor='rgba(0,0,0,0)', borderColor='#ccc', borderWidth=0,
padding=5, itemGap=10, itemSize=16,
color=c("#1e90ff", "#22bb22", "#4b0082", "#d2691e"),
disableColor='#ddd', effectiveColor='red', showTitle=TRUE,
textStyle=NULL,
...){
# Work function for setToolbox
if (! is.null(show)) show = tolower(show)
if (toolbox[1]){
lstToolbox= list(
show = ifnull(as.logical(toolbox[1]), TRUE),
feature = list(
mark =list(show = ('mark' %in% show)),
dataZoom = list(show = ('datazoom' %in% show)),
dataView = list(show = ('dataview' %in% show),
readOnly = FALSE),
magicType = list(show = FALSE),
restore = list(show = ('restore' %in% show)),
saveAsImage = list(show = ('saveasimage' %in% show))
)
)
if (! missing(bgColor)) if (bgColor != 'rgba(0,0,0,0)')
lstToolbox$backgroundColor = bgColor
if (! missing(borderColor)) if (borderColor != '#ccc')
lstToolbox$borderColor = borderColor
if (! missing(borderWidth)) if (borderWidth > 0)
lstToolbox$borderWidth = borderWidth
if (! missing(padding)) if (padding != 5) lstToolbox$padding = padding
if (! missing(itemGap)) if (itemGap != 10)
lstToolbox$itemGap = itemGap
if (! missing(itemSize)) if (itemSize != 16) lstToolbox$itemSize = itemSize
if (! missing(color)) if (!identical(color, c("#1e90ff", "#22bb22", "#4b0082", "#d2691e")))
lstToolbox$color = color
if (! missing(disableColor)) if (disableColor != '#ddd')
lstToolbox$disableColor = disableColor
if (! missing(effectiveColor)) if (effectiveColor != 'red')
lstToolbox$effectiveColor = effectiveColor
if (! missing(showTitle)) if (! showTitle) lstToolbox$showTitle = showTitle
if (! missing(textStyle)) if (is.null(textStyle))
lstToolbox$textStyle = textStyle
if (tolower(toolbox[2]) != 'cn'){ # Enlish tooltips of the controls
lstToolbox[['feature']][['mark']][['title']] = list(
mark="Apply Auxiliary Conductor",
markUndo="Undo Auxiliary Conductor",
markClear="Clear Auxiliary Conductor")
lstToolbox[['feature']][['dataZoom']][['title']] = list(
dataZoom="Data Zoom",
dataZoomReset="Reset Data Zoom")
lstToolbox[['feature']][['dataView']][['title']] = "Data View"
lstToolbox[['feature']][['dataView']][['lang']] <-
c('Data View', 'Close', 'Refresh')
lstToolbox[['feature']][['restore']][['title']] = "Restore"
lstToolbox[['feature']][['saveAsImage']][['title']] = "Save As Image"
lstToolbox[['feature']][['saveAsImage']][['lang']] = 'Click to Save'
}
if (is.numeric(pos[[1]]) && pos[[1]] <= 12){
lstToolbox[c('x', 'y', 'orient')] = vecPos(pos[[1]])
}else if (length(pos)==3 && tolower(pos[[1]]) %in%
c('left', 'right', 'center') &&
tolower(pos[[2]]) %in% c('top', 'center', 'bottom') &&
tolower(pos[[3]]) %in% c('vertical', 'horizontal')){
lstToolbox[c('x', 'y', 'orient')] = pos
}
if (type[1] %in% c('auto', 'line', 'bar', 'k')){
lstToolbox[['feature']][['magicType']] <-
list(show=TRUE, type= c('line', 'bar', 'tiled', 'stack'))
}else if (type[1] %in% c('pie', 'funnel')){
lstToolbox[['feature']][['magicType']] <-
list(show=TRUE, type= c('pie', 'funnel'))
}else if (type[1] %in% c('force', 'chord')){
lstToolbox[['feature']][['magicType']] <-
list(show=TRUE, type= c('force', 'chord'))
lstToolbox[['feature']][['dataView']] = list(show=FALSE)
lstToolbox[['feature']][['dataZoom']] = list(show=FALSE)
}
if (lstToolbox$feature$magicType$show){
if (tolower(toolbox[2]) != 'cn'){
lstToolbox[['feature']][['magicType']][['title']] = list(
line = "Switch to Line Chart",
bar = "Switch to Bar Chart",
stack = "Stack",
tiled = "Tiled",
force = "Switch to Force Chart",
chord = "Switch to Chord Chart",
pie = "Switch to Pie Chart",
funnel = "Switch to Funnel Chart"
)
}
}
}else{
lstToolbox=list(show=FALSE)
}
return(lstToolbox)
}
#' Set \code{toolbox} of Echarts
#'
#' When an echart object is generated, you can modify it by setting toolbox using
#' \code{\link{\%>\%}}.
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{\link{echartR}}
#' @param show logical. Show the toolbox if TRUE. If you want to remove toolbox from
#' the echarts object, set it NULL.
#' @param language 'cn' or 'en', the language of the toolbox tooltips.
#' @param controls which widgets to show. Default \code{'mark', 'dataZoom', 'dataView', 'magicType',
#' 'restore', 'saveAsImage'}.
#' @param pos the clock-position of toolbox, refer to \code{\link{vecPos}}. Or you can
#' define a vector \code{c(x, y, orient)} yourself.#'
#' @param bgColor background color, default transparent ('rgba(0,0,0,0)').
#' @param borderColor border color, default '#ccc'.
#' @param borderWidth border width, default 0px (not shown).
#' @param padding Padding of the toolbox. Default 5px. Could also be a list assigning
#' padding of top, right, bottom and left.
#' @param itemGap Gap between the items. Default 10px.
#' @param itemSize Size of the items. Default 16px.
#' @param color Colors of the toolbox widgets (applied in loops). Default
#' c("#1e90ff", "#22bb22", "#4b0082", "#d2691e").
#' @param disableColor Color for disabled widgets. Default '#ddd'.
#' @param effectiveColor Color for widgets be triggered. Default 'red'.
#' @param showTitle Logical, if widgets title are shown. Default TRUE.
#' @param textStyle A list of the text style of the widgets. Default \code{
#' list(fontFamily=c('Arial, Verdana, sans-serif'), fontSize=12, fontStyle='normal',
#' fontWeight='normal')}
#' @param ... elipsis
#'
#' @return A modified echart object
#' @export
#'
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~toolbox}
#' @examples
#' \dontrun{
#' g = iris %>% echartR(x=Sepal.Width, y=Petal.Width, series=Species, type='scatter')
#' g %>% setToolbox(TRUE, 'en')
#' }
setToolbox = function(chart, show=TRUE, language='cn',
controls=c('mark', 'dataZoom', 'dataView', 'magicType',
'restore', 'saveAsImage'), pos=1,
bgColor='rgba(0,0,0,0)', borderColor='#ccc', borderWidth=0,
padding=5, itemGap=10, itemSize=16,
color=c("#1e90ff", "#22bb22", "#4b0082", "#d2691e"),
disableColor='#ddd', effectiveColor='red', showTitle=TRUE,
textStyle=NULL,
...){
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)
if (hasT){
if (is.null(show)) {
chart$x$options[[1]]$toolbox = NULL
return(chart %>% tuneGrid())
}
type = chart$x$options[[1]]$series[[1]]$type
chart$x$options[[1]]$toolbox = makeToolbox(
toolbox=c(show, language), type, controls, pos, bgColor,
borderColor, borderWidth, padding, itemGap, itemSize, color,
disableColor, effectiveColor, showTitle, textStyle)
}else{
if (is.null(show)) {
chart$x$toolbox = NULL
return(chart %>% tuneGrid())
}
type = chart$x$series[[1]]$type
chart$x$toolbox = makeToolbox(
toolbox=c(show, language), type, controls, pos, bgColor,
borderColor, borderWidth, padding, itemGap, itemSize, color,
disableColor, effectiveColor, showTitle, textStyle)
}
return(chart %>% tuneGrid())
}
makeDataZoom = function(show=FALSE, pos=6, range=NULL, width=30,
fill='rgba(144,197,237,0.2)',
handle='rgba(70,130,180,0.8)',
bgColor = 'rgba(0,0,0,0)',
dataBgColor = '#eee', showDetail=TRUE, realtime=FALSE,
zoomLock=FALSE,
...){
# Work function for setDataZoom
if (is.numeric(pos[1])) pos = vecPos(pos)
if (!is.null(show)) {
lstdataZoom = list(show=show)
if (! missing(fill)) if (fill != 'rgba(144,197,237,0.2)')
lstdataZoom$fillerColor = fill
if (! missing(handle)) if (handle != 'rgba(70,130,180,0.8)')
lstdataZoom$handleColor = handle
if (! missing(bgColor)) if (bgColor != 'rgba(0,0,0,0)')
lstdataZoom$backgroundColor = bgColor
if (! missing(dataBgColor)) if (dataBgColor != '#eee')
lstdataZoom$dataBackgroundColor = dataBgColor
if (! missing(showDetail)) if (!showDetail)
lstdataZoom$showDetail = showDetail
if (! missing(realtime)) if (realtime)
lstdataZoom$realtime = realtime
if (! missing(zoomLock)) if (zoomLock)
lstdataZoom$zoomLock = zoomLock
if (pos[[3]] == 'vertical'){
lstdataZoom[['y']] = 60
if (pos[[1]]=='left') lstdataZoom[['x']] = 0
if (pos[[1]]=='right') lstdataZoom[['x']] = dev.size('px')[1] - 80
}else{
if (! (pos[[1]] == 'center' && pos[[2]] == 'bottom')){
lstdataZoom[['x']] = 80
if (pos[[2]]=='top') lstdataZoom[['y']] = 0
}
}
lstdataZoom[['orient']] = pos[[3]]
if (lstdataZoom$orient == 'horizontal') lstdataZoom[['height']] = width
if (lstdataZoom$orient == 'vertical') lstdataZoom[['width']] = width
if (!is.null(range))
range = c(range[1], ifelse(length(range) == 1, range[1], range[2]))
if (all(is.numeric(range[1:2]))){
if (any(! range >= 0 | ! range <= 100)){
stop("dataZoom should be between 0 and 100")
}else{
lstdataZoom[['start']] = min(range[1:2])
lstdataZoom[['end']] = max(range[1:2])
}
}
} else {
lstdataZoom = list(show=FALSE)
}
return(lstdataZoom)
}
#' Set \code{dataZoom} Bar of Echarts
#'
#' When an echart object is generated, you can modify it by setting dataZoom using
#' \code{\link{\%>\%}}.
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{\link{echartR}}
#' @param show logical. Show the dataZoom control if TRUE. If you want to remove
#' dataZoom from the echarts object, set it NULL.
#' @param pos the clock-position of dataZoom, refert to \code{\link{vecPos}}. You can
#' define a vector \code{c(x, y, orient)} yourself.
#' @param range A vector of \code{c(min, max)}. Cannot be out of the frame c(0, 100)
#' @param width The width of the dataZoom bar. Default 20px.
#' @param fill fillerColor of the dataZoom bar, in character \code{'rgba(red, green,
#' blue, alpha)'} format. Default 'rgba(144,197,237,0.2)' ("#90C5ED33").
#' @param handle handleColor of the dataZoom bar, in character \code{'rgba(red, green,
#' blue, alpha)'} format. Default 'rgba(70,130,180,0.8)' ("#4682B4CC").
#' @param bgColor background color. Default transparent ('rgba(0,0,0,0)')
#' @param dataBgColor background color of the data thumbnail (1st series). Default
#' '#eee'.
#' @param showDetail Logical, if show the details when zooming. Defaul TRUE.
#' @param realtime Logical, if realtime display the changes when zooming. Default FALSE.
#' @param zoomLock Logical, if the zoom range is locked. Deafult FALSE.
#' @param ... Elipsis
#' @return A modified echart object
#' @export
#'
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~dataZoom}
#' @examples
#' \dontrun{
#' g = iris %>% echartR(x=Sepal.Width, y=Petal.Width, series=Species, type='scatter')
#' g %>% setDataZoom(fill=rgba(c(col2rgb('gold'), 0.3)),
#' handle=rgba(c(col2rgb('gold'), 1)))
#'
#' g1 = iris %>% echartR(x=Sepal.Width, y=Petal.Width, t=Species, type='scatter')
#' g1 %>% setDataZoom(fill=rgba(c(col2rgb('lightgreen'), 0.2)),
#' handle=rgba(c(col2rgb('darkgreen'), 0.5)))
#' }
setDataZoom = function(chart, show=TRUE, pos=6, range=NULL, width=30,
fill='rgba(144,197,237,0.2)',
handle='rgba(70,130,180,0.8)', bgColor = 'rgba(0,0,0,0)',
dataBgColor = '#eee', showDetail=TRUE, realtime=FALSE,
zoomLock=FALSE, ...){
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)
if (hasT){
if (is.null(show)) {
chart$x$options[[1]]$dataZoom = NULL
return(chart %>% tuneGrid())
}
chart$x$options[[1]][['dataZoom']] = makeDataZoom(
show=show, pos=pos, range=range, fill=fill, handle=handle,
backgroundColor=bgColor, dataBackgroundColor=dataBgColor,
showDetail=showDetail, realtime=realtime, zoomLock=zoomLock
)
}else{
if (is.null(show)) {
chart$x$dataZoom = NULL
return(chart %>% tuneGrid())
}
chart$x[['dataZoom']] = makeDataZoom(
show=show, pos=pos, range=range, fill=fill, handle=handle,
backgroundColor=bgColor, dataBackgroundColor=dataBgColor,
showDetail=showDetail, realtime=realtime, zoomLock=zoomLock)
}
return(chart %>% tuneGrid())
}
makeDataRange = function(show=FALSE, pos=8, min=NULL, max=NULL, splitNumber=5,
itemGap=5, labels=NULL, calculable=FALSE,
borderColor='#ccc', borderWidth=0,
selectedMode=list(TRUE, 'single', 'multiple'),
color=c("#1e90ff", "#f0ffff"),
splitList=NULL, initialRange=NULL,
...){
# Work function for setDataRange
## color must be color vector
## splitList must be list(list(start=m, end=n, label=x, color=hex), ...)
## initialRange must be list(start=m, end=n)
if (is.null(show)) {
lstdataRange = NULL
} else {
if (! show){
lstdataRange = NULL
}else{
if (splitNumber == 0) calculable = TRUE
if (calculable) splitNumber = 0
lstdataRange = list(
show=show, calculable=calculable,
itemWidth=6, selectedMode=selectedMode[[1]]
)
if (is.numeric(pos[[1]]) && pos[[1]] <= 12){
lstdataRange[c('x', 'y', 'orient')] = vecPos(pos[[1]])
}else if (length(pos)==3 && tolower(pos[[1]]) %in%
c('left', 'right', 'center') &&
tolower(pos[[2]]) %in% c('top', 'center', 'bottom') &&
tolower(pos[[3]]) %in% c('vertical', 'horizontal')){
lstdataRange[c('x', 'y', 'orient')] = pos
}
if (!missing(color)) lstdataRange[['color']] = color
if (!missing(borderColor)) lstdataRange[['borderColor']] = borderColor
if (!missing(borderWidth)) lstdataRange[['borderWidth']] = borderWidth
if (!missing(labels)) {
if (length(labels) == 1) lstdataRange[['text']] = c(labels, "")
else lstdataRange[['text']] = labels[1:2]
}
if (!missing(min)) lstdataRange[['min']] = as.numeric(min)
if (!missing(max)) lstdataRange[['max']] = as.numeric(max)
if (!missing(splitList)) {
if (is.list(splitList) &&
all(names(splitList[[1]]) %in% c('start', 'end', 'label', 'color'))){
lstdataRange[['splitList']] = splitList
lstdataRange[['itemGap']] = itemGap
}
}else{
if (splitNumber > 0) {
lstdataRange[['itemGap']] = itemGap
lstdataRange[['splitNumber']] = splitNumber
}
}
if (calculable && !is.null(initialRange)){
if (is.list(initialRange) &&
all(names(initialRange) %in% c('start', 'end'))){
lstdataRange[['range']] = initialRange
lstdataRange$calculable = TRUE
}
}
}
}
return(lstdataRange)
}
#' Set \code{dataRange} Bar of Echarts
#'
#' When an echart object is generated, you can modify it by setting dataRange using
#' \code{\link{\%>\%}}.
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{\link{echartR}}
#' @param show logical. Show the dataRange control if TRUE. If you want to remove
#' dataRange from the echarts object, set it NULL.
#' @param pos the clock-position of dataRange, default 8. Refer to \code{\link{vecPos}}.
#' Or you can define the position vector \code{c(x, y, orient)} yourself.
#' @param valueRange The range of the dataRange bar in form of \code{c(min, max)}.
#' If NULL, echarts default will be used.
#' @param splitNumber How many discrete sections will the dataRange bar be divided into.
#' Default 5. Set it to 0 to set the bar continuous and calculable will be accordingly set TRUE.
#' @param itemGap The gap between itmes in pixels. Default 10px.
#' @param labels The labels to the ends the dataRange bar in form \code{c('high end',
#' 'low end')}. Default NULL, the min, max values will be used.
#' @param borderColor The border color of the dataRange bar. Default '#333'.
#' @param borderWidth The border width of the dataRange bar. Default 0px (not shown).
#' @param calculable Logical. If echart calculable feature is open. Default FALSE. If set
#' calculable TRUE, splitNumber will be set 0.
#' @param selectedMode The mode of the dataRange bar, default TRUE. You can also
#' set it 'single' or 'multiple'.
#' @param color The hex vector of colors used for dataRange bar. Default c("#1e90ff", "#f0ffff").
#' @param splitList A list for user-defined value split in the form of
#' \code{list(list(start=m, end=n, label=x, color=hex), ...)}. If a valid splitList is set,
#' splitNumber will be disabled.
#' @param initialRange Initial selected value range in the form of \code{list(start=m, end=n)}
#' @param ... Elipsis
#'
#' @return A modified echarts object
#' @export
#'
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~dataRange}
#' @examples
#' \dontrun{
#' g = iris %>% echartR(x=Sepal.Width, y=Petal.Width, series=Species, type='scatter')
#' g %>% setDataRange()
#'
#' g1 = iris %>% echartR(x=Sepal.Width, y=Petal.Width, t=Species, type='scatter')
#' g1 %>% setDataRange(valueRange=c(0, 2.5))
#' }
setDataRange = function(
chart, show=TRUE, pos=8, valueRange=NULL, splitNumber=5, itemGap=5,
labels=NULL, calculable=FALSE, borderColor='#ccc', borderWidth=0,
selectedMode=list(TRUE, 'single', 'multiple'),
color=c("#1e90ff", "#f0ffff"), splitList=NULL, initialRange=NULL,
...){
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)
if (! is.null(valueRange[1])) {
if (is.numeric(valueRange) && length(valueRange) > 1){
min = range(valueRange)[1]
max = range(valueRange)[2]
}else{
min = max = NULL
}
}else{
min = range(getYFromEChart(chart))[1]
max = range(getYFromEChart(chart))[2]
}
lst = makeDataRange(
show=show, pos=pos, min=min, max=max, splitNumber=splitNumber,
itemGap=itemGap, labels=labels, calculable=calculable,
borderColor=borderColor, borderWidth=borderWidth, selectedMode=selectedMode,
color=color, splitList=splitList, initialRange=initialRange
)
if (!is.null(lst)){
if (hasT){
if (is.null(show)) {
chart$x$options[[1]]$dataRange = NULL
return(chart %>% tuneGrid())
}
chart$x$options[[1]][['dataRange']] = lst
} else {
if (is.null(show)) {
chart$x$dataZoom = NULL
return(chart %>% tuneGrid())
}
chart$x[['dataRange']] = lst
}
}
return(chart %>% tuneGrid())
}
#' Set \code{legend} of Echarts
#'
#' When an echart object is generated, you can modify it by setting legend using
#' \code{\link{\%>\%}}.
#' You can modify the legend of the echarts object using this function.
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{\link{echartR}}
#' @param show Logical. Show the legend or not. Default TRUE. If you want to remove
#' legend from the echarts object, set it NULL.
#' @param pos Clock position of the legend. Default 11. Refer to \code{\link{vecPos}}.
#' Or you can define the position vector \code{c(x, y, orient)} yourself.
#' @param selected A vector of series names that are selected on load. If you assign 'none',
#' then none of the series will be selected in the beginning.
#' @param itemGap The gap between legend items. Default 5px.
#' @param borderColor The border color of the legend. Default '#ccc'.
#' @param borderWidth The border width of the legend. Default 0px (not shown).
#' @param textStyle A list of textStyle definition to decorate the text. E.g.,
#' \code{list(color='#444')} or \code{list(color='auto')}.
#' @param formatter A named formatter template or a string containing javascript codes.
#' E.g., \code{'{name}'}.
#' @param overideData A list of data to overide the legend text. E.g.,
#' \code{list(list(name='Series 1', icon='image://../asset/ico/favicon.png',
#' textStyle=list(color='#bbb')))}
#' @param ... Elipsis.
#'
#' @return A modified echarts object.
#' @export
#'
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~legend}
#' @examples
#' \donrun{
#' # No timeline
#' g = iris %>% echartR(x=Sepal.Width, y=Petal.Width, series=Species,
#' type='scatter')
#' g %>% setLegend(selected="versicolor")
#' g %>% setLegend(selected=levels(iris$Species)[1:2],
#' textStyle=textStyle(fontFamily='Times New Roman', color='purple',
#' fontWeight='bold', fontSize=16))
#'
#' # With Timeline
#' g1 = iris %>% echartR(x=Sepal.Width, y=Petal.Width, t=Species, type='scatter')
#' g1 %>% setLegend(pos=12, selected='none',
#' textStyle=list(fontFamily='Courier New', fontSize=16))
#' }
setLegend = function(
chart, show=TRUE, pos=11, selected=NULL, itemGap=5, borderColor='#ccc',
borderWidth=0, textStyle=list(color='auto'), formatter=NULL, overideData=NULL,
...){
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)
series = getSeriesPart(chart, 'category', fetch.all=TRUE)
if (!is.null(dim(series))) series = series[,1]
series = series[ifna(series, '') !='']
# get series name vector from echarts object
lstLegend = list(show=show, data=as.list(unique(series)))
if (is.numeric(pos[[1]]) && pos[[1]] <= 12){
lstLegend[c('x', 'y', 'orient')] = vecPos(pos[[1]])
}else if (length(pos)==3 && tolower(pos[[1]]) %in%
c('left', 'right', 'center') &&
tolower(pos[[2]]) %in% c('top', 'center', 'bottom') &&
tolower(pos[[3]]) %in% c('vertical', 'horizontal')){
lstLegend[c('x', 'y', 'orient')] = pos
}
if (!is.null(selected)){
unselected = unique(series[! series %in% selected])
lstLegend[['selected']] = emptyList()
for (item in unselected){
lstLegend[['selected']][[item]] = FALSE
}
if (length(selected) != length(series)){
if (length(unselected) == length(unique(series))-1)
lstLegend[['selectedMode']] = 'single'
else lstLegend[['selectedMode']] = 'multiple'
}
}
if (!missing(itemGap)) lstLegend[['itemGap']] = itemGap
if (!missing(borderColor)) lstLegend[['borderColor']] = borderColor
if (!missing(borderWidth)) lstLegend[['borderWidth']] = borderWidth
if (is.list(textStyle) && !identical(textStyle, list(color='auto')))
if (all(names(textStyle) %in% c('fontFamily', 'color', 'fontSize',
'fontStyle', 'fontWeight')))
lstLegend[['textStyle']] = textStyle
if (!missing(formatter)) lstLegend[['formatter']] = formatter
if (!missing(overideData))
if (all(names(overideData) %in% c('name', 'textStyle', 'icon')))
lstLegend[['data']] = overideData
if (! is.null(show)) {
if (hasT){
if (is.null(show)) {
chart$x$options[[1]]$legend = NULL
return(chart %>% tuneGrid())
}
chart$x$options[[1]][['legend']] = lstLegend
}else{
if (is.null(show)) {
chart$x$legend = NULL
return(chart %>% tuneGrid())
}
chart$x[['legend']] = lstLegend
}
}
return(chart %>% tuneGrid())
}
#' Set Theme Or Misc Aesthetics (color, background, animation, border effects) of Echarts
#'
#' Set the entire theme of Echarts. You can use a pre-installed theme or define
#' you own themes. \cr \cr
#' You can also set aesthetics of Echarts separately, including \code{color, bgColor,
#' animation, calculable, borderColor, borderWidth}.\cr \cr
#' When an echart object is generated, you can modify it by setting aesthetics using
#' \code{\link{\%>\%}}.
#'
#' @section Self-defined Themes (UDT):
#' You can design your prefered themes using
#' \url{http://echarts.baidu.com/echarts2/doc/example/themeDesigner.html}.\cr
#' \cr The UDTs in \code{echarts} are JS objects. You can write it in a list form
#' and \code{setTheme} will parse it into JSON string for process. \cr \cr
#' A typical theme JS looks like: \cr
#' \code{{\cr
#' color: ['#ff7f50','#87cefa','#da70d6','#32cd32','#6495ed'], \cr
#' title: {x: 'left', y: 'top'}, \cr
#' legend: {orient: 'horizontal'} \cr
#' }} \cr \cr
#' You should write in the format below: \cr
#' \code{list(color=c('#ff7f50','#87cefa','#da70d6','#32cd32','#6495ed'), \cr
#' title=list(x='left', y='top'), legend=list(orient='horizontal'))}
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{
#' \link{echartR}}
#' @param theme \describe{
#' \item{Pre-installed themes}{\code{'default', 'macarons', 'infographic', 'blue',
#' 'dark', 'gray', 'green', 'helianthus', 'macarons2', 'mint', 'red', 'roma',
#' 'sakura', 'shine', 'vintage'}}
#' \item{User-defined themes}{E.g., \code{list(color=c('#ff7f50', '#87cefa',
#' '#da70d6','#32cd32','#6495ed'), \cr
#' title=list(x='left', y='top'), legend=list(orient='horizontal'))}}
#' }
#' @param palette name of the palette or a color vector. Default NULL to get echarts default.
#' It could be:
#' \describe{
#' \item{\code{asis}}{keep the color palette applied in current echarts object}
#' \item{Echarts theme palette}{"_default", "_macarons", "_infographic",
#' "_blue", "_dark", "_gray", "_green", "_helianthus", "_macarons2", "_mint",
#' "_red", "_roma", "_sakura", "_shine", "_vintage"}
#' \item{\link{RColorBrewer} palettes}{Including 'BrBG', 'PiYG', 'PRGn', 'PuOr', 'RdBu',
#' 'RdGy', 'RdYlBu', 'RdYlGn', 'Spectral', 'Accent', 'Dark2', 'Paired', 'Pastel1',
#' 'Pastel2', 'Set1', 'Set2', 'Set3', 'Blues', 'BuGn', 'BuPu', 'GnBu', 'Greens',
#' 'Greys', 'Oranges', 'OrRd', 'PuBu', 'PuBuGn', 'PuRd', 'Purples', 'RdPu', 'Reds',
#' 'YlGn', 'YlGnBu', 'YlOrBr', 'YlOrRd'}
#' \item{\link{ggthemes} palettes}{'calc', 'economist', 'economist_white', 'economist_stata',
#' 'excel', 'exel_fill', 'excel_line', 'excel_new', 'few', 'fivethirtyeight', '538', 'manyeyes',
#' 'gdocs', 'pander', 'tableau', 'stata', 'stata1','stata1r','statamono', 'ptol',
#' 'tableau20', 'tableau10medium', 'tableaugray', 'tableauprgy', 'tableaublrd',
#' 'tableaugnor', 'tableaucyclic', 'tableau10light', 'tableaublrd12', 'tableauprgy12',
#' 'tableaugnor12','hc','darkunica', 'solarized','solarized_red', 'solarized_yellow',
#' 'solarized_orange', 'solarized_magenta', 'solarized_violet', 'solarized_blue',
#' 'solarized_cyan', 'solarized_green', 'wsj', 'wsj_rgby', 'wsj_red_green',
#' 'wsj_black_green', 'wsj_dem_rep', 'colorblind', 'trafficlight'}
#' \item{Aetna official palettes}{Including 'aetnagreen', 'aetnablue', 'aetnaviolet',
#' 'aetnaorange', 'aetnateal', 'aetnacranberry'}
#' \item{Other palettes}{'rainbow', 'terrain', 'topo', 'heat', 'cm'}
#' }
#' \strong{Usage:} \cr
#' \itemize{
#' \item If the value is not set, and the function defaults will be loaded \cr
#' \item Set palette=NULL to use Echarts defaults \cr
#' \item Set palette=palette name to assign any palette listed above \cr
#' \item Set palette=\code{palette name(number)} to restrict number of colors within the
#' palette (e.g., \code{palette='calc(3)'} picks 3 colors out of 'calc' \strong{RANDOMLY}) \cr
#' \item Set palette=\code{c(color1, color2, color3, ...)} to define a palette vector,
#' made of which either color names or Hex expressions. Use \code{\link{colors}()} to check
#' available color names and check the effects using \code{demo(colors)}.
#' }
#' @param bgColor Color name/value of the background. Default is transparent
#' (\code{'rgba(0,0,0,0)'})
#' @param renderAsImage Logical. If TRUE, the interactive effects are disabled. Default FALSE.
#' @param calculable Logical. If TRUE, the chart is re-calculated after drag. Default FALSE.
#' @param calculableColor The border color of the tooltip during \code{calculable} effect.
#' Default 'rgba(255,165,0,0.6)'.
#' @param calculableHolderColor The color of \code{calculableHolder}. Default '#ccc'.
#' @param animation Logical. If TRUE, the animation is on at initiation. Default TRUE.
#' For IE8, it is recommended to set FALSE.
#' @param animationEasing The slight moving effect of major elements. Default 'ExponentialOut'.
#' Other choices: 'Linear', 'QuadraticIn', 'QuadraticOut', 'QuadraticInOut', 'CubicIn',
#' 'CubicOut', 'CubicInOut', 'QuarticIn', 'QuarticOut', 'QuarticInOut', 'QuinticIn',
#' 'QuinticOut', 'QuinticInOut', 'SinusoidalIn', 'SinusoidalOut', 'SinusoidalInOut',
#' 'ExponentialIn', 'ExponentialInOut', 'CircularIn', 'CircularOut', 'CircularInOut',
#' 'ElasticIn', 'ElasticOut', 'ElasticInOut', 'BackIn', 'BackOut', 'BackInOut',
#' 'BounceIn', 'BounceOut', 'BounceInOut'
#' @param animationDuration The duration into animation. Default 2000 (ms).
#' @param width Width (px) of the whole chart.
#' @param height Height (px) of the whole chart.
#' @param ... Elipsis
#'
#' @return A modified echarts object
#' @importFrom jsonlite toJSON
#' @export
#'
#' @seealso \code{\link{brewer.pal}}, \code{\link{colors}}
#' @references
#' \code{theme} \cr
#' \url{http://echarts.baidu.com/echarts2/doc/example/theme.html} \cr \cr
#' \code{backgroundColor} \cr
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#title~backgroundColor} \cr \cr
#' \code{colors} \cr
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#title~color} \cr
#' \url{http://colorbrewer2.org} \cr \cr
#' \code{other features} \cr
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#title~renderAsImage} \cr
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#title~calculable} \cr
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#title~animation} \cr
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#title~calculableColor} \cr
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#title~calculableHolderColor}
#' @examples
#' \dontrun{
#' g = echartR(iris, Sepal.Width, Petal.Width, series=Species)
#'
#' # Set themes
#' ## pre-installed themes
#' g %>% setTheme("infographic")
#' g %>% setTheme("blue")
#' g %>% setTheme("dark")
#' g %>% setTheme("gray")
#' g %>% setTheme("green")
#' g %>% setTheme("helianthus")
#' g %>% setTheme("macarons2")
#' g %>% setTheme("mint")
#' g %>% setTheme("red")
#' g %>% setTheme("sakura")
#' g %>% setTheme("shine")
#' g %>% setTheme("vintage")
#'
#' ## self-defined themes
#' theme = list(color=c("#7AC143", "#7D3F98", "#F47721", "#D20962", "#00A78E",
#' "#00BCE4", "#B8D936", "#EE3D94"), backgroundColor="#fef8ef")
#' g %>% setTheme(theme)
#'
#' ## Misc aethetics
#' g = echartR(iris, x=Sepal.Width, y=Petal.Width, series=Species, type='scatter')
#' g %>% setTheme(palette='hc')
#' g %>% setTheme(palette=c('red', 'gold', 'deepskyblue'), 'gray95',
#' animationHoldColor='red', animationEasing='CircularOut',
#' animationDuration=10000)
#' }
setTheme = function(
chart, theme=c(
'asis', 'default', 'macarons', 'infographic', 'blue', 'dark', 'gray', 'green',
'helianthus', 'macarons2', 'mint', 'red', 'roma', 'sakura', 'shine', 'vintage'),
palette='asis', bgColor=NULL, renderAsImage=FALSE, calculable=FALSE,
calculableColor=NULL, calculableHolderColor=NULL, animation=TRUE,
animationEasing=NULL, animationDuration=NULL, width=NULL, height=NULL,
...){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
## pass theme in
if (is.list(theme)){
theme = toJSON(theme)
}else{
theme = match.arg(theme)
}
if (!identical(theme, 'asis')) chart$x[['theme']] = theme
if (missing(theme) || is.null(theme)) chart$x[['theme']] = NULL
hasT = 'baseOption' %in% names(chart$x)
## set colors
### get color
if (is.list(theme)){
colors = if ('color' %in% names(theme)) theme$color else NULL
}else{
colors = getColors(paste0(theme, 'theme'))
}
### set color
if (hasT){
nSeries = sapply(chart$x$options, function(lst) {
return(length(lst$series))
})
nSeries = max(unlist(nSeries))
if (!missing(palette)) if (!identical(palette, 'asis')) {
lstColor = as.list(getColors(palette, n=nSeries))
chart$x$options[[1]][['color']] = lstColor[1:nSeries]
}
lsts = chart$x$options
lst = chart$x$options[[1]]
}else{
nSeries = length(getSeriesPart(chart, 'category', fetch.all=TRUE))
if (nSeries == 0) nSeries = 1
if (!missing(palette)) if (!identical(palette, 'asis')) {
lstColor = as.list(getColors(palette, n=nSeries))
chart$x[['color']] = lstColor[1:nSeries]
}
lst = chart$x
}
if (!missing(palette)) if (!identical(palette, 'asis'))
colors = getColors(palette)
### special chart type, special color setting
### if wordCloud, change itemStyle one by one
if (any('wordCloud' %in% getSeriesPart(chart, 'type'))){
if (hasT){
for (iZ in seq_along(lsts)){
vecS = seq_along(lsts[[iZ]]$series)
vWC = sapply(vecS, function(i) lsts[[iZ]]$series[[i]]$type)
iWC = which(vWC=='wordCloud')
if (length(iWC) >0)
for (iS in iWC) {
colorMeta = getMeta(lsts[[iZ]]$series[[iS]]$data)
itemCol = if (!is.null(colorMeta)){
colors = rep(
colors, ceiling(nlevels(colorMeta)/length(colors)))
colors = colors[1:nlevels(colorMeta)]
}else NULL
lapply(seq_along(lsts[[iZ]]$series[[iS]]$data),
function(i){
lsts[[iZ]]$series[[iS]]$data[[i]]$itemStyle$normal$color <<-
if (is.null(itemCol)) sample(colors, 1) else
itemCol[as.numeric(colorMeta)[i]]
})
lst = lsts[[1]]
}
}
}else{
vecS = seq_along(lst$series)
vWC = sapply(vecS, function(i) lst$series[[i]]$type)
iWC = which(vWC=='wordCloud')
if (length(iWC) >0)
lapply(iWC, function(iS){
colorMeta = getMeta(lst$series[[iS]]$data)
itemCol = if (!is.null(colorMeta)){
colors = rep(
colors, ceiling(nlevels(colorMeta)/length(colors)))
colors = colors[1:nlevels(colorMeta)]
}else NULL
lapply(seq_along(lst$series[[iS]]$data), function(i){
lst$series[[iS]]$data[[i]]$itemStyle$normal$color <<-
if (is.null(itemCol)) sample(colors, 1) else
itemCol[as.numeric(colorMeta[i])]
})
})
}
}
## set the rest elements
if (!missing(bgColor)) {
lst[['backgroundColor']] = ifelse(
grepl("^rgba\\(", bgColor), bgColor, getColors(bgColor))
if (grepl("^rgba\\(", bgColor)){
backColor = as.numeric(unlist(strsplit(bgColor,
"[\\(,\\)]"))[2:5])
contrastColor = c(rep(255, 4) - backColor)
contrastColor = paste0('rgba(', paste(contrastColor, collapse=","),
')')
}else if (grepl("^#", bgColor)){
cColor = c(rep(255, 4) - col2rgb(bgColor, TRUE))
contrastColor = rgb(cColor[1], cColor[2], cColor[3], max=255)
}
}
if (!missing(renderAsImage)) lst[['renderAsImage']] = renderAsImage
if (!missing(calculable)) lst[['calculable']] = calculable
if (!missing(calculableColor))
lst[['calculableColor']] = ifelse(
grepl("^rgba\\(", calculableColor), calculableColor,
getColors(calculableColor))
if (!missing(calculableHolderColor))
lst[['calculableHolderColor']] = ifelse(
grepl("^rgba\\(", calculableHolderColor), calculableHolderColor,
getColors(calculableHolderColor))
if (!missing(animation)) lst[['animation']] = FALSE
if (!missing(animationEasing))
if (animationEasing %in%
c('Linear', 'QuadraticIn', 'QuadraticOut', 'QuadraticInOut',
'CubicIn', 'CubicOut', 'CubicInOut', 'QuarticIn', 'QuarticOut',
'QuarticInOut', 'QuinticIn', 'QuinticOut', 'QuinticInOut',
'SinusoidalIn', 'SinusoidalOut', 'SinusoidalInOut', 'ExponentialIn',
'ExponentialInOut', 'CircularIn', 'CircularOut', 'CircularInOut',
'ElasticIn', 'ElasticOut', 'ElasticInOut', 'BackIn', 'BackOut',
'BackInOut', 'BounceIn', 'BounceOut', 'BounceInOut'))
lst[['animationEasing']] = animationEasing
if (!missing(animationDuration)){
lst[['animationDuration']] = animationDuration
if (hasT) chart$x$baseOption$timeline[['playInterval']] = animationDuration
}
## merge list back to echarts object
if (hasT) {
chart$x$baseOption = mergeList(chart$x$baseOption, lst)
chart$x$options = lsts
}else chart$x = lst
## width and height
if (!is.null(width)) chart[['width']] = width
if (!is.null(height)) chart[['height']] = height
return(chart)
}
makeTooltip = function(type, trigger=NULL, formatter=NULL,
islandFormatter='{a} < br/>{b} : {c}',
position=NULL, enterable=FALSE, axisPointer=NULL,
textStyle=NULL, showDelay=20, hideDelay=100,
transitionDuration=0.4, bgColor='rgba(0,0,0,0.7)',
borderColor='#333', borderWidth=0, borderRadius=4,
show=TRUE, keepDefault=FALSE, timeIndex=NULL, ...){
if (!ifnull(show, TRUE)) {
lstTooltip = list(show=FALSE)
}else{
if (is.null(trigger)){
trigger = ifelse(
type %in% c('pie', 'funnel', 'map', 'wordcloud', 'radar', 'chord',
'force', 'gauge', 'eventRiver', 'tree', 'treemap'),
'item', 'axis')
}else{
trigger = match.arg(trigger, c('item', 'axis'))
}
lstTooltip = list(show = ifnull(show, TRUE), trigger = trigger)
## fetch default features
lstTooltip[c('axisPointer', 'textStyle')] <-
list(list(
type=ifelse(type %in% c('line'), 'line',
ifelse(type %in% c('bar'), 'shadow',
ifelse(type %in% c('scatter', 'map', 'heatmap'),
'cross', 'none'))),
crossStyle=list(type='dashed'),
lineStyle=list(type='solid', width=1),
shadowStyle=list(color='rgba(150,150,150,0.3)', width='auto',
type='default')
),
list(color='#fff')
)
if (keepDefault){
lstTooltip[c('islandFormatter', 'enterable', 'showDelay', 'hideDelay',
'transitionDuration', 'backgroundColor', 'borderWidth')] <-
list('{a} < br/>{b} : {c}', FALSE, 20, 100, 0.4, '#333', 0)
}
## fetch features
if (!is.null(position)) lstTooltip[['position']] = position
if (!is.null(formatter)) lstTooltip[['formatter']] = formatter
if (!is.null(islandFormatter))
lstTooltip[['islandFormatter']] = islandFormatter
if (!is.null(enterable)) lstTooltip[['enterable']] = enterable
if (!is.null(axisPointer)) {
if (all(names(axisPointer) %in% c('type', 'lineStyle', 'crossStyle',
'shadowStyle', 'textStyle'))){
lstTooltip[['axisPointer']] = axisPointer
}
else warning(paste(
"axisPointer must be a list containing any of the below:\n",
"'type', 'lineStyle', 'crossStyle', 'shadowStyle', 'textStyle'."))
}
if (!is.null(textStyle)) {
if (all(names(textStyle) %in% c(
'color', 'decoration', 'align', 'baseline', 'fontFamily',
'fontSize', 'fontStyle', 'fontWeight')))
lstTooltip[['textStyle']] = textStyle
else warning(paste(
"textStyle must be a list containing any of the below:\n",
"'color', 'decoration', 'align', 'baseline', 'fontFamily',",
"'fontSize','fontStyle', 'fontWeight'."))
}
if (!is.null(showDelay)) lstTooltip[['showDelay']] = showDelay
if (!is.null(hideDelay)) lstTooltip[['hideDelay']] = hideDelay
if (!is.null(transitionDuration))
lstTooltip[['transitionDuration']] = transitionDuration
if (!is.null(bgColor))
lstTooltip[['backgroundColor']] = getColors(bgColor)[1]
if (!is.null(borderColor))
lstTooltip[['borderColor']] = getColors(borderColor)[1]
if (!is.null(borderWidth)) lstTooltip[['borderWidth']] = borderWidth
if (!is.null(borderRadius))
lstTooltip[['borderRadius']] = borderRadius
}
return(lstTooltip)
}
determineFormatter = function(type){
if (type %in% c('scatter')){
formatter = tooltipJS('scatter')
}else if (type %in% c('scatter_time')){
formatter = tooltipJS('scatter_time')
}else if (type %in% c('pie')){
formatter = tooltipJS('pie')
}else if (type %in% c('pie')){
formatter = tooltipJS('pie')
}else if (type %in% c('chord', 'force')){
# if (length(getSeriesPart(chart, 'name')) == 1){
# formatter = tooltipJS('chord_mono')
# }else{
formatter = tooltipJS('chord_multi')
# }
}else if (type == 'k'){
formatter = tooltipJS('k')
}else if (type %in% c('bar', 'line')){
formatter = tooltipJS('line')
}else if (type %in% c('bar_time', 'line_time')){
formatter = tooltipJS('line_time')
}else if (type == 'histogram'){
formatter = tooltipJS('hist')
}else{
formatter = NULL # use default
}
return(formatter)
}
#' Set \code{tooltip} of Echarts
#'
#' Set tooltip of Echarts, at various levels (entire chart, specific series) with
#' various formats. \cr
#' When an echart object is generated, you can modify it by setting tooltip using
#' \code{\link{\%>\%}}.
#' @note Note that the \code{tooltip} feature is inheritable in terms of timeline.
#' \code{setTooltip} automatically breaks the inheritability by resetting tooltip
#' formats in the timeslots following the timeslots whose tooltip format are changed.
#' .
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{\link{echartR}}
#' @param series A vector of series indices or names. e.g., \code{c('setosa', 'virginica')}
#' or \code{1:2}
#' @param timeslots A vector of time slices indices or names, e.g., \code{c(1990, 1992)}
#' or \code{c(1,3)}. You can also use \code{t} as a short form of \code{timeslots}.
#' @param trigger Type of trigger, \code{'item'}, or \code{'axis'}.
#' @param formatter The format of the tooltip content.
#' \describe{
#' \item{string(template)}{
#' \itemize{
#' \item \{a\} | \{a0\}
#' \item \{b\} | \{b0\}
#' \item \{c\} | \{c0\}
#' \item \{d\} | \{d0\} (not applicable for some types)
#' \item \{e\} | \{e0\} (not applicable for some types)
#' }}
#' \item{function}{the JS list is in the form \code{[params, ticket, callback]}.}
#' }
#' \strong{Meanings of \{a\}, \{b\}, \{c\}, \{d\}...}
#' \tabular{ll}{
#' line, bar, k \tab \code{a} (series name), \code{b} (category name), \code{c} (value) \cr
#' scatter \tab \code{a} (series name), \code{b} (data name), \code{c} (value array) \cr
#' map \tab\code{a}(series name), \code{b} (area name), \code{c} (combined value) \cr
#' pie, radar, gauge, funnel \tab \code{a} (series names), \code{b}(data item name),
#' \code{c} (value), \code{d} (pie:percent|radar:indicator) \cr
#' force, chord \tab \itemize{
#' \item nodes: \code{a} (series name), \code{b} (node name), \code{c} (node value),
#' \code{d} (node type index);
#' \item links: \code{a} (series name), \code{b} (link name), \code{c} (link value),
#' \code{d} (big node name/index), \code{e} (small node/index)
#' }
#' }
#' \strong{JS Function Param Template...}
#' \tabular{ll}{
#' \code{seriesIndex} \tab 0, 1, 2, ... \cr
#' \code{seriesName} \tab 'Monday', 'Tuesday', ... \cr
#' \code{name} \tab 'day1', 'day2', ... \cr
#' \code{dataIndex} \tab 0, 1, 2, ... \cr
#' \code{data} \tab data \cr
#' \code{value} \tab value \cr
#' \code{percent} \tab special //pie \cr
#' \code{indicator} \tab special //radar, force, chord \cr
#' \code{value2} \tab special2 //force, chord \cr
#' \code{indicator2} \tab special2 //force, chord
#' }
#' @param islandFormatter Formatter of data island for calcualable effect. Can be
#' string (default \code{'{a} <br/>{b} : {c}'}) or JS function.
#' @param position Can be fixed position array \code{c(x, y)} or a JS function, e.g.,
#' \code{JS('function([x, y]) {return [newX, newY]}')}. Default NULL.
#' @param enterable If users can click into the tooltip for interacions. Default FALSE.
#' @param axisPointer The pointer formatter of axis. Default is a list \code{
#' list(type = "line", \cr
#' lineStyle = list(color = "#48b", width = 2, type = "solid"), \cr
#' crossStyle = list(color = "#1e90ff", width = 1, type = "dashed"), \cr
#' shadowStyle = list(color = "rgba(150,150,150,0.3)", width = "auto", type = "default") \cr
#' )}.
#' @param textStyle text style of the tooltip. In a list form. Default \code{list(color
#' ="#fff")}. The list coud contain elements of \code{color, decoration, fontSize,
#' fontFamily, fontStyle, fontWeight, align, baseline}.
#' @param showDelay Delayed time at show (ms). Default 20ms.
#' @param hideDelay Delayed time at hide (ms). Default 100ms.
#' @param transitionDuration The time spent at animation exchange. Default 0.4. Set
#' if 0 if you want real-time interaction.
#' @param bgColor Background color of tooltips. Default 'rgba(0,0,0,0.7)' (
#' semi-transparent dark gray).
#' @param borderColor Borderline color of the tooltips. Default '#333'.
#' @param borderWidth Border width of the tooltips. Default 0 (not shown).
#' @param borderRadius Border radius of the tooltips. Default 4px.
#' @param show Logical. If the tooltips are shown. Default TRUE.
#' @param ... Elipsis
#'
#' @return A modified echarts object
#' @export
#'
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~tooltip}
#' @examples
#' \dontrun{
#' g = echartR(iris, Sepal.Width, Petal.Width, series=Species)
#'
#' ## global tooltip
#' g %>% setTooltip(trigger='item', bgColor='rgba(0,0,200,0.7)')
#'
#' ## series-specific tooltip
#' bg = sapply(c('orange', 'deepskyblue', 'violet'), col2rgb)
#' bg = rbind(bg, 0.7) # extend the color matrix with alpha 0.7
#' bgCol = unname(apply(bg, 2, rgba)) # get rgba colors with alpha
#' g %>% setTooltip(series='setosa', bgColor=bgCol[1]) %>%
#' setTooltip(series=2, bgColor=bgCol[2]) %>%
#' setTooltip(series=3, bgColor=bgCol[3])
#'
#' ## series-and-timeline-specific tooltip
#' bg = sapply(c('orange', 'deepskyblue', 'violet'), col2rgb)
#' bg = rbind(bg, 0.7) # extend the color matrix with alpha 0.7
#' bgCol = unname(apply(bg, 2, rgba)) # get rgba colors with alpha
#' iris$tag = 1 + as.integer(row.names(iris)) %% 3
#' iris = iris[order(iris$tag),]
#' g1 = echartR(iris, Sepal.Width, Petal.Width, series=Species, t=tag)
#' g1 %>% setTooltip(series='setosa', bgColor=bgCol[1]) %>%
#' setTooltip(series=2, bgColor=bgCol[2]) %>%
#' setTooltip(series=3, bgColor=bgCol[3]) %>%
#' setTooltip(t=1, borderColor='red', borderWidth=3) %>%
#' setTooltip(t=2, borderColor='gold', borderWidth=3) %>%
#' setTooltip(t=3, borderColor='green', borderWidth=3)
#'
#' g1 %>% setTooltip(series=2, t=2, bgColor='blue')
#' # tooltip format of series 2 in the 2nd timeslot is changed to bg blue,
#' # while it in the 3rd timeslot is reset to default
#' }
setTooltip = function(chart, series=NULL, timeslots=NULL, trigger=NULL,
formatter=NULL, islandFormatter='{a} < br/>{b} : {c}',
position=NULL, enterable=FALSE, axisPointer=NULL, textStyle=NULL,
showDelay=20, hideDelay=100, transitionDuration=0.4,
bgColor='rgba(0,0,0,0.7)', borderColor='#333',
borderWidth=0, borderRadius=4, show=TRUE,
...){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
if ('t' %in% names(list(...))) timeslots = list(...)[['t']]
chartTypes = getSeriesPart(chart, 'type')
if ('eventRiver' %in% chartTypes) enterable = TRUE
if (is.null(dim(chartTypes))) chartTypes = as.matrix(chartTypes, ncol=1)
uniSeries = getSeriesPart(chart, 'category', fetch.all=TRUE)
if (!is.null(dim(uniSeries))) uniSeries = uniSeries[,1]
hasT = 'baseOption' %in% names(chart$x)
timeXAxis = FALSE
if (! hasT) {
timeslots = NULL
if ('xAxis' %in% names(chart$x)) if (chart$x$xAxis[[1]]$type == 'time'){
trigger = 'item'
timeXAxis = TRUE
}
}else{
timeslotsIndex = seq_len(length(chart$x$baseOption$timeline$data))
if (!is.null(timeslots)){
if (all(is.numeric(timeslots))){
vecZ = timeslots[timeslots %in% timeslotsIndex]
}else{
vecZ = which(timeslotsIndex %in% timeslots)
}
}
if ('xAxis' %in% names(chart$x$options[[1]]))
if (chart$x$options[[1]]$xAxis[[1]]$type == 'time') {
trigger = 'item'
timeXAxis = TRUE
}
}
if (length(chartTypes) == 1) {
series = NULL
}else{
seriesIndex = seq_len(length(uniSeries))
if (!is.null(series)){
if (all(is.numeric(series))){
vecS = series[series %in% seriesIndex]
}else{
vecS = which(uniSeries %in% series)
}
}
}
setAlongSZ = c(!is.null(series), !is.null(timeslots))
## By default, do not set tooltip along series or t
if (ifnull(show, TRUE)){
if (hasT){
if (is.null(chart$x$options[[1]][['tooltip']]))
chart$x$options[[1]][['tooltip']] = list(show=TRUE)
else
chart$x$options[[1]][['tooltip']][['show']]=TRUE
}else{
if (is.null(chart$x[[1]][['tooltip']]))
chart$x[['tooltip']] = list(show=TRUE)
else
chart$x[['tooltip']][['show']]=TRUE
}
}
fixedPart = "makeTooltip(
trigger=trigger, islandFormatter=islandFormatter, position=position,
enterable=enterable, axisPointer=axisPointer, textStyle=textStyle,
showDelay=showDelay, hideDelay=hideDelay,
transitionDuration=transitionDuration,
bgColor=bgColor, borderColor=borderColor,
borderWidth=borderWidth, borderRadius=borderRadius,
show=show, formatter=ifnull(formatter, determineFormatter('"
defaultPart = "makeTooltip(keepDefault=TRUE, type='"
if (identical(setAlongSZ, c(FALSE, FALSE))){ # global set
lhs = ifelse(hasT, "chart$x$options[[1]][['tooltip']]",
"chart$x[['tooltip']]")
rhs = paste0(fixedPart, chartTypes[[1]],
ifelse(timeXAxis, "_time'", "'"), ")), type='",
chartTypes[[1]], "')")
}else if (identical(setAlongSZ, c(TRUE, FALSE))){ # set along series
if (hasT) lhs = paste0("chart$x$options[[1]]$series[[",
vecS, "]][['tooltip']]")
else lhs = paste0("chart$x$series[[", vecS, "]][['tooltip']]")
rhs = paste0(fixedPart, chartTypes[vecS, 1],
ifelse(timeXAxis, "_time'", "'"), ")), type='",
chartTypes[vecS, 1], "')")
}else if (identical(setAlongSZ, c(FALSE, TRUE))){ # set along timeline
if (hasT) { # if not hasT, this senario fails
lhs = paste0("chart$x$options[[", vecZ, "]][['tooltip']]")
rhs = paste0(fixedPart, chartTypes[1, vecZ],
ifelse(timeXAxis, "_time'", "'"), "')), type='",
chartTypes[1, vecZ], "')")
# the following item to vecZ be reset to default
vecZ1 = vecZ + 1
if (any(vecZ1 > length(chart$x$baseOption$timeline$data))){
vecZ1[length(vecZ1)] = min(timeslotsIndex[!timeslotsIndex %in%
c(vecZ, vecZ1)])
}
lhs1 = paste0("chart$x$options[[", vecZ1, "]][['tooltip']]")
rhs1 = paste0(defaultPart, chartTypes[1, vecZ1], "')")
lhs = c(lhs, lhs1)
rhs = c(rhs, rhs1)
}
}else{ # set along s and t
vecZS = as.matrix(expand.grid(vecZ, vecS))
vecZ1 = vecZ + 1
if (any(vecZ1 > length(chart$x$baseOption$timeline$data))){
vecZ1[length(vecZ1)] = min(timeslotsIndex[!timeslotsIndex %in%
c(vecZ, vecZ1)])
}
vecZS1 = as.matrix(expand.grid(vecZ1, vecS))
if (hasT) {
lhs = paste0("chart$x$options[[", vecZS[,1], "]]$series[[",
vecZS[,2], "]][['tooltip']]")
lhs1 = paste0("chart$x$options[[", vecZS1[,1], "]]$series[[",
vecZS1[,2], "]][['tooltip']]")
}else{
lhs = paste0("chart$x[[", vecZS[,1], "]]$series[[", vecZS[,2],
"]][['tooltip']]")
lhs1 = paste0("chart$x[[", vecZS1[,1], "]]$series[[", vecZS1[,2],
"]][['tooltip']]")
}
rhs = paste0(fixedPart, chartTypes[vecZS],
ifelse(timeXAxis, "_time'", "'"), "')), type='",
chartTypes[vecZS], "')")
rhs1 = paste0(defaultPart, chartTypes[vecZS1], "')")
lhs = c(lhs, lhs1)
rhs = c(rhs, rhs1)
}
eval(parse(text=paste(lhs, "<-", rhs)))
return(chart)
}
#' @export
#' @rdname setTooltip
setTT = setTooltip
#' Set \code{timeline} of Echarts
#'
#' Set timeline of Echarts when the echarts object contains timeline slices (t). \cr
#' When an echart object is generated, you can modify it by setting tooltip using
#' \code{\link{\%>\%}}.
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{\link{echartR}}
#' @param show Logical. If or not the timeline is shown. Default TRUE. If you want
#' to remove timeline from the echarts object, set if NULL.
#' @param type 'time' or 'number' format of the timeline. Default 'time'.
#' @param realtime Logical. If or not the changes take effect in realtime manner.
#' Default TRUE.
#' @param x x coordinate of the upper left point of the timeline bar. Default 80.
#' @param y y coordinate of the upper left point of the timeline bar. Default NULL
#' (automatic).
#' @param x2 x coordinate of the upper left point of the timeline bar. Default 80.
#' @param y2 y coordinate of the upper left point of the timeline bar. Default 0.
#' @param width Width of the timeline. Could be a number or a character in percent
#' form. Default NULL.
#' @param height Height of the timeline. Default 50 (px).
#' @param bgColor Background color of the timeline. Default "rgba(0,0,0,0)" (transparent).
#' @param borderColor Border color of the timeline. Default "#ccc".
#' @param borderWidth Border width of the timeline. Default 0 (px) (not shown).
#' @param controlPosition Position of the control of the timeline. Could be 'left',
#' 'right' or 'none'. Default 'left'.
#' @param autoPlay Logical. If or not the timeline auto displays. Default FALSE.
#' @param loop Logical. If or not the timeline displays in loop mode. Default TRUE.
#' @param playInterval Interval when displays each timeslice. Default 2000 (ms).
#' @param lineStyle A list. Line style of the timeline. Default value: \cr
#' \code{list(color="#666", width=1, type="dashed")}. \cr Supports features of \code{'color',
#' 'width', 'type', 'shadowColor', 'shadowBlur', 'shadowOffsetX', 'shadowOffsetY'}
#' @param label A list. Label style of the timeline. Default value: \cr
#' \code{list(show=TRUE, interval="auto", rotate=0, formatter=NULL, \cr
#' textStyle=list(color="#333"))}. \cr Supports features of \code{'show', 'interval',
#' 'rotate', 'formatter', 'textStyle'}.
#' @param checkpointStyle A list. Checkpoint style of the timeline. Default value: \cr
#' \code{list(symbol="auto", symbolSize="auto", color="auto", \cr
#' borderColor="auto", borderWidth="auto", \cr
#' label=list(show=FALSE, textStyle=list(color="auto")))}. \cr
#' Supports features of \code{'symbol', 'symbolSize', 'color', 'borderColor',
#' 'borderWidth', 'label'}.
#' @param controlStyle A list. Control style of the timeline. Default value: \cr
#' \code{list(itemSize=15, itemGap=5, normal=list(color="#333"),
#' emphasis=list(color="#1e90ff"))}. \cr
#' Supports features of \code{'itemSize', 'itemGap', 'normal', 'emphasis'}.
#' @param symbol Character. The symbol used in timeline. Default 'emptyDiamond'.
#' You can use symbols in \code{\link{setSymbols}}.
#' @param symbolSize The size of the symbols. Default 4.
#' @param currentIndex The current index position, in correspondance with \code{t}.
#' It is used to show specific timeline slices. Default 0.
#' @param data The data list of the timeline, also used as timeline data label.
#' Default NULL.
#' @param ... Elipsis
#'
#' @return A modified echarts object
#' @export
#'
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~timeline}
#' @examples
#' \dontrun{
#' ## type = "number"
#' iris$tag = 1 + as.integer(row.names(iris)) %% 3
#' iris = iris[order(iris$tag),]
#' g = echartR(iris, Sepal.Width, Petal.Width, series=Species, t=tag)
#' g %>% setTimeline(y2=30, symbol='emptyCircle',
#' autoPlay=FALSE, data=c('tag 1', 'tag 2', 'tag 3'))
#'
#' ## type = "time"
#' ### You have to use a js function to reformat the label if you want to change
#' ### the label text
#' iris$date = as.Date(paste0("2013-1-", 1 + as.integer(row.names(iris)) %% 5))
#' iris = iris[order(iris$date),]
#' g = echartR(iris, Sepal.Width, Petal.Width, series=Species, t=date)
#' g %>% setTimeline(y2=30, symbol='emptyCircle', autoPlay=FALSE, label=list(
#' formatter=JS(paste('function(s) {return s.slice(8,10) + "\u65e5";}'))))
#' }
#'
setTimeline = function(chart, show=TRUE, type=c('time', 'number'), realtime=TRUE,
x=80, y=NULL, x2=80, y2=0, width=NULL, height=50,
bgColor='rgba(0,0,0,0)', borderColor='#ccc',
borderWidth=0, controlPosition=c('left', 'right', 'none'),
autoPlay=FALSE, loop=TRUE, playInterval=2000,
lineStyle=NULL, label=NULL, checkpointStyle=NULL,
controlStyle=NULL, symbol='emptyDiamond', symbolSize=4,
currentIndex=0, data=NULL,
...){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
if (! 'baseOption' %in% names(chart$x)) return(chart)
else if (is.null(show)) {
chart$x$baseOption$timeline = NULL
return(chart %>% tuneGrid())
}
lst = chart$x$baseOption$timeline
type = match.arg(type)
if (inherits(getMeta(chart$x$options[[1]])$t[,1],
c("Date", "POSIXct", "POSIXlt"))){
type = 'time'
}else{
type = 'number'
}
controlPosition = match.arg(controlPosition)
if (! tolower(symbol) %in% tolower(validSymbols)){
symbol = 'emptyDiamond'
}else{
symbol = validSymbols[which(tolower(validSymbols) %in% tolower(symbol))]
}
## default params
if (! ifnull(show, TRUE)) lst$show = show
if (! ifnull(type, 'time') == 'time') lst$type = type
if (! ifnull(realtime, TRUE)) lst$realtime = realtime
if (! ifnull(x, 80) == 80) lst$x = x
if (! is.null(y)) lst$y = y
if (! ifnull(x2, 80) == 80) lst$x2 = x2
if (! ifnull(y2, 0) == 0) lst$y2 = y2
if (! is.null(width)) lst$width = width
if (! ifnull(height, 50) == 50) lst$height = height
if (! ifnull(bgColor, 'rgba(0,0,0,0)') == 'rgba(0,0,0,0)')
lst$backgroundColor = getColors(bgColor)
if (! ifnull(borderColor, '#ccc') == '#ccc') lst$borderColor = borderColor
if (! ifnull(borderWidth, 0) == 0) lst$borderWidth = borderWidth
if (! ifnull(controlPosition, 'left') == 'left')
lst$controlPosition = controlPosition
if (ifnull(autoPlay, FALSE)) lst$autoPlay = autoPlay
if (! ifnull(loop, TRUE)) lst$loop = loop
if (! ifnull(playInterval, 2000) == 2000) lst$playInterval = playInterval
if (! identical(ifnull(lineStyle, list(color="#666", width=1, type="dashed")),
list(color="#666", width=1, type="dashed"))){
validLineStyleFeature = c('color', 'width', 'type', 'shadowColor',
'shadowBlur', 'shadowOffsetX', 'shadowOffsetY')
if (! all(names(lineStyle) %in% validLineStyleFeature))
stop(paste("Only supports lineStyle features as below:\n",
validLineStyleFeature))
lst$lineStyle = lineStyle
}
defaultLabel = list(show=TRUE, interval="auto", rotate=0,
formatter=NULL, textStyle=list(color="#333"))
if (! identical(ifnull(label, defaultLabel), defaultLabel)){
validLabelFeature = c('show', 'interval', 'rotate', 'formatter',
'textStyle')
if (! all(names(label) %in% validLabelFeature))
stop(paste("Only supports label features as below:\n",
validLabelFeature))
lst$label = label
}
defaultCheckpoint = list(symbol="auto", symbolSize="auto", color="auto",
borderColor="auto", borderWidth="auto",
label=list(show=FALSE, textStyle=list(color="auto")))
if (! identical(ifnull(checkpointStyle, defaultCheckpoint),
defaultCheckpoint)){
validCheckpointFeature = c('symbol', 'symbolSize', 'color', 'borderColor',
'borderWidth', 'label')
if (! all(names(checkpointStyle) %in% validCheckpointFeature))
stop(paste("Only supports checkpointStyle features as below:\n",
validCheckpointFeature))
lst$checkpointStyle = checkpointStyle
}
defaultControl = list(itemSize=15, itemGap=5, normal=list(color="#333"),
emphasis=list(color="#1e90ff"))
if (! identical(ifnull(controlStyle, defaultControl), defaultControl)){
validControlFeature = c('itemSize', 'itemGap', 'normal', 'emphasis')
if (! all(names(controlStyle) %in% validControlFeature))
stop(paste("Only supports controlStyle features as below:\n",
validControlFeature))
lst$controlStyle = controlStyle
}
if (! ifnull(symbol, "emptyDiamond") == "emptyDiamond")
lst$symbol = symbol
if (! ifnull(symbolSize, 4) == 4) lst$symbolSize = symbolSize
if (! ifnull(currentIndex, 0) == 0) lst$currentIndex = currentIndex
if (! is.null(data)) lst$data = data
chart$x$baseOption$timeline = lst
return(chart %>% tuneGrid())
}
#' Add \code{geoCoord} to An Echarts Object
#'
#' Add \code{geoCoord} object to echarts object. It is used for maps. \cr \cr
#' For maps with a timeline, \code{geoCoord} object is added to \code{options[[1]]$series[[1]]},
#' while for those without a timeline, it is added to \code{series[[1]]}.
#' @param chart chart \code{echarts} object generated by \code{\link{echart}} or
#' \code{\link{echartR}}
#' @param geoCoord Two mode: \cr
#' \describe{
#' \item{list}{A typical geoCoord list should be: \code{list(place1=c(lng1, lat1), ...)}}
#' \item{data.frame}{A data.frame of 3 columns: \code{place}, \code{longitude}, \code{latitude}}
#' }
#' @param mode 'add' or 'overide' \code{geoCoord} to the echarts object. Default 'add'.
#' You can use \code{\link{overideGeoCoord}} to overide existing \code{geoCoord}.
#'
#' @return A modified echarts object
#' @export
#'
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~series-i(map).geoCoord}
#' @examples
#' \dontrun{
#'
#' }
addGeoCoord = function(chart, geoCoord=NULL, mode=c('add', 'overide')){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
mode = match.arg(mode)
if (is.null(geoCoord)) return(chart)
hasT = 'baseOption' %in% names(chart$x)
if (is.data.frame(geoCoord)){
if (ncol(geoCoord) < 3) stop('geoCoord must contain place, lng, lat!')
nameGeoCoord = as.character(geoCoord[,1])
geoCoord = unname(apply(geoCoord, 1, function(row){
as.list(as.numeric(row[2:3]))
}))
names(geoCoord) = nameGeoCoord
lstGeoCoord = geoCoord
if (hasT){
if (chart$x$options[[1]]$series[[1]]$type == 'map')
if (mode == 'add')
if ('geoCoord' %in% names(chart$x$options[[1]]$series[[1]]))
lstGeoCoord = mergeList(
chart$x$options[[1]]$series[[1]]$geoCoord, geoCoord)
chart$x$options[[1]]$series[[1]]$geoCoord = lstGeoCoord
}else{
if (chart$x$series[[1]]$type == 'map')
if (mode == 'add')
if ('geoCoord' %in% names(chart$x$series[[1]]))
lstGeoCoord = mergeList(
chart$x$series[[1]]$geoCoord, geoCoord)
chart$x$series[[1]]$geoCoord = lstGeoCoord
}
}else if (is.list(geoCoord)){
if (is.null(names(geoCoord))) stop('geoCoord list must be named with places!')
if (hasT){
if (chart$x$options[[1]]$series[[1]]$type == 'map')
if (mode == 'add')
if ('geoCoord' %in% names(chart$x$options[[1]]$series[[1]]))
lstGeoCoord = mergeList(
chart$x$options[[1]]$series[[1]]$geoCoord, geoCoord)
chart$x$options[[1]]$series[[1]]$geoCoord = lstGeoCoord
}else{
if (chart$x$series[[1]]$type == 'map')
if (mode == 'add')
if ('geoCoord' %in% names(chart$x$series[[1]]))
lstGeoCoord = mergeList(
chart$x$series[[1]]$geoCoord, geoCoord)
chart$x$series[[1]]$geoCoord = lstGeoCoord
}
}
return(chart)
}
#' @export
#' @rdname addGeoCoord
overideGeoCoord = function(chart, geoCoord=NULL){
return(addGeoCoord(chart, geoCoord, mode='overide'))
}
#' Add \code{heatmap} to Echarts Object
#'
#' Add heatmap object to an Echarts object. (applicable for map)
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}} or
#' \code{\link{echartR}}.
#' @param series Vector. Specify which series you want to insert heatmap. Could be
#' numeric (index of the series) or string (series name). If NULL, then apply to all.
#' Default NULL.
#' @param timeslots Vector. Specify which timeslots (t) you want to insert heatmap.
#' Could be numeric (index of the timeslot) or string (timeslot name).
#' If NULL, then apply to all. Default NULL. You could use \code{t} for short.
#' @param data The heatmap source data. Two modes:
#' \describe{
#' \item{data.frame or matrix}{A data.frame or matrix of 3 columns: lng (-180 ~ 180),
#' lat (-90 ~ 90) and heat value (0-1). If heat value is out of the range [0,1],
#' then it will be normalized.}
#' \item{list}{A list in the form: \code{list(c(<lng1>, <lat1>, <value1>),
#' c(<lng2>, <lat2>, <value2>), ...)}}
#' }
#' @param gradientColors Color palette of heat visualization. Three mode:
#' \describe{
#' \item{vector}{A vector of colors (hex, name, or rgba string)}
#' \item{data.frame or matrix}{A data.frame or matrix of 2 columns: offset (0-1),
#' and color (hex, name or rgba string). }
#' \item{list}{A list in the form: \code{list(list(offset=0.2, color='red'),
#' list(offset=0.5, color='green'), ...)}}
#' } \cr
#' Default c('blue', 'cyan', 'lime', 'yellow', 'orange', 'red').
#' @param blurSize Size of blur. Default 30.
#' @param minAlpha Minimal alpha value which any opacity value below this threshold
#' will be set \code{minAlpha} in order to prevent over-transparency. Default 0.05.
#' @param valueScale Numeric. Scale of value that all the heat value will be multiplied
#' by this value before plotting. Default 1.
#' @param opacity Numeric 0-1. Degree of opacity. Default 1.
#' @param mode 'add' or 'overide' \code{heatmap} to the echarts object. Default 'add'.
#' You can use \code{\link{overideHeatmap}} to overide existing \code{heatmap}.
#' @param ... Elipsis
#'
#' @return A modified echarts object
#' @export
#'
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~series-i(map).heatmap}
#' @examples
#' \dontrun{
#'
#' }
addHeatmap = function(chart, series=NULL, timeslots=NULL, data=NULL,
gradientColors=list(
'blue', 'cyan', 'limegreen', 'yellow', 'orange', 'red'),
blurSize=30, minAlpha=0.05,
valueScale=1, opacity=1, mode=c('add', 'overide'),
...){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
mode = match.arg(mode)
if ('t' %in% names(list(...))) timeslots = list(...)[['t']]
hasT = 'baseOption' %in% names(chart$x)
if (is.null(data)) {
return(chart)
}else{
if (is.data.frame(data) || is.matrix(data)){
if (ncol(data) < 3)
stop('data must be a matrix/data.frame ',
'with the columns lng, lat, heat (0-1) in order!')
if (! all (data.table::between(data[,3], 0, 1)))
data[,3] = (data[,3]-min(data[,3], na.rm=TRUE))/
(max(data[,3], na.rm=TRUE)-min(data[,3], na.rm=TRUE))
if (! all(data.table::between(data[,1], -180, 180)))
stop('data[,1] (lng) must be between -180 and 180')
if (! all(data.table::between(data[,2], -90, 90)))
stop('data[,2] (lat) must be between -90 and 90')
data = asEchartData(unname(data[,1:3]))
}else{
stopifnot(is.list(data))
}
}
# construct lstHeatmap
lstHeatmap = list(
data=unname(data), gradientColors=gradientColors, blurSize=blurSize,
minAlpha=minAlpha, valueScale=valueScale, opacity=opacity)
# define series and t
if (hasT){
if (is.null(timeslots))
timeslots = seq_along(chart$x$options)
else
if (is.numeric(timeslots)){
timeslots = intersect(timeslots, seq_along(chart$x$options))
}else{
timeslots = which(chart$x$baseOption$timeline$data %in% timeslots)
}
}else{
timeslots = NULL
}
mapType = getSeriesPart(chart, 'mapType')
if (length(unique(mapType)) == 1){ # map mode is 'series'
series = 1
}else{ # map mode is 'split'
if (is.null(series)){
series = if (hasT)
seq_len(max(sapply(chart$x$options, function(l) {
length(l$series)}))) else
seq_len(length(chart$x$series))
}else{
if (is.numeric(series)){
series = intersect(series, seq_along(getSeriesPart(
chart, 'category', fetch.all=TRUE)))
}else{
series = which(getSeriesPart(chart, 'category', fetch.all=TRUE) %in%
intersect(getSeriesPart(chart, 'category', fetch.all=TRUE),
series))
}
}
}
# insert lstHeatmap
if (is.null(timeslots)){ # no timeline
for (s in ifnull(series, 1)){ # series is null, mono series
lData = chart$x$series[[s]]$heatmap$data
chart$x$series[[s]]$heatmap = lstHeatmap
if (mode == 'add') if ('heatmap' %in% names(chart$x$series[[s]]))
chart$x$series[[s]]$heatmap$data = append(
lData, chart$x$series[[s]]$heatmap$data)
}
}else{ # with timeline
for (t in timeslots){
for (s in ifnull(series, 1)){ # series is null: mono series
lData = chart$x$options[[t]]$series[[s]]$heatmap$data
chart$x$options[[t]]$series[[s]]$heatmap = lstHeatmap
if (mode == 'add')
if ('heatmap' %in% names(chart$x$options[[t]]$series[[s]]))
chart$x$options[[t]]$series[[s]]$heatmap$data = append(
lData, chart$x$options[[t]]$series[[s]]$heatmap$data)
}
}
}
return(chart)
}
#' @export
#' @rdname addHeatmap
overideHeatmap = function(chart, ...){
return(addHeatmap(chart, mode='overide', ...))
}
#' Add \code{nameMap} to Echarts Object
#'
#' For map charts, you can add \code{nameMap} to translate the place names from one to another.
#' The \code{nameMap} object will be inserted to the first series of the echarts object.
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}} or
#' \code{\link{echartR}}.
#' @param nameMap Two modes: \cr
#' \describe{
#' \item{data.frame/matrix}{A data.frame or matrix comprising of 2 columns: \code{nameToTranslate &
#' nameTranslatedTo}. E.g., You can load a preinstalled Chinese-English geographic
#' dictionary using \code{recharts:::geoNameMap}.}
#' \item{list}{The nameMap in list should follow the structure: \code{list(list(
#' `United States of America`='USA'), list('United Kingdom'='GB'), ...)}}
#' }
#' @param mode 'add' or 'overide' \code{nameMap} to the echarts object. Default 'add'.
#' You can use \code{\link{overideNameMap}} to overide existing \code{nameMap}.
#'
#' @return A modified echarts object
#' @export
#' @seealso \code{data(geoNameMap)}
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#title~series-i(map).nameMap}
#' @examples
#' \dontrun{
#' }
addNameMap = function(chart, nameMap, mode=c('add', 'overide')){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
mode = match.arg(mode)
if (is.data.frame(nameMap) || is.matrix(nameMap)){
stopifnot(ncol(nameMap) > 1)
if (! (is.character(nameMap[,1]) && is.character(nameMap[,2])))
stop('nameMap[,1] and nameMap[,2] must both be characters.')
lstNameMap = asEchartData(nameMap[,2])
names(lstNameMap) = nameMap[,1]
}else if (is.list(nameMap)){
stopifnot(length(unlist(nameMap)) == length(nameMap))
if (is.null(names(nameMap)))
stop('list nameMap must be named with the names you want to translate!')
lstNameMap = nameMap
}
hasT = 'baseOption' %in% names(chart$x)
if(hasT){
if (mode == 'add')
if ('nameMap' %in% names(chart$x$options[[1]]$series[[1]]))
lstNameMap = mergeList(
chart$x$options[[1]]$series[[1]]$nameMap, lstNameMap)
chart$x$options[[1]]$series[[1]]$nameMap = lstNameMap
}else{
if (mode == 'add')
if ('nameMap' %in% names(chart$x$series[[1]]))
lstNameMap = mergeList(
chart$x$series[[1]]$nameMap, lstNameMap)
chart$x$series[[1]]$nameMap = lstNameMap
}
return(chart)
}
#' @export
#' @rdname addNameMap
overideNameMap = function(chart, ...){
return(addNameMap(chart, mode='overide', ...))
}
#' Add \code{markLine} to An Echarts Object
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{\link{echartR}}
#' @param series Numeric (series index) or character (series name), numeric preferred.
#' If set NULL, then apply the \code{markPoint} to all the series.
#' @param timeslots Numeric (timeslot index) or character (timeslot name), numeric is preferred.
#' If set NULL, then apply the \code{markPoint} to all the timeslots. You can use \code{t}
#' for short.
#' @param data Data.frame, the data of the \code{markLine}s. It must contain the
#' following columns: \code{\strong{name1}}, \code{name2, value | type} and/or
#' \code{x1 | xAxis1, y1 | yAxis1, x2 | xAxis2, y2 | yAxis2} and/or \code{series}. \cr \cr
#' When series is given, it must be cooresponding to the \code{series} argument.
#' \describe{
#' \item{generic}{generic form is columns \code{[name1, name2, value, x1, y1, x2, y2]}.
#' The minimum form is \code{[name1, x1, y1, x2, y2]}}
#' \item{scatter, line, bar}{\code{[name1, name2, value, x1, y1, x2, y2]} or
#' \code{[name1, type]} (type can only be 'max', 'min' or 'average') or
#' \code{[name1, name2, value, xAxis1, yAxis1, xAxis2, yAxis2]}}
#' \item{k, eventRiver}{\code{[name1, name2, value, x1, y1, x2, y2]} or
#' \code{[name1, name2, value, xAxis1, yAxis1, xAxis2, yAxis2]}}
#' \item{map}{\code{[name1, name2, value]}. \strong{You need to pass in \code{
#' [name1, lng1, lat1], [name2, lng2, lat2]} using \code{\link{addGeoCoord}}} separately.}
#' }
#' @param clickable Logical, if the graphs are clickable. Default TRUE.
#' @param symbol Symbol vector of the markLines, refer to \code{recharts:::validSymbols}.
#' Default \code{c('circle', 'arrow')}.
#' @param symbolSize Numeric vector or \code{JS} function defining the size of the
#' the beginning symbol and the end symbol of the marklines. Default \code{c(2, 4)}.
#' @param symbolRotate Numeric -180 ~ 180. Default NULL.
#' @param large Logical if large effect is on. Default FALSE.
#' @param effect List. effect configurator of markLines. Default NULL, which is
#' \code{list(show=FALSE, loop=TRUE, period=15, scaleSize=2, color=NULL,
#' shadowColor=NULL, shadowBlur=0)}
#' @param itemStyle List. It is a list with the structure \code{list(normal=list(...),
#' emphasis=list(...))}. Default NULL.
#' @param mode 'add' or 'overide' the data part of \code{markLine} to the echarts
#' object. Default 'add'.
#' You can use \code{\link{overideMarkLine}} to overide the data of the existing
#' \code{markLine}.
#' @param ... Elipsis
#' @export
#'
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#tooltip-line1~series-i(line).markLine}
#' @examples
#' \dontrun{
#' g = echartr(iris, Sepal.Width, Petal.Width, Species)
#' g %>% addML(c('setosa', 'versicolor'), data=data.frame(name1=rep('mean', 2),
#' type=rep('average', 2), series=c('setosa', 'versicolor')))
#' }
#'
addMarkLine = function(
chart, series=NULL, timeslots=NULL, data=NULL, clickable=TRUE,
symbol=c('circle', 'arrow'), symbolSize=c(2,4), symbolRotate=NULL,
large=FALSE, smooth=FALSE, smoothness=0.2, precision=2,
bundling=list(enable=FALSE, maxTurningAngle=45),
effect=list(show=FALSE), itemStyle=NULL, mode=c('add', 'overide'),
...){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
if ('t' %in% names(list(...))) timeslots = list(...)[['t']]
hasT = 'baseOption' %in% names(chart$x)
# data validation
if (is.null(data)) {
return(chart)
}else{
if (is.data.frame(data)){
names(data) = tolower(names(data))
data = data[, intersect(names(data), c(
'name1', 'name2', 'value', 'type', 'x1', 'y1', 'xaxis1', 'yaxis1',
'x2', 'y2', 'xaxis2', 'yaxis2', 'series'))]
if (! 'name1' %in% names(data))
stop('`data` must be a data.frame with the columns: ',
'name1 and/or name2, and/or value|type, and/or x1|xAxis1, ',
'y1|yAxis1, x2|xAxis2, y2|yAxis2 and/or series!')
stopifnot(all(tolower(data$type) %in% c(NA, 'min', 'max', 'average')))
data = data[!is.na(data$name1),]
names(data) = tolower(names(data))
}else{
stop('`data` must be a data.frame.')
}
}
# other params
if (!missing(symbol)) {
intersectSymbols = symbol[tolower(symbol) %in% tolower(validSymbols)]
iSymbol = sapply(intersectSymbols, function(symbol) {
return(which(tolower(validSymbols) == tolower(symbol)))
})
symbol = as.vector(validSymbols[unlist(iSymbol)])
}
# define t
if (hasT){
if (is.null(timeslots))
timeslots = seq_along(chart$x$options)
else
if (is.numeric(timeslots)){
timeslots = intersect(timeslots, seq_along(chart$x$options))
}else{
timeslots = which(chart$x$baseOption$timeline$data %in% timeslots)
}
}else{
timeslots = NULL
}
# define series
lstAnalyzeSeries = analyzeSeries(chart, series)
series = lstAnalyzeSeries$numSeries
lvlseries = lstAnalyzeSeries$strSeries
allSeries = lstAnalyzeSeries$allnumSeries
lvlSeries = lstAnalyzeSeries$allStrSeries
newSeries = lstAnalyzeSeries$strNewSeries
# construct base lstMarkline
lstMark = list(
data=list(), clickable=clickable, symbol=symbol, smooth=smooth,
symbolSize=symbolSize, large=large, effect=effect, smoothness=smoothness,
precision=precision, bundling=bundling)
if (!is.null(symbolRotate)) if (symbolRotate <= 180 && symbolRotate >= -180)
lstMark$symbolRotate = symbolRotate
if (!is.null(itemStyle))
if (is.list(itemStyle)){
lstMark$itemStyle = itemStyle[names(itemStyle) %in% c('normal', 'emphasis')]
if (! all(names(itemStyle) %in% c('normal', 'emphasis')))
warning('itemStyle must be comprised of list(normal) and/or list(emphasis)')
}
.mkMLbyRow = function(row, type){
o = list(list(name=unname(row['name1'])), list())
if (!is.null(row['name2'])) o[[2]]$name = ifna(unname(row['name2']), '')
if (!is.null(row['value'])) o[[1]]$value = ifna(unname(row['value']), '')
if (!is.null(row['x1'])) o[[1]]$x = ifna(as.numeric(row['x1']), '-')
if (!is.null(row['y1'])) o[[1]]$y = ifna(as.numeric(row['y1']), '-')
if (!is.null(row['x2'])) o[[2]]$x = ifna(as.numeric(row['x2']), '-')
if (!is.null(row['y2'])) o[[2]]$y = ifna(as.numeric(row['y2']), '-')
if (type %in% c('scatter', 'line', 'bar', 'k', 'eventRiver')){
if (!is.null(row['xaxis1']))
if (!is.na(row['xaxis1'])){
o[[1]]$xAxis = ifna(as.numeric(row['xaxis1']),
unname(row['xaxis1']))
o[[1]]$x = NULL
}
if (!is.null(row['yaxis1']))
if (!is.na(row['yaxis1'])){
o[[1]]$yAxis = ifna(as.numeric(row['yaxis1']),
unname(row['yaxis1']))
o[[1]]$y = NULL
}
if (!is.null(row['xaxis2']))
if (!is.na(row['xaxis2'])){
o[[2]]$xAxis = ifna(as.numeric(row['xaxis2']),
unname(row['xaxis2']))
o[[2]]$x = NULL
}
if (!is.null(row['yaxis2']))
if (!is.na(row['yaxis2'])){
o[[2]]$yAxis = ifna(as.numeric(row['yaxis2']),
unname(row['yaxis2']))
o[[2]]$y = NULL
}
if (type %in% c('scatter', 'line', 'bar'))
if (!is.null(row['type'])) if (!is.na(row['type'])){
o = list(
name=unname(ifna(row['name1'], ifna(row['name2'], ''))),
type=unname(row['type']))
}
}else if (type %in% c('map')){
o = list(list(name=unname(row['name1'])),
list(name=unname(row['name2'])))
if (!is.na(row['value'])) o[[1]]$value = as.numeric(row['value'])
}else{
}
return(o)
}
# insert lstMarkline
lstML = lstMark
if (is.null(timeslots)){ # no timeline
if (length(series) > 0)
for (s in unlist(series)){ # series is null, mono series
if ('series' %in% names(data)){
dt = data[data$series == lvlseries[which(series==s)],]
}else dt = data
lstML$data = unname(apply(dt, 1, .mkMLbyRow,
type=chart$x$series[[s]]$type))
if ('markLine' %in% names(chart$x$series[[s]]))
lstML$data = append(
chart$x$series[[s]]$markLine$data, lstML$data)
chart$x$series[[s]]$markLine = lstML
}
if (length(newSeries) > 0){
for (ns in seq_along(newSeries)){
chart$x$series = append(chart$x$series, list(list(
name=newSeries[ns], type=chart$x$series[[1]]$type,
data=list(list('-')))))
idxNew = length(chart$x$series)
dt = if ('series' %in% names(data))
data[data$series==newSeries[ns],] else data
lstML$data = unname(apply(dt, 1, .mkMLbyRow,
type=chart$x$series[[ns]]$type))
chart$x$series[[idxNew]]$markLine = lstML
chart$x$legend$data = append(
chart$x$legend$data, newSeries[ns]
)
if (chart$x$series[[1]]$type == 'map')
chart$x$series[[idxNew]]$mapType = chart$x$series[[1]]$mapType
}
}
}else{ # with timeline
for (t in timeslots){
if (length(series) >0)
for (s in series[[t]]){
# series is null, mono series
dt = if ('series' %in% names(data))
data[data$series==allSeries[[t]][which(series==s)],] else data
lstML$data = unname(apply(
dt, 1, .mkMLbyRow,
type=chart$x$options[[t]]$series[[s]]$type))
if ('markLine' %in% names(chart$x$options[[t]]$series[[s]]))
lstML$data = append(
chart$x$options[[t]]$series[[s]]$markLine$data,
lstML$data)
chart$x$options[[t]]$series[[s]]$markLine = lstML
}
if (length(newSeries) > 0){
for (ns in seq_along(newSeries)){
chart$x$options[[t]]$series <-
append(chart$x$options[[t]]$series, list(list(
name=newSeries[ns], data=list(list('-')),
type=chart$x$options[[t]]$series[[1]]$type)))
dt = if ('series' %in% names(data))
data[data$series==newSeries[ns],] else data
lstML$data = unname(apply(
dt, 1, .mkMLbyRow,
type=chart$x$options[[t]]$series[[ns]]$type))
idxNew = length(chart$x$options[[t]]$series)
chart$x$options[[t]]$series[[idxNew]]$markLine = lstML
chart$x$options[[1]]$legend$data = append(
chart$x$options[[1]]$legend$data, newSeries[ns]
)
if (chart$x$options[[t]]$series[[1]]$type == 'map')
chart$x$options[[t]]$series[[idxNew]]$mapType <-
chart$x$options[[t]]$series[[1]]$mapType
}
}
}
}
return(chart)
}
#' @export
#' @rdname addMarkLine
addML = addMarkLine
#' @export
#' @rdname addMarkLine
addMarkline = addMarkLine
#' @export
#' @rdname addMarkLine
overideMarkLine = function(chart, ...){
return(addMarkLine(chart, mode='overide', ...))
}
#' @export
#' @rdname addMarkLine
overideMarkline = overideMarkLine
#' @export
#' @rdname addMarkLine
overideML <-overideMarkLine
#' Add \code{markPoint} to An Echarts Object
#'
#' @param chart \code{echarts} object generated by \code{\link{echart}} or \code{\link{echartR}}
#' @param series Numeric (series index) or character (series name), numeric preferred.
#' If set NULL, then apply the \code{markPoint} to all the series.
#' @param timeslots Numeric (timeslot index) or character (timeslot name), numeric preferred.
#' If set NULL, then apply the \code{markPoint} to all the timeslots. You can use \code{t}
#' for short.
#' @param data Data.frame, the data of the \code{markPoint}s. It must contain the
#' following columns: \code{\strong{name}}, and/or \code{value | type} and/or
#' \code{x | xAxis, y | yAxis} and/or \code{series}. \cr \cr
#' When series is given, it must be corresponding to the \code{series} argument.
#' \describe{
#' \item{generic}{generic form is columns \code{[name, x, y]} or \code{[name, value,
#' x, y]}}
#' \item{scatter, line, bar}{\code{[name, value, x, y]} or \code{[name, type]}
#' (type can only be 'max' or 'min') or \code{[name, value, xAxis, yAxis]}}
#' \item{k, eventRiver}{\code{[name, value, x, y]} or \code{[name, value, xAxis, yAxis]}}
#' \item{map}{\code{[name, value]}. \strong{You need to pass in \code{[name, lng, lat]}
#' using \code{\link{addGeoCoord}}} separately.}
#' }
#' Note that markLine dataset is compatible with \code{addMarkPoint}.
#' \itemize{
#' \item \code{x1, x2} are treated as \code{x} (keep the first detected one only)
#' \item \code{y1, y2} are treated as \code{y} (keep the first detected one only)
#' \item \code{xAxis1, xAxis2} are treated as \code{xAxis} (keep the first detected
#' one only)
#' \item \code{yAxis1, yAxis2} are treated as \code{yAxis} (keep the first detected
#' one only
#' }
#' @param clickable Logical, if the points are clickable. Default TRUE.
#' @param symbol Symbol of the markpoints, refer to \code{recharts:::validSymbols}.
#' Default 'pin'.
#' @param symbolSize Numeric or vector \code{c(height, width)} or JS function. Default 10.
#' @param symbolRotate Numeric -180 ~ 180. Default NULL.
#' @param large Logical if large effect is on. Default FALSE.
#' @param effect List. effect configurator of markPoints. Default NULL, which is
#' \code{list(show=FALSE, type='scale', loop=TRUE, period=15, scaleSize=2,
#' bounceDistance=10, color=NULL, shadowColor=NULL, shadowBlur=0)}
#' @param itemStyle List. It is a list with the structure \code{list(normal=list(...),
#' emphasis=list(...))}. Default NULL.
#' @param mode 'add' or 'overide' the data part of \code{markPoint} to the echarts
#' object. Default 'add'.
#' You can use \code{\link{overideMarkPoint}} to overide the data of the existing
#' \code{markPoint}.
#' @param ... Elipsis
#'
#' @export
#' @references \url{http://echarts.baidu.com/echarts2/doc/option.html#tooltip-line1~series-i(line).markPoint}
#' @seealso \code{\link{addMarkLine}} \code{\link{addMarkline}}
#' @examples
#' \dontrun{
#' g = echartr(iris, Sepal.Width, Petal.Width, Species)
#' g %>% addMP(c('setosa', 'versicolor'), data=data.frame(name=c('max', 'min'),
#' type=c('max', 'min'), series=c('setosa', 'versicolor')))
#' }
#'
addMarkPoint = function(
chart, series=NULL, timeslots=NULL, data=NULL, clickable=TRUE, symbol='pin',
symbolSize=10, symbolRotate=NULL, large=FALSE, effect=list(show=FALSE),
itemStyle=NULL, ...){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
if ('t' %in% names(list(...))) timeslots = list(...)[['t']]
hasT = 'baseOption' %in% names(chart$x)
# data validation
if (is.null(data)) {
return(chart)
}else{
if (is.data.frame(data)){
names(data) = tolower(names(data))
if (! 'name' %in% names(data))
names(data) = sub('name\\d*', 'name', names(data))
if (! 'x' %in% names(data))
names(data) = sub('x\\d*', 'x', names(data))
if (! 'y' %in% names(data))
names(data) = sub('y\\d*', 'y', names(data))
if (! 'xaxis' %in% names(data))
names(data) = sub('xaxis\\d*', 'xaxis', names(data))
if (! 'yaxis' %in% names(data))
names(data) = sub('yaxis\\d*', 'yaxis', names(data))
data = data[, intersect(names(data), c(
'name', 'value', 'type', 'x', 'y', 'xaxis', 'yaxis', 'series'))]
if (! 'name' %in% names(data))
stop('`data` must be a data.frame with the columns: ',
'name, and/or value|type, and/or x|xAxis, y|yAxis and/or series!')
stopifnot(all(tolower(data$type) %in% c(NA, 'min', 'max')))
data = data[!is.na(data$name),]
names(data) = tolower(names(data))
}else{
stop('`data` must be a data.frame.')
}
}
# other params
if (!missing(symbol)) {
intersectSymbols = symbol[tolower(symbol) %in% tolower(validSymbols)]
iSymbol = sapply(intersectSymbols, function(symbol) {
return(which(tolower(validSymbols) == tolower(symbol)))
})
symbol = as.vector(validSymbols[unlist(iSymbol)])
}
# define t
if (hasT){
if (is.null(timeslots))
timeslots = seq_along(chart$x$options)
else
if (is.numeric(timeslots)){
timeslots = intersect(timeslots, seq_along(chart$x$options))
}else{
timeslots = which(chart$x$baseOption$timeline$data %in% timeslots)
}
}else{
timeslots = NULL
}
# define series
lstAnalyzeSeries = analyzeSeries(chart, series)
series = lstAnalyzeSeries$numSeries
lvlseries = lstAnalyzeSeries$strSeries
allSeries = lstAnalyzeSeries$allnumSeries
lvlSeries = lstAnalyzeSeries$allStrSeries
newSeries = lstAnalyzeSeries$strNewSeries
# construct base lstMarkpoint
lstMark = list(
data=list(), clickable=clickable, symbol=symbol,
symbolSize=symbolSize, large=large, effect=effect)
if (!is.null(symbolRotate)) if (symbolRotate <= 180 && symbolRotate >= -180)
lstMark$symbolRotate = symbolRotate
if (!is.null(itemStyle))
if (is.list(itemStyle)){
lstMark$itemStyle = itemStyle[names(itemStyle) %in% c('normal', 'emphasis')]
if (!all(names(itemStyle) %in% c('normal', 'emphasis')))
warning('itemStyle must be comprised of list(normal) and/or list(emphasis)')
}
.mkMPbyRow = function(row, type){
o = list()
if (type %in% c('scatter', 'line', 'bar', 'k', 'eventRiver')){
if (type %in% c('scatter', 'line', 'bar')){
if (!is.na(row['type'])) o = as.list(row[c('name', 'type')])
}
if (!is.null(row['xaxis'])){
if (!is.na(row['xaxis']))
o$xAxis = ifna(as.numeric(row['xaxis']), unname(row['xaxis']))
}else if (!is.null(row['x'])){
if (!is.na(row['x'])) o$x = ifna(as.numeric(row['x']), unname(row['x']))
}
if (!is.null(row['yaxis'])){
if (!is.na(row['yaxis']))
o$yAxis = ifna(as.numeric(row['yaxis']), unname(row['yaxis']))
}else if (!is.null(row['y'])){
if (!is.na(row['y'])) o$y = ifna(as.numeric(row['y']), unname(row['y']))
}
}else if (type %in% c('map')){
o = as.list(row[c('name', 'value')])
o$value = ifna(as.numeric(o$value), '-')
}else{
o = list(name=unname(row['name']),
value=ifna(as.numeric(row['value']), '-'),
x=ifna(as.numeric(row['x']), '-'),
y=ifna(as.numeric(row['y']), '-'))
}
return(o)
}
# insert lstMarkpoint
lstMP = lstMark
if (is.null(timeslots)){ # no timeline
if (length(series) >0)
for (s in unlist(series)){ # series is null, mono series
if ('series' %in% names(data)){
dt = data[data$series == lvlseries[which(series==s)],]
}else dt = data
lstMP$data = unname(apply(dt, 1, .mkMPbyRow,
type=chart$x$series[[s]]$type))
if ('markPoint' %in% names(chart$x$series[[s]]))
lstMP$data = append(
chart$x$series[[s]]$markPoint$data, lstMP$data)
chart$x$series[[s]]$markPoint = lstMP
}
if (length(newSeries) > 0){
for (ns in seq_along(newSeries)){
chart$x$series = append(chart$x$series, list(list(
name=newSeries[ns], type=chart$x$series[[1]]$type,
data=list(list('-')))))
dt = if ('series' %in% names(data))
data[data$series==newSeries[ns],] else data
lstMP$data = unname(apply(dt, 1, .mkMPbyRow,
type=chart$x$series[[ns]]$type))
idxNew = length(chart$x$series)
chart$x$series[[idxNew]]$markPoint = lstMP
chart$x$legend$data = append(
chart$x$legend$data, newSeries[ns])
if (chart$x$series[[1]]$type == 'map')
chart$x$series[[idxNew]]$mapType = chart$x$series[[1]]$mapType
}
}
}else{ # with timeline
for (t in timeslots){
if (length(series) >0)
for (s in series[[t]]){ # series is null, mono series
dt = if ('series' %in% names(data))
data[data$series==allSeries[[t]][which(series==s)],] else data
lstMP$data = unname(apply(
dt, 1, .mkMPbyRow,
type=chart$x$options[[t]]$series[[s]]$type))
if ('markPoint' %in% names(chart$x$options[[t]]$series[[s]]))
lstMP$data = append(
chart$x$options[[t]]$series[[s]]$markPoint$data,
lstMP$data)
chart$x$options[[t]]$series[[s]]$markPoint<- lstMP
}
if (length(newSeries) > 0){
for (ns in seq_along(newSeries)){
chart$x$options[[t]]$series = append(
chart$x$options[[t]]$series, list(list(
name=newSeries[ns], data=list(list('-')),
type=chart$x$options[[t]]$series[[1]]$type)))
dt = if ('series' %in% names(data))
data[data$series==newSeries[ns],] else data
lstMP$data = unname(apply(
dt, 1, .mkMPbyRow,
type=chart$x$options[[t]]$series[[ns]]$type))
idxNew = length(chart$x$options[[t]]$series)
chart$x$options[[t]]$series[[idxNew]]$markPoint = lstMP
chart$x$options[[1]]$legend$data = append(
chart$x$options[[1]]$legend$data, newSeries[ns]
)
if (chart$x$options[[t]]$series[[1]]$type == 'map')
chart$x$options[[t]]$series[[idxNew]]$mapType <-
chart$x$options[[t]]$series[[1]]$mapType
}
}
}
}
return(chart)
}
#' @export
#' @rdname addMarkPoint
addMP = addMarkPoint
#' @export
#' @rdname addMarkPoint
addMarkpoint = addMarkPoint
#' @export
#' @rdname addMarkPoint
overideMarkPoint = function(chart, ...){
return(addMarkPoint(chart, mode='overide', ...))
}
#' @export
#' @rdname addMarkPoint
overideMarkpoint = overideMarkPoint
#' @export
#' @rdname addMarkPoint
overideMP = overideMarkPoint
#' Set `series` Element by Element
#'
#' The basic framework of making Echarts object is Step 1 \code{echart} => Step 2
#' \code{set[Widgets]} => Step 3 \code{set[Aesthetics]}. Step 1 makes the structure
#' of the Echarts object, step 2 creates/modifies its widgets, and step 3 modifies
#' the params of the widgets. But what if you want to modify the details inside
#' \code{series} list? -- You may want \code{setSeries}.\cr \cr
#' \code{setSeries} is a bit low-level, compared to other \code{set[Widgets]} functions.
#' It directly pass the param list on to an Echarts object and may lead to unexpected
#' results. So you are suggested to get more familiar with Echarts structure before
#' you decide to \code{setSeries}.
#'
#' @param chart chart \code{echarts} object generated by \code{\link{echart}} or
#' \code{\link{echartR}}
#' @param timeslots vector of timeslots, either name or index of timeline variable
#' \code{t}.
#' @param series series, could be the name or the index of the series. When the string
#' is not in the existing series list, it will be treated as new
#' @param ... The params to pass to the echarts object for modification. \cr
#' The generic params include:
#' \tabular{ll}{
#' \code{type} \tab chart type. 'line', 'bar', 'scatter', 'k', 'pie', 'radar',
#' 'chord', 'force', 'map'... If NULL, the series will not display. \cr
#' \code{name} \tab name of the series. \cr
#' \code{tooltip} \tab \code{\link{setTooltip}} \cr
#' \code{data} \tab the \code{data} part of \code{\link{echartR}} \cr
#' \code{itemStyle} \tab \code{\link{itemStyle}} \cr
#' \code{markPoint} \tab \code{\link{addMarkPoint}} \cr
#' \code{markLine} \tab \code{\link{addMarkLine}} \cr
#' \code{clickable} \tab whether the data graph is clickable, default TRUE. \cr
#' \code{z} \tab level-2 layer control, default 2. \cr
#' \code{zlevel} \tab level-1 layer control, default 0.
#' } \cr
#' The type-specific params include:
#' \describe{
#' \item{line}{
#' \tabular{ll}{
#' \code{stack} \tab TRUE|FALSE \cr
#' \code{xAxisIndex} \tab 0|1, default 0 (main axis) \cr
#' \code{yAxisIndex} \tab 0|1, default 0 (main axis) \cr
#' \code{symbol} \tab \code{\link{setSymbols}} \cr
#' \code{symbolSize} \tab numeric or \code{\link{JS}} function \cr
#' \code{symbolRotate} \tab -180 ~ 180 \cr
#' \code{showAllSymbol} \tab TRUE|FALSE, default FALSE\cr
#' \code{smooth} \tab TRUE|FALSE, default FALSE \cr
#' \code{dataFilter} \tab only for line charts. 'nearest'|'min'|'max'|'average', default 'nearest'. \cr
#' \code{legendHoverLink} \tab TRUE|FALSE, default TRUE.
#' }}
#' \item{bar}{
#' \tabular{ll}{
#' \code{stack} \tab TRUE|FALSE \cr
#' \code{xAxisIndex} \tab 0|1, default 0 (main axis) \cr
#' \code{yAxisIndex} \tab 0|1, default 0 (main axis) \cr
#' \code{barGap} \tab percent or numeric, default '30\%'. \cr
#' \code{barCategoryGap} \tab percent or numeric, default '20\%'. \cr
#' \code{barMinHeight} \tab numeric, default 0. \cr
#' \code{barWidth} \tab numeric, default automatic. \cr
#' \code{barMaxWidth} \tab numeric, default automatic. \cr
#' \code{legendHoverLink} \tab TRUE|FALSE, default TRUE.
#' }}
#' \item{scatter}{
#' \tabular{ll}{
#' \code{xAxisIndex} \tab 0|1, default 0 (main axis) \cr
#' \code{yAxisIndex} \tab 0|1, default 0 (main axis) \cr
#' \code{symbol} \tab \code{\link{setSymbols}} \cr
#' \code{symbolSize} \tab numeric or \code{\link{JS}} function \cr
#' \code{symbolRotate} \tab -180 ~ 180 \cr
#' \code{large} \tab TRUE|FALSE, default FALSE. \cr
#' \code{largeThreshold} \tab numeric, default 2000. \cr
#' \code{legendHoverLink} \tab TRUE|FALSE, default TRUE.
#' }}
#' \item{pie}{
#' \tabular{ll}{
#' \code{legendHoverLink} \tab TRUE|FALSE, default TRUE. \cr
#' \code{center} \tab percent or numeric, default c('50\%', '50\%') \cr
#' \code{radius} \tab percent or numeric, default c(0, '75\%') \cr
#' \code{startAngle} \tab numeric -360 ~ 360, default 90 for pie, 225 for gauge. \cr
#' \code{minAngle} \tab numeric, default 0. \cr
#' \code{clockWise} \tab TRUE|FALSE, default TRUE. \cr
#' \code{roseType} \tab 'radius'|'area'. \cr
#' \code{selectedOffset} \tab numeric, default 10. \cr
#' \code{selectedMode} \tab NULL|'single'|'multiple', default NULL.
#' }}
#' \item{radar}{
#' \tabular{ll}{
#' \code{symbol} \tab \code{\link{setSymbols}} \cr
#' \code{symbolSize} \tab numeric or \code{\link{JS}} function \cr
#' \code{symbolRotate} \tab -180 ~ 180 \cr
#' \code{legendHoverLink} \tab TRUE|FALSE, default TRUE. \cr
#' \code{polarIndex} \tab numeric. Index of the polar system to host the series.
#' }}
#' \item{chord}{
#' \tabular{ll}{
#' \code{symbol} \tab \code{\link{setSymbols}} \cr
#' \code{symbolSize} \tab numeric or \code{\link{JS}} function \cr
#' \code{clockWise} \tab TRUE|FASLE, default FALSE. \cr
#' \code{categories} \tab character vector \cr
#' \code{links} \tab list of links \cr
#' \code{matrix} \tab matrix data \cr
#' \code{minRadius} \tab numeric, default 10. \cr
#' \code{maxRadius} \tab numeric, default 20. \cr
#' \code{ribbonType} \tab TRUE|FALSE, default TRUE. \cr
#' \code{showScale} \tab TRUE|FALSE, default FALSE. \cr
#' \code{showScaleText} \tab TRUE|FALSE, default FALSE \cr
#' \code{padding} \tab numeric, default 2. \cr
#' \code{sort} \tab 'none'|'ascending'|'descending', default 'none'. \cr
#' \code{sortSub} \tab 'none'|'ascending'|'descending', default 'none'. \cr
#' \code{nodes} \tab nodes list
#' }}
#' \item{force}{
#' \tabular{ll}{
#' \code{symbol} \tab \code{\link{setSymbols}} \cr
#' \code{symbolSize} \tab numeric or \code{\link{JS}} function. \cr
#' \code{large} \tab TRUE|FALSE, default FALSE. \cr
#' \code{center} \tab percent or numeric, default c('50\%', '50\%'). \cr
#' \code{roam} \tab TRUE|FALSE|'scale'|'move', default FALSE. \cr
#' \code{categories} \tab character vector \cr
#' \code{links} \tab links list \cr
#' \code{matrix} \tab data matrix \cr
#' \code{size} \tab percent or numeric, default '100\%' \cr
#' \code{minRadius} \tab numeric, default 10. \cr
#' \code{maxRadius} \tab numeric, default 20. \cr
#' \code{linkSymbol} \tab vector of symbol characters, default c('none', 'arrow') \cr
#' \code{linkSymbolSize} \tab numeric verctor, default c(10, 15) \cr
#' \code{scaling} \tab numeric, default 1 \cr
#' \code{gravity} \tab numeric, default 1 \cr
#' \code{draggable} \tab TRUE|FALSE, default TRUE \cr
#' \code{useWorker} \tab TRUE|FALSE, default FALSE \cr
#' \code{steps} \tab numeric, default 1 \cr
#' \code{nodes} \tab nodes list
#' }}
#' \item{map}{
#' \tabular{ll}{
#' \code{selectedMode} \tab NULL|'single'|'multiple', default NULL \cr
#' \code{mapType} \tab 'china'|'world', default 'china' \cr
#' \code{hoverable} \tab TRUE|FALSE, default TRUE \cr
#' \code{dataRangeHoverLink} \tab TRUE|FALSE, default TRUE \cr
#' \code{mapLocation} \tab list{x=.., y=.., width=.., height=..}, default
#' list(x='center', y='center') \cr
#' \code{mapValueCalculation} \tab 'sum'|'average', default 'sum' \cr
#' \code{mapValuePrecision} \tab integer, default 0 \cr
#' \code{showLegendSymbol} \tab TRUE|FALSE, default TRUE \cr
#' \code{roam} \tab TRUE|FALSE|'scale'|'move', default FALSE \cr
#' \code{scaleLimit} \tab numeric list(max=.., min=..), default NULL \cr
#' \code{nameMap} \tab \code{\link{addNameMap}} \cr
#' \code{textFixed} \tab list, e.g., list(China=c(10, -10)), default NULL \cr
#' \code{geoCoord} \tab \code{\link{addGeoCoord}} \cr
#' \code{heatmap} \tab \code{\link{addHeatMap}}
#' }}
#' \item{gauge}{
#' \tabular{ll}{
#' \code{legendHoverLink} \tab TRUE|FALSE, default TRUE. \cr
#' \code{center} \tab percent or numeric vector, default c('50\%', '50\%') \cr
#' \code{radius} \tab percent or numeric vector, default c(0, '75\%') \cr
#' \code{startAngle} \tab numeric -360 ~ 360, default 225 \cr
#' \code{endAngle} \tab numeric -360 ~ 360, default -45 \cr
#' \code{min} \tab numeric, default 0 \cr
#' \code{max} \tab numeric, default 100 \cr
#' \code{splitNumber} \tab numeric, default 10 \cr
#' \code{axisLine} \tab list, default \code{list(
#' show=TRUE, lineStyle=list(
#' color=list(list(0.2, '#228b22'), list(0.8, '#48b'), list(1, '#ff4500')),
#' width=30))} \cr
#' \code{axisTick} \tab list, default \code{list(
#' show=TRUE, splitNumber=5, length=8, lineStyle=list(
#' color='#eee', width=1, type='solid'))} \cr
#' \code{axisLabel} \tab list, default \code{list(show=TRUE, formatter=NULL,
#' textStyle=list(color='auto'))} \cr
#' \code{splitLine} \tab list, default \code{list(show=TRUE,
#' length=30, lineStyle=list(
#' color='#eee', width=2, type='solid'))} \cr
#' \code{pointer} \tab list, default \code{list(length='80\%', width=8,
#' color='auto')} \cr
#' \code{title} \tab list, default \code{list(show=TRUE, offsetCenter=list(0, '40\%'),
#' textStyle=list(color='#333', fontSize=15))} \cr
#' \code{detail} \tab list, default \code{list(show=TRUE, backgroundColor='rgba(0,0,0,0)',
#' borderWidth=0, borderColor='#ccc', width=100, height=40, offsetCenter=list(0, '40\%'),
#' formatter=NULL, textStyle=list(color='auto', fontSize=30))}
#' }}
#' \item{funnel}{
#' \tabular{ll}{
#' \code{legendHoverLink} \tab TRUE|FALSE, default TRUE. \cr
#' \code{sort} \tab 'ascending'|'descending', default 'descending' \cr
#' \code{min} \tab numeric, default 0 \cr
#' \code{max} \tab numeric, default 100 \cr
#' \code{x} \tab numeric, default 80 \cr
#' \code{y} \tab numeric, default 60 \cr
#' \code{x2} \tab numeric, default 80 \cr
#' \code{y2} \tab numeric, default 60 \cr
#' \code{width} \tab percent or numeric, default NULL \cr
#' \code{height} \tab percent or numeric, default NULL \cr
#' \code{funnelAlign} \tab 'left'|'right'|'center', default 'center' \cr
#' \code{minSize} \tab percent, default '0\%' \cr
#' \code{maxSize} \tab percent, default '100\%' \cr
#' \code{gap} \tab numeric, default 0
#' }}
#' \item{eventRiver}{
#' \tabular{ll}{
#' \code{xAxisIndex} \tab 0|1, default 0 (main axis) \cr
#' \code{legendHoverLink} \tab TRUE|FALSE, default TRUE. \cr
#' \code{weight} \tab numeric, default 1
#' }}
#' \item{treemap}{
#' \tabular{ll}{
#' \code{center} \tab percent or numeric vector, default c('50\%', '50\%') \cr
#' \code{size} \tab percent or numeric vector, default c('80\%', '80\%') \cr
#' \code{root} \tab name of the root displayed currently
#' }}
#' \item{tree}{
#' \tabular{ll}{
#' \code{symbol} \tab \code{\link{setSymbols}} \cr
#' \code{symbolSize} \tab numeric or \code{\link{JS}} function. \cr
#' \code{roam} \tab TRUE|FALSE|'scale'|'move', default FALSE \cr
#' \code{rootLocation} \tab list, could be list(x='center' | 'left' | 'right' | 'x\%' | {number},
#' y='center' | 'top' | 'bottom' | 'y\%' | {number}) \cr
#' \code{layerPadding} \tab numeric, default 100 \cr
#' \code{nodePadding} \tab numeric, default 30 \cr
#' \code{orient} \tab 'vertical' | 'horizontal' | 'radial', default 'vertical' \cr
#' \code{direction} \tab "" or "inverse", default ""
#' }}
#' \item{wordCloud}{
#' \tabular{ll}{
#' \code{center} \tab percent or numeric vector, default c('50\%', '50\%') \cr
#' \code{size} \tab percent or numeric vector, default c('80\%', '80\%') \cr
#' \code{textRotation} \tab vector, -90 ~ 90, default c(0, 90) \cr
#' \code{autoSize} \tab list, default \code{list(enable=TRUE, minSize=12)}
#' }}
#' \item{heatmap}{
#' \tabular{ll}{
#' \code{blurSize} \tab numeric, default 30 \cr
#' \code{gradientColors} \tab \code{list(offset=.., color=..)} or color vector.
#' default \code{list('blue', 'cyan', 'limegreen', 'yellow', 'red')} \cr
#' \code{minAlpha} \tab numeric, default 0.05 \cr
#' \code{valueScale} \tab numeric, default 1 \cr
#' \code{opacity} \tab numeric, default 1
#' }}
#' }
#' @references
#' \url{http://echarts.baidu.com/echarts2/doc/option.html#title~series-i}
#' @return A modified echarts object
#' @export
#'
#' @examples
#' \dontrun{
#' g = echartr(iris, Sepal.Width, Petal.Width, Species)
#' g %>% setSeries(series=3, symbol='emptyCircle')
#' }
setSeries = function(chart, series=NULL, timeslots=NULL, ...){
if (!inherits(chart, 'echarts'))
stop('chart is not an Echarts object. ',
'Check if you have missed a %>% in your pipe chain.')
validTypes = c(
'line', 'bar', 'scatter', 'pie', 'radar', 'chord','force', 'map', 'gauge',
'funnel', 'eventRiver', 'treemap', 'tree', 'wordCloud', 'heatmap')
hasT = 'baseOption' %in% names(chart$x)
lst = list(...)
# define t
if (hasT){
if (is.null(timeslots))
timeslots = seq_along(chart$x$options)
else
if (is.numeric(timeslots)){
timeslots = intersect(timeslots, seq_along(chart$x$options))
}else{
timeslots = which(chart$x$baseOption$timeline$data %in% timeslots)
}
}else{
timeslots = NULL
}
# define series
lstAnalyzeSeries = analyzeSeries(chart, series)
series = lstAnalyzeSeries$numSeries
lvlseries = lstAnalyzeSeries$strSeries
allSeries = lstAnalyzeSeries$allnumSeries
lvlSeries = lstAnalyzeSeries$allStrSeries
newSeries = lstAnalyzeSeries$strNewSeries
# mergeList
if (is.null(timeslots)){ # no timeline
if (length(series) >0)
for (s in unlist(series)){ # series is null, mono series
if (! 'type' %in% names(lst))
type = chart$x$series[[s]]$type
else
type = match.arg(lst$type, validTypes)
chart$x$series[[s]] = mergeList(
chart$x$series[[s]], filterSeriesParts(lst, type)
)
}
if (length(newSeries) > 0){
for (ns in seq_along(newSeries)){
if ('type' %in% names(lst)){
type = match.arg(lst$type, validTypes)
chart$x$series = append(chart$x$series, list(
filterSeriesParts(lst, type)
))
}
}
}
}else{ # with timeline
for (t in timeslots){
if (length(series) >0)
for (s in series[[t]]){ # series is null, mono series
if (! 'type' %in% names(lst))
type = chart$x$options[[t]]$series[[s]]$type
else
type = match.arg(lst$type, validTypes)
chart$x$options[[t]]$series[[s]] = mergeList(
chart$x$options[[t]]$series[[s]],
filterSeriesParts(lst, type)
)
}
if (length(newSeries) > 0){
for (ns in seq_along(newSeries)){
if ('type' %in% names(lst)){
type = match.arg(lst$type, validTypes)
chart$x$options[[t]]$series = append(
chart$x$options[[t]]$series, list(
filterSeriesParts(lst, type)
))
}
}
}
}
}
return(chart)
}
#' Define Aesthetic Elements of Echarts Object
#'
#' An Echarts object uses \code{itemStyle} heavily. You can use \code{itemStyle}
#' to compose an itemStyle list. \cr \cr
#' Contained in an itemStyle object are \cr
#' \describe{
#' \item{atomic features}{'color', 'borderColor', 'borderWidth', 'barBorderColor',
#' 'barBorderRadius', 'barBorderWidth', which you can directly assign values}
#' \item{object features}{'lineStyle', 'textStyle','areaStyle', 'chordStyle',
#' 'nodeStyle', 'linkStyle', which you can yield by \code{aesStyle} function family}
#' \item{mixed object features}{'label' and 'labelLine', which contains other
#' object features, such as 'lineStyle', 'textStyle'}
#' } \cr
#' You can use \code{aesStyle} function family (\code{
#' lineStyle, textStyle, areaStyle, aesChordSytle, labelStyle, labelLineStyle})
#' to compose basic feature objects, and then group them into label or labelLine
#' using \code{labelStyle / labelLineStyle}, and finally pack them into an itemStyle
#' object using \code{itemStyle}.
#'
#' @param element String, could be 'text', 'line', 'area', 'chord', 'node', or 'link',
#' corresponding to \code{textStyle, lineStyle, areaStyle, chordStyle, nodeStyle,
#' linkStyle}
#' @param ... The params to form an aesthetic element \cr
#' The element-specific params list:
#' \describe{
#' \item{\strong{itemStyle} (normal|emphasis)}{
#' \tabular{ll}{
#' \code{color} \tab color vector, 'rgba', hex color, or color names. \cr
#' \code{lineStyle} \tab for line, k charts and markLine, \code{\link{lineStyle}} \cr
#' \code{textStyle} \tab \code{\link{textStyle}} \cr
#' \code{areaStyle} \tab for stacked line chart and map, \code{\link{areaStyle}} \cr
#' \code{chordStyle} \tab for chord chart, \code{\link{chordStyle}} \cr
#' \code{nodeStyle} \tab for force chart, \code{\link{nodeStyle}} \cr
#' \code{linkStyle} \tab for force chart, \code{\link{linkStyle}} \cr
#' \code{borderColor} \tab color vector, 'rgba', hex color, or color names. \cr
#' \code{borderWidth} \tab for symbol, symbole, pie chart, map and markPoint, numeric \cr
#' \code{barBorderColor} \tab for symbol, symbole, pie chart, map and markPoint, numeric \cr
#' \code{barBorderRadius} \tab numeric vector length 1 or 4 (right-bottom-left-top), default 0 \cr
#' \code{barBorderWidth} \tab numeric vector length 1 or 4 (right-bottom-left-top), default 00 \cr
#' \code{label} \tab for line, bar, k, scatter, pie, map, force, funnel charts
#' and markPoint, markLine, \code{\link{labelStyle}} \cr
#' \code{labelLine} \tab for pie and funnel chart, \code{\link{labelLineStyle}}
#' }}
#' \item{\emph{label}}{
#' \tabular{ll}{
#' \code{show} \tab TRUE|FALSE, default TRUE \cr
#' \code{position} \tab \itemize{
#' \item for pie, 'outer'|'inner'; \cr
#' \item for funnel, 'inner'|'left'|'right'; \cr
#' \item for line, bar, k, scatter, 'top'|'right'|'inside'|'left'|'bottom'; \cr
#' \item for bar, additionally 'insideLeft' | 'insideRight' | 'insideTop' | 'insideBottom'} \cr
#' \code{rotate} \tab chord chart only. TRUE|FALSE, default FALSE \cr
#' \code{distance} \tab chord and pie chart only. numeric, default 10 \cr
#' \code{formatter} \tab \code{\link{setTooltip}} \cr
#' \code{textStyle} \tab \code{\link{textStyle}} \cr
#' \code{x} \tab treemap only, numeric \cr
#' \code{y} \tab treemap only, numeric
#' }}
#' \item{\emph{labelLine}}{
#' \tabular{ll}{
#' \code{show} \tab TRUE|FALSE, default TRUE \cr
#' \code{length} \tab numeric or 'auto', default 40 \cr
#' \code{lineStyle} \tab \code{\link{lineStyle}}
#' }}
#' \item{textStyle}{
#' \tabular{ll}{
#' \code{color} \tab color vector, 'rgba', hex color, or color names. \cr
#' \code{decoration} \tab only for tooltip. string, default 'none' \cr
#' \code{align} \tab 'left' | 'right' | 'center' \cr
#' \code{baseline} \tab 'top' | 'bottom' | 'middle' \cr
#' \code{fontFamily} \tab valid font family name \cr
#' \code{fontSize} \tab numeric, default 12 \cr
#' \code{fontStyle} \tab 'normal' | 'italic' | 'oblique', default 'normal' \cr
#' \code{fontWeight} \tab 'normal' | 'bold' | 'bolder' | 'lighter' or numeric,
#' default 'normal'
#' }}
#' \item{lineStyle}{
#' \tabular{ll}{
#' \code{color} \tab color vector, 'rgba', hex color, or color names. \cr
#' \code{type} \tab 'solid' | 'dotted' | 'dashed', for tree, additionally
#' 'curve' | 'broken'. Default 'solid' \cr
#' \code{width} \tab numeric \cr
#' \code{shadowColor} \tab color vector, 'rgba', hex color, or color names. \cr
#' \code{shadowBlur} \tab numeric, default 5 \cr
#' \code{shadowOffsetX} \tab numeric, default 3 \cr
#' \code{shadowOffsetY} \tab numeric, default 3
#' }}
#' \item{areaStyle}{
#' \tabular{ll}{
#' \code{color} \tab color vector, 'rgba', hex color, or color names. \cr
#' \code{type} \tab only 'default'
#' }}
#' \item{chordStyle}{
#' \tabular{ll}{
#' \code{width} \tab numeric, default 1 \cr
#' \code{color} \tab color vector, 'rgba', hex color, or color names. \cr
#' \code{borderWidth} \tab numeric, default 1 \cr
#' \code{borderColor} \tab color vector, 'rgba', hex color, or color names.
#' }}
#' \item{nodeStyle}{
#' \tabular{ll}{
#' \code{color} \tab color vector, 'rgba', hex color, or color names. \cr
#' \code{borderWidth} \tab numeric, default 1 \cr
#' \code{borderColor} \tab color vector, 'rgba', hex color, or color names.
#' }}
#' \item{linkStyle}{
#' \tabular{ll}{
#' \code{type} \tab 'curve'|'line' \cr
#' \code{color} \tab color vector, 'rgba', hex color, or color names. default '#5182ab' \cr
#' \code{width} \tab numeric, default 1
#' }}
#' }
#'
#' @return A list
#' @export
#'
#' @examples
#' \dontrun{
#' lab = labelStyle(show=TRUE, position='inside',
#' textStyle=textStyle(color='red'))
#' styLine = lineStyle(color='#fff', width=4, shadowBlur=5)
#' itemStyle = list(normal=itemStyle(lineStyle=styLine, label=lab),
#' emphasis=itemStyle(lineStyle=styLine, label=lab)
#' )
#' }
aesStyle = function(element=c('text', 'line', 'area', 'chord', 'node', 'link'),
...){
lst = list(...)
element = match.arg(element)
validParts = switch(
element,
text=c('color', 'decoration', 'align', 'baseline', 'fontFamily',
'fontSize', 'fontStyle', 'fontWeight'),
line=c('color', 'type', 'width', 'shadowColor', 'shadowBlur',
'shadowOffsetX', 'shadowOffsetY'),
area=c('color', 'type'),
chord=c('width', 'color', 'borderWidth', 'borderColor'),
node=c('color', 'borderWidth', 'borderColor'),
link=c('type', 'color', 'width'))
lst = lst[intersect(names(lst), validParts)]
if ('align' %in% names(lst))
lst$align = match.arg(lst$align, c('left', 'center', 'right'))
if ('baseline' %in% names(lst)) lst$baseline = match.arg(lst$baseline, c(
'top', 'middle', 'bottom'))
if ('type' %in% names(lst)) lst$type = match.arg(lst$type, c(
'solid', 'dotted', 'dashed', 'broken', 'curve', 'line', 'default'))
if ('fontStyle' %in% names(lst)) lst$fontStyle = match.arg(lst$fontStyle, c(
'normal', 'italic', 'oblique'))
if ('fontWeight' %in% names(lst)) stopifnot(
is.numeric(lst$fontWeight) || lst$fontWeight %in% c(
'normal', 'bold', 'bolder', 'lighter'))
if ('width' %in% names(lst)) stopifnot(is.numeric(lst$width))
if ('shadowBlur' %in% names(lst)) stopifnot(is.numeric(lst$shadowBlur))
if ('shadowOffsetX' %in% names(lst)) stopifnot(is.numeric(lst$shadowOffsetX))
if ('shadowOffsetY' %in% names(lst)) stopifnot(is.numeric(lst$shadowOffsetY))
if ('borderWidth' %in% names(lst)) stopifnot(is.numeric(lst$borderWidth))
if ('fontSize' %in% names(lst)) stopifnot(is.numeric(lst$fontSize))
return(lst)
}
#' @export
#' @rdname aesStyle
lineStyle = function(...) aesStyle('line', ...)
#' @export
#' @rdname aesStyle
textStyle = function(...) aesStyle('text', ...)
#' @export
#' @rdname aesStyle
areaStyle = function(...) aesStyle('area', ...)
#' @export
#' @rdname aesStyle
chordStyle = function(...) aesStyle('chord', ...)
#' @export
#' @rdname aesStyle
nodeStyle = function(...) aesStyle('node', ...)
#' @export
#' @rdname aesStyle
linkStyle = function(...) aesStyle('link', ...)
#' @export
#' @rdname aesStyle
labelStyle = function(...){
lst = list(...)
validParts = c(
'show', 'position', 'rotate', 'distance', 'formatter', 'textStyle', 'x', 'y')
if ('show' %in% names(lst)) stopifnot(is.logical(lst$show))
if ('position' %in% names(lst)) lst$position = match.arg(lst$position, c(
'outer', 'inner', 'left', 'right', 'top', 'inside', 'bottom', 'insideLeft',
'insideRight', 'insideTop', 'insdieBottom'
))
if ('rotate' %in% names(lst)) stopifnot(is.logical(lst$rotate))
if ('textStyle' %in% names(lst)) stopifnot(is.list(lst$textStyle))
return(lst)
}
#' @export
#' @rdname aesStyle
labelLineStyle = function(...){
lst = list(...)
validParts = c(
'show', 'length', 'lineStyle')
if ('show' %in% names(lst)) stopifnot(is.logical(lst$show))
if ('length' %in% names(lst)) stoifnot(
is.numeric(lst$length) || lst$length=='auto')
if ('lineStyle' %in% names(lst)) stopifnot(is.list(lst$lineStyle))
return(lst)
}
#' @export
#' @rdname aesStyle
itemStyle = function(...){
lst = list(...)
validParts = c(
'color', 'lineStyle', 'textStyle', 'areaStyle', 'chordStyle', 'nodeStyle',
'linkStyle', 'borderColor', 'borderWidth', 'barBorderColor', 'barBorderRadius',
'barBorderWidth', 'label', 'labelLine')
lst = lst[intersect(names(lst), validParts)]
return(lst)
}
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.