recharts2: An R Interface to ECharts3

#' @importFrom data.table melt
series_scatter = function(
    lst, type, subtype, layout, meta, fullMeta, layouts, return=NULL,
...){
    # g = echart(mtcars, wt, mpg, am)

    if (is.null(lst$x) || is.null(lst$y))
        stop('scatter charts need x and y!')
    if (is.character(lst$x) && is.character(lst$y) && is.null(lst$weight)){
        lst$weight = data.frame(weight=rep(1, nrow(lst$x)))
        type$misc[1] = 'bubble'
    }
    lst = mergeList(list(weight=NULL, series=NULL), lst)
    if (length(lst$x[[1]]) == 0) return(list(type=type$type[1], data=list(), name=''))

    data =  data.frame(y=lst$y[,1], x=lst$x[,1])

    if (!is.null(lst$weight)){  # weight as symbolSize
        data$weight = lst$weight[,1]
        minWeight = min(abs(meta$weight[,1]), na.rm=TRUE)
        maxWeight = max(abs(meta$weight[,1]), na.rm=TRUE)
        range = maxWeight - minWeight
        folds = maxWeight / minWeight
        if (abs(folds) < 50){  # max/min < 50, linear
            jsSymbolSize = JS(paste0('function (value){
                return ', switch(ceiling(abs(folds)/10), 8,7,6,5,4),
                '*Math.round(Math.abs(value[2]/', minWeight,'));
                }'))
        }else{  # max/min >= 50, normalize
            jsSymbolSize = JS(paste0('function (value){
                return Math.round(1+29*(Math.abs(value[2])-', minWeight,')/', range, ');
            }'))
        }

        if(is.numeric(lst$weight[,1])){
            if (nrow(lst$weight) > 0){
                dfWgt = data.frame(s=if (is.null(lst$series)) '' else lst$series[,1],
                                    w=lst$weight[,1], stringsAsFactors = FALSE)
                lvlWgt = data.table::dcast(dfWgt, s~., mean, value.var='w')
                lvlWgt[,2][is.na(lvlWgt[,2])] = 0
                pctWgt = lvlWgt[,2]/sum(lvlWgt[,2])
                lineWidths = 8*(pctWgt-min(pctWgt))/(max(pctWgt)-min(pctWgt)) +1
                lineWidths[is.na(lineWidths)] = 1
            }else{
                lineWidth = 1
            }
        }
    }

    if (is.null(lst$weight)){
        obj = list(type = type$type[1], data = asEchartData(data[,2:1]))
        ## only fetch col 1-2 of data, col 3 is series
    }else{
        obj = list(type = type$type,
                   data = asEchartData(data[,c(2:1, 3)]))
            if (grepl('bubble', type$misc)) obj$symbolSize = jsSymbolSize
            # line, weight links to line width
            if (type$type == 'line' && !is.null(lineWidths)){
                if (is.null(obj$itemStyle)) obj$itemStyle = list()
                if (is.null(obj$itemStyle$normal))
                    obj$itemStyle$normal = list()
                if (is.null(obj$itemStyle$normal$lineStyle))
                    obj$itemStyle$normal$lineStyle = list()
                obj$itemStyle$normal$lineStyle = mergeList(
                    obj$itemStyle$normal$lineStyle, list(width=lineWidths)
                )
            }  ## fetch col 1-2 and 3 (x, y, weight)
    }
    if (!is.null(lst$series)) if (length(lst$series[[1]])>0 && !is.na(lst$series[1,1]))
        obj$name = as.character(lst$series[1,1])
    if (type$type == 'effectScatter')
        obj$rippleEffect = list(brushType='stroke')

    obj = setCoordIndex(obj, layout$coordSys, layout$coordIdx)

    return(obj[intersect(names(obj), ifnull(return, names(obj)))])
}

series_effectScatter = series_scatter

series_bar = function(
    lst, type, subtype, layout, meta, fullMeta, layouts, return=NULL,
...){
    # example:
    # mtcars$model = row.names(mtcars)
    # echart(mtcars, model, mpg,
    #     series=factor(am, levels=c(1,0), labels=c('Manual','Automatic')),
    #     type=c('hbar','scatter'))
    lst = mergeList(list(series=NULL), lst)
    if (is.null(lst$x)) stop('bar chart needs at least x.')
    if (length(lst$x[[1]]) == 0) return(list(type=type$type[1], data=list(), name=''))

    data = data.frame(y=ifnull(lst$y[,1], NA), x=lst$x[,1])

    if (!'y' %in% names(lst)) {  # y is null, then...
        if (any(grepl('hist', type$misc))){  # histogram
            hist = hist(data[,2], plot=FALSE)
            if ('density' %in% subtype[[1]]){
                data = as.matrix(cbind(hist$density, hist$mids))  # y, x
            }else{
                data = as.matrix(cbind(hist$counts, hist$mids))  # y, x
            }
        }else{  # simply run freq of x
            if (is.numeric(data[,2])){
                data = as.matrix(as.data.frame(table(data[,2])))
            }else{
                data = as.matrix(table(data[,2]))
            }
        }
    }else{
        if (any(duplicated(data$x)))
            stop('y must only have one value corresponding to each combination of x, series and facet')
    }

    data1 = data.frame(y=NA, x=meta$x[,1])
    data1$y[data1$x %in% data$x] = data$y
    data = data1
    rm(data1)

    # weight link to barWidth/lineWidth
    barWidths = NULL
    lineWidths = NULL
    if ('weight' %in% names(lst)) if(is.numeric(lst$weight[,1])){
        if (nrow(lst$weight) > 0){
            dfWgt = data.frame(s=if (is.null(lst$series)) '' else meta$series[,1],
                               w=meta$weight[,1], stringsAsFactors = FALSE)
            lvlWgt = data.table::dcast(dfWgt, s~., mean, value.var='w')
            lvlWgt[,2][is.na(lvlWgt[,2])] = 0
            lvlWgt$pct = lvlWgt[,2]/sum(lvlWgt[,2], na.rm=TRUE)
            barWidths = paste0(85 * lvlWgt$pct, '%')
            lineWidths = 8 * with(lvlWgt, pct-min(pct)/(max(pct)-min(pct))) + 1
            lineWidths[is.na(lineWidths)] = 1
        }else{
            lineWidths = 1
        }
    }

    obj = list(type=type$type[1], data=asEchartData(data[,2:1]))
    if (!is.null(lst$series)) if (length(lst$series[[1]]>0) && !is.na(lst$series[1,1]))
        obj$name = as.character(lst$series[1,1])
    if (any(grepl("flip", type$misc[[1]]))) obj$barMinHeight = 0
    if (grepl('hist',type$misc[[1]])) obj$barWidth = '90%'
    if (type$type[1] == 'bar' && !is.null(barWidths))
        obj$barWidth = barWidths[which(lvlWgt$s == lst$series[1,1])]

    if (type$type[1] == 'line' && !is.null(lineWidths)){
        if (is.null(obj$itemStyle)) obj$itemStyle = list()
        obj$itemStyle = mergeList(obj$itemStyle, list(
            normal=list(lineStyle=list(
                width=lineWidths[which(lvlWgt$s == lst$series[1,1])]))))
    }
    if ('stack' %in% ifnull(subtype[1], '')[[1]]) obj$stack = 'Group'
    obj = setCoordIndex(obj, layout$coordSys, layout$coordIdx)

    return(obj[intersect(names(obj), ifnull(return, names(obj)))])
}

series_line = function(
    lst, type, subtype, layout, meta, fullMeta, layouts, return=NULL,
...) {
    # Example:
    # g=echart(airquality, as.character(Day), Temp,t=Month, type='curve')
    # g=echart(airquality, as.character(Day), Temp,t=Month, type='area_smooth')
    lst = mergeList(list(series=NULL), lst)
    if (length(lst$x[[1]]) == 0) return(list(type=type$type[1], data=list(), name=''))

    data = data.frame(y=ifnull(lst$y[,1], NA), x=lst$x[,1])

    if (is.null(lst$x[,1]) && is.ts(lst$y[,1])) {
        lst$x[,1] = as.numeric(time(lst$y[,1]))
        lst$y[,1] = as.numeric(lst$y[,1])
    }
    obj = list()

    if (is.numeric(lst$x[,1])) {
        obj = series_scatter(lst, type = type, subtype = subtype, layout = layout,
                             meta = meta, fullMeta = fullMeta)
    }else{
        if (is.null(lst$series)) {
            obj = list(list(type = 'line', data = asEchartData(lst$y[,1]),
                            name = ''))
        }
    }
    if (length(obj) == 0) obj = series_bar(
        lst, type = type, subtype = subtype, layout = layout, meta = meta,
        fullMeta = fullMeta)

    # area / stack / smooth
    if (grepl("fill", type$misc))
        obj$areaStyle = list(normal=list(opacity = 0.5))
    if (grepl('step', type$misc)){
        obj$step = TRUE
        if ('step_start' %in% subtype) obj$step = 'start'
        if ('step_middle' %in% subtype) obj$step = 'middle'
        if ('step_end' %in% subtype) obj$step = 'end'
    }
    if (is.null(obj$lineStyle)) obj$lineStyle = list(normal=list())
    if ('connect' %in% subtype) obj$connectNulls = TRUE
    if ('solid' %in% subtype)
        obj$lineStyle$normal = mergeList(obj$lineStyle$normal, list(type='solid'))
    if ('dashed' %in% subtype)
        obj$lineStyle$normal = mergeList(obj$lineStyle$normal, list(type='dashed'))
    if ('dotted' %in% subtype)
        obj$lineStyle$normal = mergeList(obj$lineStyle$normal, list(type='dotted'))

    if ('stack' %in% subtype) obj[['stack']] = 'Group'
    if (grepl('smooth', type$misc)) obj[['smooth']] = TRUE
    if ('nosymbol' %in% subtype) {
        obj$symbol = 'none'
    }else{
        if (any(validSymbols %in% subtype)) {
            obj$symbol = interct(validSymbols, subtype)[1]
            obj$showAllSymbol = TRUE
        }
    }
    obj = setCoordIndex(obj, layout$coordSys, layout$coordIdx)
    return(obj[intersect(names(obj), ifnull(return, names(obj)))])
}

series_candlestick = function(
    lst, type, subtype, layout, meta, fullMeta, layouts, return=NULL,
...){
    # Example:
    # g=echart(stock, date, c(open, close, low, high), type='k')

    obj = list(list(name='Stock', type=type$type[1], data=asEchartData(lst$y[,1:4])))
    obj = setCoordIndex(obj, layout$coordSys, layout$coordIdx)
    return(obj[intersect(names(obj), ifnull(return, names(obj)))])
}

series_boxplot = function(
    lst, type, subtype, layout, meta, fullMeta, layouts, return=NULL,
...){
    # Example:
browser()
    if (is.null(lst$y)) stop('boxplots need y!')
    if (!is.numeric(lst$y[,1])) stop('boxplots only support numeric y!')
    if (ncol(lst$y) >= 5) {
        if (sort(lst$y[1,1:5]) != lst$y[1,1:5])
            stop('please ensure y is arranged in the order of min, Q1, median, Q3, max.')
        obj = list(name = if (is.null(lst$series)) 'boxplot' else as.character(lst$series[1]),
                   type = type$type, data = asEchartData(lst$y[,1:5])
                   )
    }else{
        data = data.frame(y=lst$y[,1])
        data$x = if (is.null(lst$x)) names(lst$y)[1] else lst$x[,1]
        box.data = sapply(split(data, data$x), function(df){
            result = summary(df$y)
            return(unname(c(result['Median'] - 1.5 * IQR(df$y),
                     result[c('1st Qu.', 'Median', '3rd Qu.')],
                     result['Median'] + 1.5 * IQR(df$y))))
        })
        box.data = as.data.frame(t(box.data))
        obj = list(name = if (is.null(lst$series)) 'boxplot' else as.character(lst$series[1]),
                   type = type$type, data = asEchartData(box.data)
                  )
    }
    obj = setCoordIndex(obj, layout$coordSys, layout$coordIdx)
    return(obj[intersect(names(obj), ifnull(return, names(obj)))])
}

series_pie = function(
    lst, type, subtype, layout, meta, fullMeta, layouts, return=NULL,
...){
    # Example:
    # g=echart(iris, Species, Sepal.Width, type='pie')
    # g=echart(mtcars, gear, mpg, am, type='pie')
    # g=echart(mtcars, gear, mpg, facet=am, type='pie')
    # g=echart(mtcars, y=mpg, facet=gear, type='ring')
    # g=echart(mtcars, y=mpg, series=gear, type='ring')
    ## ring_info
    # ds=data.frame(q=c('68% feel good', '29% feel bad', '3% have no feelings'),
    #               a=c(68, 29, 3))
    # g=echart(ds, q, a, type='ring_info')
    # dev.width=paste0("document.getElementById('", g$elementId,"').offsetWidth")
    # dev.height=paste0("document.getElementById('", g$elementId,"').offsetHeight")
    # g %>% setLegend(pos=c('center','top','vertical'),
    #                 itemGap=JS(paste0(dev.height,"*0.4/3"))) %>%
    #       relocLegend(x=JS(paste0(dev.width,"/2")), y=JS(paste0(dev.height,"/10")))
browser()
    if (is.null(lst$y)) stop('pie/funnel charts need y!')
    if (is.null(lst$x) && is.null(lst$facet) && is.null(lst$series))
        stop('pie/funnel charts need either x or series or facet!')
    data = data.frame(y=lst$y[,1])

    if (!is.null(lst$x)){  # there is x
        data[,'x'] = lst$x[,1]
    }else{  # there is no x
        data[,'x'] = 'TRUE'
    }
    data[,'series'] = if (is.null(lst$series)) NA else lst$series[,1]
    data[,'facet'] = if (is.null(lst$facet)) names(lst$y)[1] else lst$facet[,1]

    data = data.table::dcast(data, facet + series + x~., sum, value.var='y')
    names(data) = c('facet', 'series', 'x', 'y')

    ## if no NULL, then suppl a negative level
    if (all(data$x == 'TRUE')){
        meta.data = if (!is.null(lst$t))
            data.frame(y=meta[[lst$t[1,1]]]$y[,1], x=meta[[lst$t[1,1]]]$x[,1]) else
                data.frame(y=meta$y[,1])

        if (!is.null(lst$series))
            meta.data$g = if (!is.null(lst$t)) meta[[lst$t[1,1]]]$series[,1] else
                meta$series[,1]
        else meta.data$g = ''

        meta.data = data.table::dcast(meta.data, g ~ ., sum, value.var = 'y')
        if (is.null(lst$facet))
            sum.y = sum.y = sum(meta.data[, '.'], na.rm=TRUE)
        else
            sum.y = sum(meta.data[meta.data$g == ifna(data$series,''), '.'], na.rm=TRUE)
        data1 = data
        data1$x = 'FALSE'
        data1$y = sum.y - data$y
        data = rbind(data, data1)
        rm(data1)
    }

    ## styles: itemStyle, label, labelLine
    sty.label.generic = list(
        normal = list(show=FALSE), emphasis = list(show=TRUE)
    )
    sty.label.show = list(
        normal = list(show=TRUE), emphasis = list(show=TRUE)
    )
    sty.label.inside = list(
        normal = list(show=FALSE, position='center'),
        emphasis = list(show=TRUE, textStyle=list(
            fontSize='30', fontWeight='bold'))
    )
    sty.label.noshow = list(
        normal = list(show=FALSE), emphasis = list(show=FALSE)
    )
    sty.labelLine.generic = list(
        normal = list(show=FALSE), emphasis = list(show=TRUE)
    )
    sty.labelLine.show = list(
        normal = list(show=TRUE), emphasis = list(show=TRUE)
    )
    sty.labelLine.noshow = list(
        normal = list(show=FALSE), emphasis = list(show=FALSE)
    )
    sty.placeholder = list(
        normal = list(color='rgba(0,0,0,0)'), emphasis = list(color='rgba(0,0,0,0)')
    )
    sty.gray = list(
        normal = list(color='#ccc'), emphasis=list(color='rgba(0,0,0,0)')
    )
    delta.radius = sort(with(layouts[layouts$type %in% c('pie', 'rose', 'ring'),],
                        convPct2Num(layouts$radius) - min(convPct2Num(layouts$radius))
                    ))[2]
    if (delta.radius == 0) delta.radius = convPct2Num(layouts$radius[1]) * 2/3
    delta.radius = if ('info' %in% subtype) {
            if (delta.radius > 0.1) 0.1 else delta.radius
        }else {
            delta.radius*2/3
        }

    obj = list(
        name=as.character(data$facet[1]), type=type$type,
        data=unname(apply(data[,c('x', 'y', 'series', 'facet')], 1, function(row) {
            if (row[1] == 'FALSE')
                return(list(name='', value= ifna(as.numeric(row[2]), '-'),
                     itemStyle=sty.gray, label=sty.label.noshow,
                     labelLine=sty.labelLine.noshow))
            else
                return(list(name=if (as.character(row[1])=='TRUE')
                    as.character(ifna(unname(row[3]), unname(row[4]))) else
                        as.character(unname(row[1])),
                    value=ifna(as.numeric(unname(row[2])), '-')
                    ))
            })),
        center=c(layout$centerX, layout$centerY), width=layout$radius,
        left=convNum2Pct(convPct2Num(layout$centerX)-convPct2Num(layout$radius)/2),
        label=sty.label.generic, labelLine=sty.labelLine.generic, radius=layout$radius,
        max=ifelse(all(is.na(data[,'y'])), 0, max(unname(data[,'y']), na.rm=TRUE)),
        height=layout$radius, top=layout$top, bottom=layout$bottom,
        selectedMode=if ('multi' %in% subtype) 'multiple' else FALSE
    )
    # additinal for ring
    if (grepl('ring', type$misc)){
        obj[['radius']] = convNum2Pct(
            convPct2Num(layout$radius) - c(delta.radius, 0))
        obj[['label']] = sty.label.inside
        obj[['labelLine']] = sty.labelLine.noshow
        obj[['clockwise']] = any(c('clock', 'clockwise') %in% subtype)
    }
    # additional fo rose
    if ('radius' %in% subtype){
        obj[['roseType']] = 'radius'
        obj[['radius']] = convNum2Pct(convPct2Num(layout$radius) * c(0.2, 1))
    }else if ('area' %in% subtype){
        obj[['roseType']] = 'area'
        obj[['radius']] = convNum2Pct(convPct2Num(layout$radius) * c(0.2, 1))
    }else if ('info' %in% subtype){
        obj[['data']][[2]][['itemStyle']] = sty.placeholder
    }else{
        if (is.null(obj)) obj[['radius']] = layout$radius
    }
    ## additional for funnel charts
    if (type$type == 'funnel'){
        if (grepl('ascending', type$misc)) obj[['sort']] = 'ascending'
        if (is.null(obj$labelLine)) obj$labelLine = list()
        obj[['labelLine']] = mergeList(obj[['labelLine']], list(normal=list(show=TRUE)))
        if (is.null(obj$label)) obj$label = list()
        obj[['label']] = mergeList(obj[['label']], list(normal=list(show=TRUE)))
        if ('left' %in% subtype){
            obj[['funnelAlign']] = 'left'
        }else if ('right' %in% subtype){
            obj[['funnelAlign']] = 'right'
        }
    }

    obj = setCoordIndex(obj, layout$coordSys, layout$coordIdx)
    return(obj[intersect(names(obj), ifnull(return, names(obj)))])
}

series_funnel = series_pie

series_radar = function(
    lst, type, subtype, layout, meta, fullMeta, layouts, return=NULL,
...){
    # Example:
    # cars = mtcars[c('Merc 450SE','Merc 450SL','Merc 450SLC'),
    #               c('mpg','disp','hp','qsec','wt','drat')]
    # cars$model = rownames(cars)
    # cars = data.table::melt(cars, id.vars='model')
    # names(cars) = c('model', 'indicator', 'Parameter')
    # echart(cars, indicator, Parameter, model, type='radar') %>%
    #        setTitle('Merc 450SE  vs  450SL  vs  450SLC')
    # echart(cars, c(indicator, model), Parameter, type='radar', sub='fill')
    # echart(cars, c(indicator, model), Parameter, type='target') %>%
    #         setSymbols('none')
    #
    # echart(cars, indicator, Parameter, t=model, type='radar')
    # ----------------
    #
    # carstat = data.table::dcast(data.table::data.table(mtcars),
    #               am + carb + gear ~., mean,
    #               value.var=c('mpg','disp','hp','qsec','wt','drat'))
    # carstat = data.table::melt(carstat, id=c('am', 'carb', 'gear'))
    # names(carstat) = c('am', 'carb', 'gear', 'indicator', 'Parameter')
    # levels(carstat$indicator) = gsub("_mean_\\.", "",
    #                                   levels(carstat$indicator))
    # carstat$am = factor(carstat$am, labels=c('A', 'M'))
    # fullData = data.frame(expand.grid(levels(carstat$indicator),
    #             levels(carstat$am), unique(carstat$carb)))
    # carstat = merge(fullData, carstat, all.x=TRUE)
    # echart(carstat, c(indicator, am),
    #         Parameter, carb, t=gear, type='radar')

    # x[,1] is x, x[,2] is series; y[,1] is y; series[,1] is polorIndex
    if (is.null(lst$y) || is.null(lst$x)) stop('radar charts need x and y!')
    ds = data.frame(lst$y[,1], lst$x[,1:(ifelse(ncol(lst$x) > 1, 2, 1))])
    if (ncol(lst$x) == 1) ds[,ncol(ds)+1] = names(lst$y)[1]
    if (is.null(lst$series)) ds[,ncol(ds)+1] = 0
    else ds[,ncol(ds)+1] = lst$series[,1]
    names(ds) = c('y', 'x', 'series', 'index')
    ds$x = as.factor(ds$x)
    ds$series = as.factor(ds$series)
    ds$index = as.factor(ds$index)

    data = data.table::dcast(ds, index+x+series~., sum, value.var='y')
    names(data) = c('index', 'x', 'series', 'y')
    fullData = data.frame(expand.grid(
        if (is.null(lst$series)) levels(ds$index) else
            if (is.factor(lst$series[,1])) levels(lst$series[,1]) else
                unique(lst$series[,1]),
            levels(ds$x), levels(ds$series)))
    if (ncol(lst$x) > 1) if (is.factor(lst$x[,2])){
        fullData = data.frame(expand.grid(
            if (is.null(lst$series)) levels(ds$index) else
                if (is.factor(lst$series[,1])) levels(lst$series[,1]) else
                    unique(lst$series[,1]),
            levels(ds$x), levels(lst$x[,2])))
    }

    names(fullData) = c('index', 'x', 'series')
    data = merge(fullData, data, all.x=TRUE, sort=FALSE)
    data$x = as.character(data$x)
    index = if (length(unique(fullData$index)) == 1) 0 else
        (1:nlevels(fullData$index))-1
    obj = lapply(index, function(i){
        dt = if (length(index) == 1) data else
            data[data$index==levels(fullData$index)[i+1],]
        out = list(type=type[i+1, 'type'], symbol='none',
                    name=if (length(index) == 1) 0 else
                        levels(fullData$index)[i+1],
                    data=lapply(unique(dt$series), function(s){
                        list(name=as.character(s),
                             value=lapply(dt[dt$series==s, 'y'], function(x){
                                 ifna(x, '-')}))
                    }))
        if (i>0) out[['polarIndex']] = i
        if ('fill' %in% subtype[[i+1]])
            out[['itemStyle']] = list(normal=list(areaStyle=list(type='default')))
        return(out)
    })

    return(obj[intersect(names(obj), ifnull(return, names(obj)))])
}

series_force = function(
    lst, type, subtype, layout, meta, fullMeta, layouts, return=NULL,
...){
    # x: node/link, x2: link, series: series/relation, y: weight/value
    # df with x2 NA is nodes, !NA is links. If all !NA, no categories are linked
    # or x: name column, y: matrix
    # Example
    # echart(yu, c(source, target), value, relation, type='force')
    # echart(deutsch, c(club, player), weight, role, type='chord')
    if (is.null(lst$y) || is.null(lst$x))
        stop('radar charts need x and y!')
    if (is.null(lst$series)){
        if (ncol(lst$y) != nrow(lst$y)) stop('When there is no series, y must be a matrix!')
    }else{
        if (ncol(lst$x) < 2) stop('x must have at least 2 columns: 1st as source, 2nd as target!')
    }

    if (is.null(lst$series)){  #matrix mode
        data = data.frame(lst$y, lst$x[,1])
        matrix = unname(as.matrix(lst$y))
        categories = as.character(unique(lst$x[,1]))
    }else{  # nodes and links mode
        data = data.frame(lst$y[,1], lst$x[,1:2], lst$series[,1])
        if (!any(is.na(data[,3]))){
            nodes = unique(c(as.character(data[,2]), as.character(data[,3])))
            categories = as.character(data[,4])
        }else{
            nodes = data[is.na(data[,3]), c(1,2,4)]
            names(nodes) = c("value", "name", "series")
            categories = as.character(unique(nodes$series))
        }
        links = data[!is.na(data[,3]),]
        names(links) = c("value", "source", "target", "name")
    }

    if (any(type$type %in% c('force', 'chord'))){
        types = type$type
        o = list(list(
            type=types[1], name='Connection', roam='move',
            itemStyle=list(normal=list(
                label=list(show=TRUE, textStyle=list(color='#333')),
                nodeStyle=list(brushType='both', strokeColor='rgba(255,215,0,0.4)'),
                linkStyle=list(type=ifelse(grepl('line', type$misc[1]), 'line',
                                           ifelse(is.null(lst$series), 'line', 'curve')))
            ), emphasis=list(
                label=list(show=FALSE), nodeStyle=list(), lineStyle=list()
            )),
            minRadius=8, maxRadius=20
        ))
        # nodes/links or matrix
        if (is.null(lst$series)){  # data/matrix
            o[[1]]$matrix = asEchartData(matrix)
            o[[1]]$data = lapply(categories, function(catg){
                list(name=unname(catg))})
        }else{  # categories, nodes/links
            if (is.null(dim(nodes))){
                o[[1]]$nodes = lapply(nodes, function(vec){
                    list(name=vec)
                })
            }else{
                o[[1]]$nodes = unname(apply(nodes, 1, function(row){
                    list(category=which(categories==row[['series']])-1,
                         name=row[['name']], value=as.numeric(row[['value']]))
                }))
                o[[1]]$categories = lapply(categories, function(catg){
                    list(name=unname(catg))})
            }

            o[[1]]$links = unname(apply(links, 1, function(row){
                list(source=row[['source']], target=row[['target']],
                     name=row[['name']], weight=as.numeric(row[['value']]))
            }))
        }

        #other params
        ## linkSymbol
        if ('arrow' %in% subtype[[1]]) o[[1]]$linkSymbol = 'arrow'
        if ('triangle' %in% subtype[[1]]) o[[1]]$linkSymbol = 'triangle'

        ## auto ribbon
        if (types[1] == 'force'){
            if (is.null(lst$series)){
                 o[[1]]$ribbonType = TRUE
            }else{
                if (sum(paste(links$source, links$target) ==
                        paste(links$target, links$source), na.rm=TRUE) / nrow(links) > 0.5)
                    o[[1]]$ribbonType = TRUE
                else o[[1]]$ribbonType = FALSE
            }
        }else{
            o[[1]]$ribbonType = 'ribbon' %in% subtype[[1]]
        }

        ## sort, sortSub, rotateLabel, scale
        if ('asc' %in% subtype[[1]]) o[[1]]$sort = 'ascending'
        if ('ascsub' %in% subtype[[1]]) o[[1]]$sortSub = 'ascending'
        if ('desc' %in% subtype[[1]]) o[[1]]$sort = 'descending'
        if ('descsub' %in% subtype[[1]]) o[[1]]$sortSub = 'descending'
        if ('rotatelab' %in% subtype[[1]]) {
            if (is.null(o[[1]]$itemStyle)) o[[1]]$itemStyle = list()
            if (is.null(o[[1]]$itemStyle$normal)) o[[1]]$itemStyle$normal = list()
            if (is.null(o[[1]]$itemStyle$normal$label))
                o[[1]]$itemStyle$normal$label = list()
            o[[1]]$itemStyle$normal$label$rotate = TRUE
        }
        if ('hidelab' %in% subtype[[1]]) {
            if (is.null(o[[1]]$itemStyle)) o[[1]]$itemStyle = list()
            if (is.null(o[[1]]$itemStyle$normal)) o[[1]]$itemStyle$normal = list()
            if (is.null(o[[1]]$itemStyle$normal$label))
                o[[1]]$itemStyle$normal$label = list()
            o[[1]]$itemStyle$normal$label$show = FALSE
        }
        o[[1]]$showScale = any(c('scale', 'scaletext') %in% subtype[[1]])
        o[[1]]$showScaleText = 'scaletext' %in% subtype[[1]]

        ## clockWise
        if ('clock' %in% subtype[[1]] || 'clockwise' %in% subtype[[1]])
            o[[1]]$closeWise = TRUE

        return(o[intersect(names(o), ifnull(return, names(o)))])
    }
}

series_chord = series_force

series_gauge = function(
    lst, type, subtype, layout, meta, fullMeta, layouts, return=NULL,
...){
    if (is.null(lst$x) || is.null(lst$y))
        stop('gauge charts need x and y!')
    data = data.frame(y=lst$y[,1], x=lst$x[,1])
    data$series = if (is.null(lst$series)) '' else lst$series[,1]
    nSeries = length(unique(data$series))
    layouts = autoMultiPolarChartLayout(nSeries)
    rows = layouts$rows
    cols = layouts$cols
    cols = layouts$cols
    centers = layouts$centers
    radius = layouts$radius

    if ('fullMeta' %in% names(list(...))){
        fullMeta = list(...)$fullMeta
        meta = cbind(
            as.character(unlist(lapply(fullMeta, function(l) unlist(l$x)))),
            unlist(lapply(fullMeta, function(l) unlist(l$y))))
    }

    out = lapply(unique(data$series), function(series){
        dt = data[data$series==series,]
        idx = which(unique(data$series)==series)
        iType = type[idx,]
        o = list(type=iType$type, center=paste0(centers[idx,], '%'),
                  radius=paste0(radius, '%'),
                  data=unname(apply(dt, 1, function(row){
                      list(name=unname(as.character(row['x'])),
                           value=unname(as.numeric(row['y'])))
                  })))
        if (series != '') o[['name']] = unname(series)
        if ('fullMeta' %in% names(list(...))){
            o[['max']] = max(as.numeric(meta[meta[,1]==series, 2]), na.rm=TRUE)
        }else{
            o[['max']] = max(dt$y[dt$x==dt$x[1]], na.rm=TRUE)
        }
        return(o)
    })

    return(oout[intersect(names(out), ifnull(return, names(out)))])
}

series_map = function(
    lst, type, subtype, layout, meta, fullMeta, layouts, return=NULL,
...){
    # x[,1] x; x[,2] series; y[,1] value; y[,2] selected; series[,1] multi-maps

    # Example:
    # echart(NULL, type="map_china")
    x = if (is.null(lst$x)) NA else lst$x[,1]
    series = if (is.null(lst$x)) '' else if (ncol(lst$x) > 1) lst$x[,2] else ''
    y = if (is.null(lst$y)) NA else lst$y[,1]
    sel = if (is.null(lst$y)) FALSE else
        if (ncol(lst$y) > 1) as.logical(lst$y[,2]) else FALSE
    idx = if (is.null(lst$series)) '' else lst$series[,1]
    data = data.frame(y, x, series, sel, idx, stringsAsFactors=FALSE)

    # special case: geoJSON
    if (any(type$misc == 'geojson')){
        iGeoJSON = which(type$misc == 'geojson')
        subtype[iGeoJSON] = 'newmap'
    }

    # two modes: series - mono map mulit series; split - multi map mono series
    mode = if (is.null(lst$series)) 'series' else 'split'
    lvlSeries = if (mode=='series') as.character(unique(data$series)) else
        as.character(unique(data$idx))
    nSeries = length(lvlSeries)

    if (nrow(type) < nSeries)
        type[nrow(type)+1:nSeries,] = type[nrow(type),]
    if (length(subtype) < nSeries)
        subtype[length(subtype)+1:nSeries] = subtype[length(subtype)]

    #layouts
    if (mode=='split'){
        if (is.null(lst$t)){
            layouts = autoMultiPolarChartLayout(nSeries, col.max=4)
        }else{
            layouts = autoMultiPolarChartLayout(nSeries, bottom=15, col.max=4)
        }
        rows = layouts$rows
        cols = layouts$cols
        ul.corners = layouts$centers - layouts$radius/2
    }

    out = lapply(lvlSeries, function(series){
        if (mode=='series'){
            dt = data[!is.na(data$x) & !is.na(data$y) & data$series==series,]
            idx = which(unique(data$series)==series)
        }else{
            dt = data[!is.na(data$x) & !is.na(data$y) & data$idx==series,]
            idx = which(unique(data$idx)==series)
        }
        iType = type[idx,]
        validSubtypes = eval(parse(text=iType$subtype))
        iSubtype = subtype[[idx]]
        if (!identical(iSubtype, ''))
            iSubtype = validSubtypes[which(tolower(validSubtypes) %in% iSubtype)]
        if (length(iSubtype[!iSubtype %in% c(
            "", "sum", "average", "scale", "move")]) == 0){
            mapType = gsub("^.*(china|world|newmap).*$", "\\1", iType$misc)
        }else{
            if (mode=='series'){
                if (grepl('world', iType$misc))
                    mapType =paste('world',
                          iSubtype[! iSubtype %in% c(
                              'sum', 'average', 'scale', 'move')][1],
                          sep='|')
                else
                    mapType = iSubtype[! iSubtype %in% c(
                        'sum', 'average', 'scale', 'move')][1]
            }else{
                mapType = paste(gsub("^.*(china|world).*$", "\\1", iType$misc),
                      iSubtype[! iSubtype %in% c(
                          'sum', 'average', 'scale', 'move')][1], sep="|")
            }
        }
        o = list(
            type=iType$type, mapType=mapType,
            itemStyle=list(normal=list(label=list(show=FALSE)),
                           emphasis=list(label=list(show=TRUE))),
            data=list()
        )
        if ('move' %in% iSubtype){
            o$roam = 'move'
            if ('scale' %in% iSubtype) o$roam = TRUE
        }else if ('scale' %in% iSubtype){
            o$roam = 'scale'
        }
        o$name = if (!is.null(lst$y)) names(lst$y)[1]
        if (grepl('multi', iType$misc)) o$selectedMode = 'multiple'
        if (mode=='split')
            o$mapLocation = list(
                x=paste0(ul.corners[idx,1], '%'),
                y=paste0(ul.corners[idx,2], '%'),
                width=paste0((90-4*cols)/cols, '%'),
                height=paste0((90-4*rows)/rows, '%'))
        if (nrow(dt) > 0)
            o$data = unname(apply(dt, 1, function(row){
                list(name=as.character(unname(row['x'])),
                     value=ifna(as.numeric(unname(row['y'])), '-'),
                     selected=ifna(as.logical(unname(row['sel'])), FALSE))
            }))
        if (mode=='series') if (series != "") o$name = series
        if (mode=='split') if (! (is.na(dt$series) || all(dt$series=='')))
            o$name = dt$series[1]
        if ('average' %in% iSubtype) o$mapValueCalculation = 'average'

        return(o)
    })

    return(out[intersect(names(out), ifnull(return, names(out)))])
}


series_wordCloud = function(
    lst, type, subtype, layout, meta, fullMeta, layouts, return=NULL,
...){
    # does not accept series
    if (is.null(lst$y) || is.null(lst$x))
        stop('wordCloud charts need x and y!')
    data = data.frame(lst$y[,1], lst$x[,1])
    names(data)[1:2] = c('y', 'x')
    data = data.table::dcast(data, x~., sum, value.var='y')
    names(data)[2] = 'y'

    colors = getColFromPal()

    if (is.null(lst$series)){
        o = list(list(data=unname(apply(data, 1, function(row){
            list(name=unname(row['x']), value=unname(ifna(as.numeric(row['y']), '-')),
                 itemStyle=list(normal=list(color=sample(colors,1))))
            })), textRotation=c(0,-45,-90,45,90), type=type$type[1],
            size=list('80%', '80%')))

    }else{
        data$series = as.factor(lst$series[,1])
        if (length(colors) < length(nlevels(data$series)))
            colors = rep(colors, ceiling(nlevels(data$series)/length(colors)))
        data$color = colors[as.numeric(data$series)]

        o = list(list(data=unname(apply(data, 1, function(row){
            list(name=unname(row['x']), value=unname(ifna(as.numeric(row['y']), '-')),
                 itemStyle=list(normal=list(color=unname(row['color']))))
        })), textRotation=c(0,-45,45,90), type=type$type[1],
        size=list('80%', '80%')))
        attr(o[[1]]$data, 'meta') = data$series
    }

    return(o[intersect(names(o), ifnull(return, names(o)))])
}

series_eventRiver = function(
    lst, type, subtype, layout, fullMeta, layouts, return=NULL,
...){
    # x: slice time, event name, slice title, slice url, slice img;
    # y: slice value, event weight;  series: series, series weight
    if (is.null(lst$x) || is.null(lst$y)) stop('eventRiver chart needs x and y!')
    if (ncol(lst$x) < 2)
        stop(paste('x should be comprised of 2 compulsory columns:',
                   'event slice time, events name and 3 optional columns:',
                   'event slice title, event slice links, event slice images.',
                   '(the exact order)'))
    if (!is.numeric(lst$x[,1]))
        stop('x[,1] should be transformed to time first.')
    if (any(duplicated(paste(lst$x[,1], lst$x[,2]))))
        stop(paste('No duplicated combination of x[,1] and x[,2] is allowed!',
                   'Please check row', which(duplicated(paste(lst$x[,1], lst$x[,2])))), '.')
    if (ncol(lst$y) < 2) lst$y[,2] = 1

    data = cbind(lst$y[,1:2], lst$x[,1:2])
    names(data) = c('value', 'weight', 'time', 'event')
    data$slice = if (ncol(lst$x) >= 3) lst$x[,3] else NA
    data$link = if (ncol(lst$x) >= 4) lst$x[,4] else NA
    data$image = if (ncol(lst$x) >= 5) lst$x[,5] else NA
    if (is.null(lst$series)) {
        data$series = ''
        data$seriesWgt = 1
    }else{
        data$series = lst$series[,1]
        data$seriesWgt = if (ncol(lst$series) > 1) lst$series[,2] else 1
    }

    series = unique(as.character(data$series))
    data$time = format(convTimestamp(data$time, 'JS', 'R'), "%Y-%m-%d %T")

    out = lapply(series, function(s){
        type = type[which(series == s),]
        dt = data[data$series==s,]
        o = list(type=type$type, data=lapply(as.character(unique(dt$event)),
                                              function(event){
            ds = dt[dt$event==event,]
            list(name=event, weight=ifna(as.numeric(ds$weight[1]), '-'),
                 evolution=unname(apply(ds, 1, function(row){
                     evo = list(
                         time=unname(row['time']),
                         value=ifna(as.numeric(unname(row['value'])), '-'),
                         detail=list())
                     if (!is.na(row['link']))
                         evo$detail[['link']] = unname(row['link'])
                     if (!is.na(row['slice']))
                         evo$detail[['text']] = unname(row['slice'])
                     if (!is.na(row['image']))
                         evo$detail[['img']] = unname(row['image'])
                     return(evo)
                 })))
            }), weight=as.numeric(dt$seriesWgt[1])
            )
        if (s != '') o$name = unname(s)
        return(o)
    })

    return(out[intersect(names(out), ifnull(return, names(out)))])
}

series_venn = function(
    lst, type, layout, meta, fullMeta, layouts, return=NULL,
...){
    # deleted
    if (is.null(lst$x) || is.null(lst$y)) stop('venn charts need x and y!')
    if (nrow(lst$y) < 3) stop('y has to have 3 rows with the last row be intersection.')
    data = data.frame(y=lst$y[,1], x=lst$x[,1])[1:3,]
    o = list(list(type='venn', itemStyle=list(
        normal=list(label=list(show=TRUE)),
        emphasis=list(borderWidth=3, borderColor='yellow')
        ),
        data=unname(apply(data, 1, function(row){
            list(value=unname(ifna(as.numeric(row['y']), '-')),
                 name=unname(row['x']))
        }))
    ))

    return(o[intersect(names(o), ifnull(return, names(o)))])
}

series_treemap = function(
    lst, type, subtype, layout, meta, fullMeta, layouts, return=NULL,
...){

    if (is.null(lst$x) || is.null(lst$y))
        stop("treemap charts need x and y!")
    if (ncol(lst$x) < 2 && any(type$type == 'treemap'))
        stop(paste('for tree charts, x must contain 2 columns. x[,1] is node name,',
                   'x[,2] is parent node name.'))
    data = data.frame(value=lst$y[,1], name=lst$x[,1],
                       parent=if (ncol(lst$x)<2) NA else lst$x[,2])

    data$series = if (is.null(lst$series)) '' else lst$series[,1]
    nSeries = length(unique(data$series))
    if (nSeries > 4) warning('Too many series! The layout will be messy!')

    out = lapply(unique(data$series), function(series){
        idx = which(unique(data$series) == series)
        dt = data[data$series == series, c('name', 'value', 'parent')]
        iType = type[idx,]
        iSubtype = subtype[[idx]]
        orient = ifelse(grepl('horizontal', iType$misc), 'horizontal', 'vertical')
        inv = grepl('inv', iType$misc)
        center = list(paste0(5+90/nSeries*(idx-0.5), '%'), '50%')
        size = list(paste0((90-nSeries*5)/nSeries, '%'), '80%')
        lineType = ifelse('broken' %in% iSubtype, 'broken',
                           ifelse('dotted' %in% iSubtype, 'dotted',
                                  ifelse('solid' %in% iSubtype, 'solid',
                                         ifelse('dashed' %in% iSubtype,
                                                      'dashed', 'curve'))))

        o = list(type=iType$type, orient=orient, roam=TRUE,
                  direction=ifelse(inv, 'inverse', ''),
                  data=parseTreeNodes(dt)
        )
        if (series != '') o$name = as.character(series) else
            if (iType$type=='treemap') o$name = as.character(names(lst$x))[1]
        if (iType$type == 'tree'){
            o$nodePadding = 1
            o$rootLocation = list(
                x=ifelse(orient=='vertical',
                         paste0(10+80/nSeries*(idx-0.5), '%'),
                         ifelse(inv, paste0(10+80/nSeries*(idx), '%'),
                                paste0(10+80/nSeries*(idx-1), '%'))),
                y=ifelse(orient=='vertical', ifelse(inv, '90%', '10%'),
                         '50%'))
            o$itemStyle=list(normal=list(
                label=list(show=FALSE, formatter="{b}"),
                lineStyle=list(
                    color='#48b', shadowColor='#000', shadowBlur=3,
                    shadowOffsetX=2, shadowOffsetY=3, type=lineType)),
                emphasis=list(label=list(show=TRUE))
            )
        }else if (iType$type == 'treemap'){
            o$center = center
            o$size = size
            o$itemStyle=list(normal=list(
                label=list(show=TRUE, formatter="{b}")),
                emphasis=list(label=list(show=TRUE))
            )
        }
        return(o)
    })

    return(out[intersect(names(out), ifnull(return, names(out)))])
}

series_tree = series_treemap
# deleted

#' @importFrom data.table between
series_heatmap = function(
    lst, type, subtype, layout, meta, fullMeta, layouts, return=NULL,
...){
    # data = rbind(data.frame(lng=100+rnorm(100,0, 1)*600,
    #        lat=150+rnorm(100,0, 1)*50, y=abs(rnorm(100,0,1))),
    # data.frame(lng=rnorm(200,0, 1)*1000,
    #        lat=rnorm(200,0, 1)*800, y=abs(rnorm(200,0,1))),
    # data.frame(lng=400+rnorm(20,0, 1)*300,
    #        lat=5+rnorm(20,0, 1)*10, y=abs(rnorm(100,0,1))))
    # echart(data,lng=lng,lat=lat,y=y,type='heatmap')
    if (is.null(lst$lng) || is.null(lst$lat) || is.null(lst$y))
        stop("heatmap needs lng, lat and y!")
    if (!all(data.table::between(lst$y[,1], 0, 1)))
        lst$y[,1] = (max(lst$y[,1], na.rm=TRUE)-lst$y[,1]) /
            (max(lst$y[,1], na.rm=TRUE)-min(lst$y[,1], na.rm=TRUE))

    data = data.frame(y=lst$y[,1], lng=lst$lng[,1], lat=lst$lat[,1])
    o = list(list(type=type$type[1], minAlpha=0.2, opacity=0.6,
              gradientColors=c('blue', 'cyan', 'limegreen', 'yellow', 'red'),
              data=asEchartData(unname(data[,c('lng', 'lat', 'y')]))
    ))
    return(o[intersect(names(o), ifnull(return, names(o)))])
}