eSeries ()

NAMESPACE

@@ -9,6 +9,7 @@ export(eChartOutput)
 export(eXAxis)
 export(eYAxis)
 export(echart)
+export(echart_hist)
 export(renderEChart)
 importFrom(htmlwidgets,JS)
 importFrom(magrittr,"%>%")

R/add_line.R

@@ -0,0 +1,66 @@
+echart_stat_line = function ( stat, name = NULL){
+  # stat is the statisitic of such hline,
+  check_stat(stat)
+  if (length(stat) > 1) stop("Only one stat each time.")
+  list(markLine= list(data = list(type = stat, name = name )))
+}
+
+
+# a more general function to add any line
+echart_abline_point = function ( start, end, name = NULL){
+  # start is a vector with two values (x,y)
+  # end is a vector with two values (x,y)
+  if (!is.numeric(start) | !is.numeric(end)) stop("start and end should be numeric vectors.")
+  if (length(start)!=2 | length(end) != 2) stop("start and end should be a vector of two numeric values.")
+  if (Inf %in% c(start, end)) {
+    warning("Cannot draw infinitie line.") # check if echart can handle Inf; if not, replace Inf
+
+    }
+  list(markLine =
+         list(data =
+                c(list( name = 'line start', value = 1, x = start[1], y = start[2]),
+                               list( name = 'line end',  x = end[1], y = end[2]))
+                      ))
+
+}
+
+# wrap of abline(); add line by intercept and slope
+echart_abline = function ( intercept, slope, name = NULL,
+                                 # put some defaults here, could be extended
+                                 xmin = -100,
+                                 xmax = 100,
+                                 ymin = -100,
+                                 ymax = 100){
+  # start is a vector with two values (x,y)
+  # end is a vector with two values (x,y)
+  y_min_actual = xmin * slope + intercept
+  y_max_actual = xmax * slope + intercept
+
+  start = c(xmin, y_min_actual)
+  end = c(xmax, y_max_actual)
+
+  # ignore ymin and ymax for now
+  echart_abline_point(start, end, name = name)
+}
+
+# wrap function for horizontal line
+echart_hline = function (yintercept, name = NULL){
+  if (!is.numeric(y)) stop("yintercept must be numeric.")
+  if (length(yintercept)>1) stop("only one line each time.")
+  echart_abline(intercept = yintercept, slope = 0)
+}
+
+# wrap function for vertical line
+
+echart_vline = function (xintercept, name = NULL){
+  if (!is.numeric(y)) stop("yintercept must be numeric.")
+  if (length(xintercept)>1) stop ("one line each time.")
+  start = c(xintercept, -Inf)
+  end = c(xintercept, Inf)
+  echart_abline_point(start, end, name = name)
+}
+
+#choose statistic
+check_stat = function (stat) {
+  if(!stat %in% c( "max", "min", "average")) stop("Statistic line should be either max, min or average.")
+}

R/add_point.R

@@ -0,0 +1,18 @@
+# function to add points on plot
+echart_point = function (x, y, name = NULL, value = NULL){
+  if (!is.numeric(x) | !is.numeric(y)) { stop("x and y should be numeric.")}
+  list(markPoint = list(data = list(name = name, value =  value, x = x, y = y)))
+}
+
+# add statistic point directly
+echart_stat_point = function (stat, name = NULL, value = NULL){
+  check_stat(stat)
+  list(markPoint = list(data = list(name = name, type = stat)))
+}
+
+check_stat = function (stat){
+  if (!stat %in% c("min","max","average")){
+    stop("stat should be either min, max or avergae.")
+  }
+}
+

R/echart.R

@@ -67,6 +67,7 @@ echart.data.frame = function(
     params$legend = list(data = levels(as.factor(series)))
   }
 
