From a838bf791a04635c106d2f032fa76edbfd7de811 Mon Sep 17 00:00:00 2001 From: Liyun Chen Date: Wed, 29 Apr 2015 22:44:42 -0700 Subject: [PATCH 1/7] + echart_hist() to generate simple histograms. I need to deal with parameters in data_bar() because of this so there should be a better way to handle these parameters. Any idea? --- NAMESPACE | 1 + R/data.R | 21 +++++++++++++++++---- R/echart.R | 18 ++++++++++++++---- R/echart_hist.R | 22 ++++++++++++++++++++++ man/eChart.Rd | 5 ++++- man/echart_hist.Rd | 17 +++++++++++++++++ 6 files changed, 75 insertions(+), 9 deletions(-) create mode 100644 R/echart_hist.R create mode 100644 man/echart_hist.Rd diff --git a/NAMESPACE b/NAMESPACE index b361e19..910b1d4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,6 +9,7 @@ export(eChartOutput) export(eXAxis) export(eYAxis) export(echart) +export(echart_hist) export(renderEChart) importFrom(htmlwidgets,JS) importFrom(magrittr,"%>%") diff --git a/R/data.R b/R/data.R index 7634500..aca8f23 100644 --- a/R/data.R +++ b/R/data.R @@ -11,15 +11,28 @@ data_scatter = function(x, y, series = NULL) { obj } -data_bar = function(x, y, series = NULL) { +data_bar = function(x, y, series = NULL, + name = NULL, #the series name? + stack = NULL, + barGap = NULL, + barCategoryGap = NULL, + barMinHeight = NULL, + barWidth = NULL, + barMaxWidth = NULL + ) { ### if no series passed... go with only one series. if (is.null(series)) { warning("No series specified for bar plot.") - return(list(list(name = '', type = 'bar', data = y))) + series_data = list(name = '', type = 'bar', data = y) + if(!is.null(barCategoryGap)) series_data = c(series_data , barCategoryGap = barCategoryGap) + if(!is.null(barMinHeight)) series_data = c(series_data , barMinHeight = barMinHeight) + if(!is.null(barGap)) series_data = c(series_data , barGap = barGap) + if(!is.null(barWidth)) series_data = c(series_data , barWidth = barWidth) + if(!is.null(barMaxWidth)) series_data = c(series_data , barMaxWidth = barMaxWidth) + return(list(series_data)) } #otherwise, go with series. - xy = y ### why no names? - xy = split(as.data.frame(xy), series) + xy = split(as.data.frame(y), series) nms = names(xy) obj = list() for (i in seq_along(xy)) { diff --git a/R/echart.R b/R/echart.R index f2de72c..6cbb3d9 100644 --- a/R/echart.R +++ b/R/echart.R @@ -49,19 +49,28 @@ echart.data.frame = function( y = evalFormula(y, data) if (type == 'auto') type = determineType(x, y) - #for bar plot, convert x to factors + # for histogram, change it to bar plot with no space between bars + hist_indicator = 0 # need a tag here for histogram + if (type == 'hist') { + hist_indicator = 1 # use 1 for histograms + type = 'bar' + } + # for bar plot, convert x to factors if (type == 'bar' && !is.factor(x)) x = as.factor(x) if (type == 'bar' && !is.numeric(y)) stop("y must be numeric for bar plot.") series = evalFormula(series, data) data_fun = getFromNamespace(paste0('data_', type), 'recharts') - ###start axis from 0? + # start axis from 0? if (is.numeric(x)) min_xaxis = ifelse( min(x) >0, 0, min(x)) if (is.numeric(y)) min_yaxis = ifelse( min(y) >0, 0, min(y)) params = structure(list( - series = data_fun(x, y, series), + # any better way here? only pass a parameter if it exists + series = ifelse(hist_indicator ==1, + data_fun(x, y, series, barCategoryGap='0%'), + data_fun(x, y, series)), xAxis = list(), yAxis = list() ), meta = list( x = x, y = y @@ -95,7 +104,8 @@ eChart = echart determineType = function(x, y) { if (is.numeric(x) && is.numeric(y)) return('scatter') if (is.factor(x) && is.numeric(y)) return("bar") - if (is.numeric(x) && is.null(y)) return("histogram") + # use echart_hist() for histograms + # if (is.numeric(x) && is.null(y)) return("histogram") message('The structure of x:') str(x) message('The structure of y:') diff --git a/R/echart_hist.R b/R/echart_hist.R new file mode 100644 index 0000000..4876870 --- /dev/null +++ b/R/echart_hist.R @@ -0,0 +1,22 @@ +#' 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) + } + + echart(bar_hist, ~breaks, ~counts, type = "hist" ) +} diff --git a/man/eChart.Rd b/man/eChart.Rd index 473c615..e060aa0 100644 --- a/man/eChart.Rd +++ b/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") } diff --git a/man/echart_hist.Rd b/man/echart_hist.Rd new file mode 100644 index 0000000..c7e4ab7 --- /dev/null +++ b/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)) +} From 21e97e21cece1099164de51398a02dce842a830c Mon Sep 17 00:00:00 2001 From: Liyun Chen Date: Wed, 29 Apr 2015 22:49:31 -0700 Subject: [PATCH 2/7] +readme --- README.md | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/README.md b/README.md index dfbf8d5..bee6ee9 100644 --- a/README.md +++ b/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: From abe46ec1ae43e46d97e8c99a9b214568c8d75849 Mon Sep 17 00:00:00 2001 From: Liyun Chen Date: Wed, 29 Apr 2015 23:20:04 -0700 Subject: [PATCH 3/7] +merge --- NAMESPACE | 1 + R/data.R | 26 ++++++++++++++++++++++++++ R/echart.R | 31 ++++++++++++++++++++++++++++++- R/echart_hist.R | 22 ++++++++++++++++++++++ man/eChart.Rd | 5 ++++- man/echart_hist.Rd | 17 +++++++++++++++++ 6 files changed, 100 insertions(+), 2 deletions(-) create mode 100644 R/echart_hist.R create mode 100644 man/echart_hist.Rd diff --git a/NAMESPACE b/NAMESPACE index b361e19..910b1d4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,6 +9,7 @@ export(eChartOutput) export(eXAxis) export(eYAxis) export(echart) +export(echart_hist) export(renderEChart) importFrom(htmlwidgets,JS) importFrom(magrittr,"%>%") diff --git a/R/data.R b/R/data.R index 5412e25..4b7f57c 100644 --- a/R/data.R +++ b/R/data.R @@ -11,6 +11,7 @@ data_scatter = function(x, y, series = NULL, type = 'scatter') { obj } +<<<<<<< HEAD data_bar = function(x, y, series = NULL, type = 'bar') { # plot the frequencies of x when y is not provided @@ -41,6 +42,31 @@ data_bar = function(x, y, series = NULL, type = 'bar') { stop('y must only have one value corresponding to each combination of x and series') }) nms = colnames(xy) +======= +data_bar = function(x, y, series = NULL, + name = NULL, #the series name? + stack = NULL, + barGap = NULL, + barCategoryGap = NULL, + barMinHeight = NULL, + barWidth = NULL, + barMaxWidth = NULL + ) { + ### if no series passed... go with only one series. + if (is.null(series)) { + warning("No series specified for bar plot.") + series_data = list(name = '', type = 'bar', data = y) + if(!is.null(barCategoryGap)) series_data = c(series_data , barCategoryGap = barCategoryGap) + if(!is.null(barMinHeight)) series_data = c(series_data , barMinHeight = barMinHeight) + if(!is.null(barGap)) series_data = c(series_data , barGap = barGap) + if(!is.null(barWidth)) series_data = c(series_data , barWidth = barWidth) + if(!is.null(barMaxWidth)) series_data = c(series_data , barMaxWidth = barMaxWidth) + return(list(series_data)) + } + #otherwise, go with series. + xy = split(as.data.frame(y), series) + nms = names(xy) +>>>>>>> + echart_hist() to generate simple histograms. I need to deal with parameters in data_bar() because of this so there should be a better way to handle these parameters. Any idea? obj = list() for (i in seq_len(ncol(xy))) { obj[[i]] = list(name = nms[i], type = type, data = unname(xy[, i])) diff --git a/R/echart.R b/R/echart.R index 1a713ed..1507a34 100644 --- a/R/echart.R +++ b/R/echart.R @@ -48,16 +48,39 @@ echart.data.frame = function( x = evalFormula(x, data) y = evalFormula(y, data) if (type == 'auto') type = determineType(x, y) +<<<<<<< HEAD if (type == 'bar') { x = as.factor(x) if (is.null(y)) ylab = 'Frequency' } +======= + + # for histogram, change it to bar plot with no space between bars + hist_indicator = 0 # need a tag here for histogram + if (type == 'hist') { + hist_indicator = 1 # use 1 for histograms + type = 'bar' + } + # for bar plot, convert x to factors + if (type == 'bar' && !is.factor(x)) x = as.factor(x) + if (type == 'bar' && !is.numeric(y)) stop("y must be numeric for bar plot.") +>>>>>>> + echart_hist() to generate simple histograms. I need to deal with parameters in data_bar() because of this so there should be a better way to handle these parameters. Any idea? series = evalFormula(series, data) data_fun = getFromNamespace(paste0('data_', type), 'recharts') +<<<<<<< HEAD +======= + # start axis from 0? + if (is.numeric(x)) min_xaxis = ifelse( min(x) >0, 0, min(x)) + if (is.numeric(y)) min_yaxis = ifelse( min(y) >0, 0, min(y)) + +>>>>>>> + echart_hist() to generate simple histograms. I need to deal with parameters in data_bar() because of this so there should be a better way to handle these parameters. Any idea? params = structure(list( - series = data_fun(x, y, series), + # any better way here? only pass a parameter if it exists + series = ifelse(hist_indicator ==1, + data_fun(x, y, series, barCategoryGap='0%'), + data_fun(x, y, series)), xAxis = list(), yAxis = list() ), meta = list( x = x, y = y @@ -87,6 +110,7 @@ eChart = echart determineType = function(x, y) { if (is.numeric(x) && is.numeric(y)) return('scatter') +<<<<<<< HEAD # when y is numeric, plot y against x; when y is NULL, treat x as a # categorical variable, and plot its frequencies if ((is.factor(x) || is.character(x)) && (is.numeric(y) || is.null(y))) @@ -94,6 +118,11 @@ determineType = function(x, y) { # 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') +======= + if (is.factor(x) && is.numeric(y)) return("bar") + # use echart_hist() for histograms + # if (is.numeric(x) && is.null(y)) return("histogram") +>>>>>>> + echart_hist() to generate simple histograms. I need to deal with parameters in data_bar() because of this so there should be a better way to handle these parameters. Any idea? message('The structure of x:') str(x) message('The structure of y:') diff --git a/R/echart_hist.R b/R/echart_hist.R new file mode 100644 index 0000000..4876870 --- /dev/null +++ b/R/echart_hist.R @@ -0,0 +1,22 @@ +#' 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) + } + + echart(bar_hist, ~breaks, ~counts, type = "hist" ) +} diff --git a/man/eChart.Rd b/man/eChart.Rd index 473c615..e060aa0 100644 --- a/man/eChart.Rd +++ b/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") } diff --git a/man/echart_hist.Rd b/man/echart_hist.Rd new file mode 100644 index 0000000..c7e4ab7 --- /dev/null +++ b/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)) +} From 3436fbff6577a3d55dc45c169c7463944fce08f4 Mon Sep 17 00:00:00 2001 From: Liyun Chen Date: Wed, 29 Apr 2015 23:22:49 -0700 Subject: [PATCH 4/7] merge --- R/data.R | 30 ------------------------------ R/echart.R | 43 +------------------------------------------ 2 files changed, 1 insertion(+), 72 deletions(-) diff --git a/R/data.R b/R/data.R index b0b21e4..5412e25 100644 --- a/R/data.R +++ b/R/data.R @@ -11,7 +11,6 @@ data_scatter = function(x, y, series = NULL, type = 'scatter') { obj } -<<<<<<< HEAD data_bar = function(x, y, series = NULL, type = 'bar') { # plot the frequencies of x when y is not provided @@ -42,35 +41,6 @@ data_bar = function(x, y, series = NULL, type = 'bar') { stop('y must only have one value corresponding to each combination of x and series') }) nms = colnames(xy) -======= -data_bar = function(x, y, series = NULL, - name = NULL, #the series name? - stack = NULL, - barGap = NULL, - barCategoryGap = NULL, - barMinHeight = NULL, - barWidth = NULL, - barMaxWidth = NULL - ) { - ### if no series passed... go with only one series. - if (is.null(series)) { - warning("No series specified for bar plot.") - series_data = list(name = '', type = 'bar', data = y) - if(!is.null(barCategoryGap)) series_data = c(series_data , barCategoryGap = barCategoryGap) - if(!is.null(barMinHeight)) series_data = c(series_data , barMinHeight = barMinHeight) - if(!is.null(barGap)) series_data = c(series_data , barGap = barGap) - if(!is.null(barWidth)) series_data = c(series_data , barWidth = barWidth) - if(!is.null(barMaxWidth)) series_data = c(series_data , barMaxWidth = barMaxWidth) - return(list(series_data)) - } - #otherwise, go with series. - xy = split(as.data.frame(y), series) - nms = names(xy) -<<<<<<< HEAD ->>>>>>> + echart_hist() to generate simple histograms. I need to deal with parameters in data_bar() because of this so there should be a better way to handle these parameters. Any idea? -======= ->>>>>>> 21e97e21cece1099164de51398a02dce842a830c ->>>>>>> 5fbbb818e3e6798c0e6df841844478ceb4438484 obj = list() for (i in seq_len(ncol(xy))) { obj[[i]] = list(name = nms[i], type = type, data = unname(xy[, i])) diff --git a/R/echart.R b/R/echart.R index 730878e..1a713ed 100644 --- a/R/echart.R +++ b/R/echart.R @@ -48,47 +48,16 @@ echart.data.frame = function( x = evalFormula(x, data) y = evalFormula(y, data) if (type == 'auto') type = determineType(x, y) -<<<<<<< HEAD if (type == 'bar') { x = as.factor(x) if (is.null(y)) ylab = 'Frequency' } -======= - - # for histogram, change it to bar plot with no space between bars - hist_indicator = 0 # need a tag here for histogram - if (type == 'hist') { - hist_indicator = 1 # use 1 for histograms - type = 'bar' - } - # for bar plot, convert x to factors - if (type == 'bar' && !is.factor(x)) x = as.factor(x) - if (type == 'bar' && !is.numeric(y)) stop("y must be numeric for bar plot.") -<<<<<<< HEAD ->>>>>>> + echart_hist() to generate simple histograms. I need to deal with parameters in data_bar() because of this so there should be a better way to handle these parameters. Any idea? -======= ->>>>>>> 21e97e21cece1099164de51398a02dce842a830c ->>>>>>> 5fbbb818e3e6798c0e6df841844478ceb4438484 series = evalFormula(series, data) data_fun = getFromNamespace(paste0('data_', type), 'recharts') -<<<<<<< HEAD -======= - # start axis from 0? - if (is.numeric(x)) min_xaxis = ifelse( min(x) >0, 0, min(x)) - if (is.numeric(y)) min_yaxis = ifelse( min(y) >0, 0, min(y)) - -<<<<<<< HEAD ->>>>>>> + echart_hist() to generate simple histograms. I need to deal with parameters in data_bar() because of this so there should be a better way to handle these parameters. Any idea? -======= ->>>>>>> 21e97e21cece1099164de51398a02dce842a830c ->>>>>>> 5fbbb818e3e6798c0e6df841844478ceb4438484 params = structure(list( - # any better way here? only pass a parameter if it exists - series = ifelse(hist_indicator ==1, - data_fun(x, y, series, barCategoryGap='0%'), - data_fun(x, y, series)), + series = data_fun(x, y, series), xAxis = list(), yAxis = list() ), meta = list( x = x, y = y @@ -118,7 +87,6 @@ eChart = echart determineType = function(x, y) { if (is.numeric(x) && is.numeric(y)) return('scatter') -<<<<<<< HEAD # when y is numeric, plot y against x; when y is NULL, treat x as a # categorical variable, and plot its frequencies if ((is.factor(x) || is.character(x)) && (is.numeric(y) || is.null(y))) @@ -126,15 +94,6 @@ determineType = function(x, y) { # 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') -======= - if (is.factor(x) && is.numeric(y)) return("bar") - # use echart_hist() for histograms - # if (is.numeric(x) && is.null(y)) return("histogram") -<<<<<<< HEAD ->>>>>>> + echart_hist() to generate simple histograms. I need to deal with parameters in data_bar() because of this so there should be a better way to handle these parameters. Any idea? -======= ->>>>>>> 21e97e21cece1099164de51398a02dce842a830c ->>>>>>> 5fbbb818e3e6798c0e6df841844478ceb4438484 message('The structure of x:') str(x) message('The structure of y:') From 6452641365c26733a2850286838ac382743f4f8a Mon Sep 17 00:00:00 2001 From: Liyun Chen Date: Thu, 30 Apr 2015 00:24:26 -0700 Subject: [PATCH 5/7] a much better way to pass the parameters. --- R/echart.R | 8 +++++++- R/echart_hist.R | 2 +- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/R/echart.R b/R/echart.R index 1a713ed..e135598 100644 --- a/R/echart.R +++ b/R/echart.R @@ -67,6 +67,11 @@ echart.data.frame = function( params$legend = list(data = levels(as.factor(series))) } + if("barCategoryGap" %in% names(list(...))){ + for (i in 1:length(params$series)) + {params$series[[i]]$barCategoryGap = list(...)$barCategoryGap} + } + chart = htmlwidgets::createWidget( 'echarts', params, width = width, height = height, package = 'recharts', dependencies = getDependency(NULL) @@ -93,7 +98,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:') diff --git a/R/echart_hist.R b/R/echart_hist.R index 4876870..4a2c2f8 100644 --- a/R/echart_hist.R +++ b/R/echart_hist.R @@ -18,5 +18,5 @@ echart_hist = function(data, binwidth = NULL){ bar_hist = hist(data, plot = FALSE , binwidth = binwidth) } - echart(bar_hist, ~breaks, ~counts, type = "hist" ) + echart(bar_hist, ~breaks, ~counts, type ="bar", barCategoryGap='0%') } From 71352895657a60f3619c24d5f75ca352b5791d8d Mon Sep 17 00:00:00 2001 From: Liyun Chen Date: Thu, 30 Apr 2015 23:22:27 -0700 Subject: [PATCH 6/7] 1. use mids not breaks in echart_hist() 2. simple functions for add line and points to plot. Not tested yet. 3. start to wrap an eSeries function to add Series attributes. --- R/add_line.R | 61 +++++++++++++++++++++++++++++++++++++++++++++++++ R/add_point.R | 18 +++++++++++++++ R/echart.R | 4 ---- R/echart_hist.R | 4 +++- R/options.R | 6 +++++ 5 files changed, 88 insertions(+), 5 deletions(-) create mode 100644 R/add_line.R create mode 100644 R/add_point.R diff --git a/R/add_line.R b/R/add_line.R new file mode 100644 index 0000000..2bf3c1a --- /dev/null +++ b/R/add_line.R @@ -0,0 +1,61 @@ +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) +} + diff --git a/R/add_point.R b/R/add_point.R new file mode 100644 index 0000000..fb50f74 --- /dev/null +++ b/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.") + } +} + diff --git a/R/echart.R b/R/echart.R index e135598..0585e4e 100644 --- a/R/echart.R +++ b/R/echart.R @@ -67,10 +67,6 @@ echart.data.frame = function( params$legend = list(data = levels(as.factor(series))) } - if("barCategoryGap" %in% names(list(...))){ - for (i in 1:length(params$series)) - {params$series[[i]]$barCategoryGap = list(...)$barCategoryGap} - } chart = htmlwidgets::createWidget( 'echarts', params, width = width, height = height, package = 'recharts', diff --git a/R/echart_hist.R b/R/echart_hist.R index 4a2c2f8..eb6da9a 100644 --- a/R/echart_hist.R +++ b/R/echart_hist.R @@ -17,6 +17,8 @@ echart_hist = function(data, binwidth = NULL){ } else{ bar_hist = hist(data, plot = FALSE , binwidth = binwidth) } + # adjust the breaks + # bar_hist$x = round(bar_hist$mids,2) - echart(bar_hist, ~breaks, ~counts, type ="bar", barCategoryGap='0%') + echart(bar_hist, ~mids, ~counts, type ="bar", barCategoryGap='0%') } diff --git a/R/options.R b/R/options.R index e090f71..dbe0a36 100644 --- a/R/options.R +++ b/R/options.R @@ -67,3 +67,9 @@ axisType = function(data, which = c('x', 'y')) { str(data) stop('Unable to derive the axis type automatically from the ', which, ' variable') } + +eSeries = function (chart,barCategoryGap, ...){ + # basically we need to add barCategoryGap to series + params$series[[i]]$barCategoryGap = list(...)$barCategoryGap + +} From 6f1481142efdbdef30374b124ab82ad030e236bd Mon Sep 17 00:00:00 2001 From: Liyun Chen Date: Sun, 3 May 2015 22:59:41 -0700 Subject: [PATCH 7/7] + eSeries() function + add line and add points --- R/add_line.R | 5 +++ R/echart_hist.R | 2 +- R/options.R | 114 ++++++++++++++++++++++++++++++++++++++++++++++-- 3 files changed, 117 insertions(+), 4 deletions(-) diff --git a/R/add_line.R b/R/add_line.R index 2bf3c1a..424144a 100644 --- a/R/add_line.R +++ b/R/add_line.R @@ -5,6 +5,7 @@ echart_stat_line = function ( stat, name = NULL){ 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) @@ -59,3 +60,7 @@ echart_vline = function (xintercept, name = NULL){ 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.") +} diff --git a/R/echart_hist.R b/R/echart_hist.R index eb6da9a..b242f93 100644 --- a/R/echart_hist.R +++ b/R/echart_hist.R @@ -20,5 +20,5 @@ echart_hist = function(data, binwidth = NULL){ # adjust the breaks # bar_hist$x = round(bar_hist$mids,2) - echart(bar_hist, ~mids, ~counts, type ="bar", barCategoryGap='0%') + echart(bar_hist, ~mids, ~counts, type ="bar") %>% eSeries ( barCategoryGap = 0) } diff --git a/R/options.R b/R/options.R index dbe0a36..30b6311 100644 --- a/R/options.R +++ b/R/options.R @@ -68,8 +68,116 @@ axisType = function(data, which = c('x', 'y')) { stop('Unable to derive the axis type automatically from the ', which, ' variable') } -eSeries = function (chart,barCategoryGap, ...){ - # basically we need to add barCategoryGap to series - params$series[[i]]$barCategoryGap = list(...)$barCategoryGap +#' 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) }