+
   chart = htmlwidgets::createWidget(
     'echarts', params, width = width, height = height, package = 'recharts',
     dependencies = getDependency(NULL)
@@ -93,7 +94,8 @@ determineType = function(x, y) {
     return('bar')
   # FIXME: 'histogram' is not a standard plot type of ECharts
   # http://echarts.baidu.com/doc/doc.html
-  if (is.numeric(x) && is.null(y)) return('histogram')
+  # wrap the echart_hist() function
+  # if (is.numeric(x) && is.null(y)) return('histogram')
   message('The structure of x:')
   str(x)
   message('The structure of y:')

R/echart_hist.R

@@ -0,0 +1,24 @@
+#' Create an histogram
+#'
+#' @param a numeric vector
+#' @rdname echart_hist
+#' @export
+#' @examples library(recharts)
+#' echart_hist(rnorm(100))
+
+#' @export
+#' @rdname echart_hist
+echart_hist = function(data, binwidth = NULL){
+  if (!is.vector(data)) stop("Histogram only takes vectors.")
+  if (!is.numeric(data)) stop ("Histogram needs a numeric vector.")
+  if(is.null(binwidth)) {
+    warning("Bin width is not specified. Default is Sturges's formula.")
+    bar_hist = hist(data, plot = FALSE )
+  } else{
+    bar_hist = hist(data, plot = FALSE , binwidth = binwidth)
+  }
+  # adjust the breaks
+  # bar_hist$x = round(bar_hist$mids,2)
+
+  echart(bar_hist, ~mids, ~counts,  type ="bar") %>% eSeries ( barCategoryGap = 0)
+}

R/options.R

@@ -67,3 +67,117 @@ axisType = function(data, which = c('x', 'y')) {
   str(data)
   stop('Unable to derive the axis type automatically from the ', which, ' variable')
 }
+
+#' Modify series properties
+#'
+#' Modify series properties
+#'
+#' @export
+
+eSeries = function (chart,
+                    which = 'all' , # wich should be series name or index? go with index now
+                    stack = NULL, # binary T or F
+                    barGap = NULL, # a number between 0 and 1
+                    barCategoryGap = NULL, # a number between 0 and 1
+                    barMinHeight = NULL,  #  a number >= 0
+                    barWidth = NULL, # a number >= 0
+                    barMaxWidth = NULL, # a number >= 0
+                    symbol = NULL, # choose from 'circle' | 'rectangle' | 'triangle' | 'diamond' | 'emptyCircle' | 'emptyRectangle' | 'emptyTriangle' | 'emptyDiamond'| heart' | 'droplet' | 'pin' | 'arrow' | 'star'
+                    symbolSize = NULL, # a number >= 0
+                    showAllSymbol = NULL, # T or F
+                    symbolRotate = NULL, # between -180 and 180
+                    smooth = NULL,  # T or F
+                    dataFilter = NULL,
+                    large = NULL,  # T or F, use large scatter plot?
+                    largeThreshold = NULL, # a number > 0 for large scatter plot
+                    legendHoverLink= NULL, # highlight when hover on legend? T or F
+                    ...){
+  # change all series
+  if (which == "all") series = chart$x$series else series = chart$x$series[which]
+
+    # usage of stack: echart allows to stack any bar but here we stack for now.
+    if (isTRUE(stack)) {
+      series = lapply(list(series), function(x) {
+       mergeList(x, eSeries_add_parameter(name = "stack", value = "grand total"))
+      })
+    }
+    if (!is.null(barGap)) series = lapply(series, function(x) {
+      mergeList(x, eSeries_add_parameter(name = "barGap", value = percent_scale(barGap)))
+    })
+    if (!is.null(barCategoryGap)) series = lapply(series, function(x) {
+      mergeList(x, eSeries_add_parameter(name = "barCategoryGap", value = percent_scale(barCategoryGap)))
+
+    })
+    if (!is.null(barMinHeight) && barMinHeight >= 0) series = lapply(series, function(x) {
+      mergeList(x, eSeries_add_parameter(name = "barMinHeight", value = barMinHeight))
+    })
+    if (!is.null(barWidth)  && barWidth >= 0) series = lapply(series, function(x) {
+      mergeList(x, eSeries_add_parameter(name = "barWidth", value = barWidth))
+    })
+    if (!is.null(barMaxWidth)  && barMaxWidth >= 0) series = lapply(series, function(x) {
+      mergeList(x, eSeries_add_parameter(name = "barMaxWidth", value = barMaxWidth))
+    })
+    # symbol also supports pictures? ignore for now.
+    if (!is.null(symbol)  &&
+        symbol %in% c('circle' , 'rectangle' , 'triangle' , 'diamond' , 'emptyCircle' ,
+                      'emptyRectangle' , 'emptyTriangle' , 'emptyDiamond', 'heart' ,
+                      'droplet' , 'pin' , 'arrow' , 'star')) series = lapply(series, function(x) {
+      mergeList(x, eSeries_add_parameter(name = "symbol", value = symbol))
+    })
+    # also handle symbolsize for bubble plots?
+    if (!is.null(symbolSize)  && symbolSize >= 0) series = lapply(series, function(x) {
+      mergeList(x, eSeries_add_parameter(name = "symbolSize", value = symbolSize))
+    })
+    if (!is.null(symbolRotate)  && symbolRotate <= 180  && symbolRotate >= -180) series = lapply(series, function(x) {
+      mergeList(x, eSeries_add_parameter(name = "symbolRotate", value = symbolRotate))
+    })
+    if (isTRUE(showAllSymbol)) series = lapply(series, function(x) {
+      mergeList(x, eSeries_add_parameter(name = "showAllSymbol", value = showAllSymbol))
+    })
+    if (isTRUE(smooth)) series = lapply(series, function(x) {
+      mergeList(x, eSeries_add_parameter(name = "smooth", value = smooth))
+    })
+    if (isTRUE(large)) series = lapply(series, function(x) {
+      mergeList(x, eSeries_add_parameter(name = "large", value = large))
+    })
+    if (!is.null(largeThreshold) && largeThreshold >= 0 ) series = lapply(series, function(x) {
+      mergeList(x, eSeries_add_parameter(name = "largeThreshold", value = largeThreshold))
+    })
+    if (isTRUE(legendHoverLink)) series = lapply(series, function(x) {
+      mergeList(x, eSeries_add_parameter(name = "legendHoverLink", value = legendHoverLink))
+    })
+
+  if (which == "all") chart$x$series = series  else chart$x$series[which] = series
+
+  return(chart)
+}
+
+eSeries_add_parameter = function (name, value){
+  temp = list(name = value)
+  names(temp) = name
+  return(temp)
+}
+
+percent_scale = function(number){
+  if(! (number >=0 & number <=1)) stop("Number should be between 0 and 1.")
+  paste0(number * 100, "%")
+}
+
+#' Add lines to graph
+#'
+#' Add lines to graph
+#'
+#' @export
+eSeries_addline = function (chart, which = "all",
+                            line_stat = NULL, # add a statistical line, choose from min, max, average
+                            ...){
+
+  if (which == "all") series = chart$x$series else series = chart$x$series[which]
+  if (!is.null(line_stat)) series = lapply(series, function(x) {
+    mergeList(x, echart_stat_line(stat = line_stat, name = line_stat))
+  })
+
+  if (which == "all") chart$x$series = series  else chart$x$series[which] = series
+
+  return(chart)
+}

README.md

@@ -17,6 +17,17 @@ Some "hello world" examples:
 library(recharts)
 echart(iris, ~Sepal.Length, ~Sepal.Width)
 echart(iris, ~Sepal.Length, ~Sepal.Width, series = ~Species)
+# bar chart
+bar_df = data.frame(
+  date = rep(paste("day",1:10), 2),
+  temperature = floor(rnorm(n = 20, mean = 20, sd = 10)),
+  location = rep(c("NY","DC"), each = 10)
+ )
+echart(bar_df, ~date, ~temperature, ~location)
+# line chart
+echart(bar_df, ~date, ~temperature, ~location, type="line")
+# histogram
+echart_hist(rnorm(1000))
 ```
 
 See the package vignette for more information if you want to contribute:

man/eChart.Rd

@@ -36,9 +36,12 @@ library(recharts)
 ### scatter plot
 echart(iris, ~Sepal.Length, ~Sepal.Width)
 echart(iris, ~Sepal.Length, ~Sepal.Width, series = ~Species)
-### bar chart
 
+# bar chart
 bar_df = data.frame(date = rep(paste("day", 1:10), 2), temperature = floor(rnorm(n = 20, 
     mean = 20, sd = 10)), location = rep(c("NY", "DC"), each = 10))
 echart(bar_df, ~date, ~temperature, ~location)
+
+# line chart
+echart(bar_df, ~date, ~temperature, ~location, type = "line")
 }

man/echart_hist.Rd

@@ -0,0 +1,17 @@
+% Please edit documentation in R/echart_hist.R
+\name{echart_hist}
+\alias{echart_hist}
+\title{Create an histogram}
+\usage{
+echart_hist(data, binwidth = NULL)
+}
+\arguments{
+\item{a}{numeric vector}
+}
+\description{
+Create an histogram
+}
+\examples{
+library(recharts)
+echart_hist(rnorm(100))
+}