setClassUnion(name = "characterOrFactor", members = c("character", "factor"))
#' @title Plot serial data
#'
#' @description amPlot computes a plot of the given data values (can be a vector, dataframe or formula).
#'
#' @param x the coordinates of points in the plot : \code{numeric},
#' \code{data.frame}, or \code{formula}.
#' @param y \code{numeric}, the y coordinates of points in the plot,
#' optional if x is an appropriate structure.
#' @param xlab \code{character}, label for x-axis.
#' @param ylab \code{character}, label for y-axis.
#' @param bullet \code{character}, point shape. Possible values are : "diamond", "square",
#' "bubble", "yError", "xError", "round", "triangleLeft", "triangleRight", "triangleUp",
#' "triangleDown". Default set to "round".
#' @param type \code{character}, type of plot. Possible values are : "l" for a line, "sl"
#' for a smoothed line, "st" for step, "p" for points, and "b" for line and points.
#' Default set to "p".
#' @param col either a \code{factor} or a \code{character}, default set to "gray".
#' @param fill_alphas a \code{numeric} between 0 and 1 for printed area.
#' @param weights \code{numeric}, weights for x/y charts only. Small values are prefered for lisibility.
#' @param id \code{numeric}, point id, for x/y charts only. Default 1:length(x).
#' @param precision \code{numeric}, precision you wish to display. Default set to 2.
#' @param title \code{character}, name of the new serie, used when legend is enabled.
#' @param dataDateFormat \code{character}, default set to NULL. Even if your chart parses dates,
#' you can pass them as strings in your dataframe -
#' all you need to do is to set data date format and the chart will parse dates to date objects.
#' Check this page for available formats.
#' Please note that two-digit years (YY) as well as literal month names (MMM) are NOT supported in this setting.
#' @param parseDates \code{logical}, default set to FALSE, if TRUE argument
#' \code{dataDateFormat} has to be provided.
#' @param error \code{numeric}, only when type is "xError" "yError" default NULL,
#' @param xlim \code{numeric}, x range.
#' @param ylim \code{numeric}, y range.
#' @param cex \code{numeric}, bullet size.
#' @param lty \code{numeric}, line type (dashes).
#' @param lwd \code{numeric}, line width
#' @param ... see \code{\link{amOptions}} for more options.
#'
#' @return Return an Amchart.
#'
#' @examples
#'
#' \dontrun{
#' # 'numeric':
#' amPlot(x = rnorm(100))
#'
#' # add line
#' chart <- amPlot(x = rnorm(100), type = 'sl', legend = T)
#' amLines(chart, x = rnorm(100), type = "p")
#'
#' # 'character':
#' start <- as.POSIXct('2015-01-01')
#' end <- as.POSIXct('2015-12-31')
#' date <- seq.POSIXt(from = start, to = end, by = 'day')
#' date <- format(date)
#'
#' y <- rnorm(length(date))
#' amPlot(x = date, y = y, type = 'l', parseDates = TRUE, dataDateFormat = "YYYY-DD-MM")
#' # notice that by default 'parseDates = FALSE'
#'
#' # 'data.frame'
#' amPlot(iris, col = colnames(iris)[1:2], type = c("l", "st"), zoom = TRUE, legend = TRUE)
#'
#' # 'formula':
#' amPlot(Petal.Length + Sepal.Length ~ Sepal.Width, data = iris, legend = TRUE, zoom = TRUE)
#' }
#'
#' @import data.table
#' @rdname amPlot
#'
#'
#' @seealso \link{amOptions}, \link{amBarplot}, \link{amBoxplot}, \link{amHist}, \link{amPie},
#' \link{amPlot}, \link{amTimeSeries}, \link{amStockMultiSet}, \link{amBullet}, \link{amRadar},
#' \link{amWind}, \link{amFunnel}, \link{amAngularGauge}, \link{amSolidGauge}, \link{amMekko},
#' \link{amCandlestick}, \link{amFloatingBar}, \link{amOHLC}, \link{amWaterfall}
#'
#' @export
#'
#' @references See online documentation \url{https://datastorm-open.github.io/introduction_ramcharts/}
#' and \link{amChartsAPI}
#'
amPlot <- function(x, ...) UseMethod("amPlot")
#' @rdname amPlot
#' @export
#'
amPlot.default <- function(x, ...) "Wrong class"
#' @rdname amPlot
#'
#' @examples
#' \dontrun{
#' # Other examples available which can be time consuming depending on your configuration.
#' library(data.table)
#'
#' iris <- as.data.table(get("iris", "package:datasets"))
#' x <- rnorm(100)
#'
#' # Simple scatter plot with title and color
#' # Also change type (set to "p" by default), avalaible "l", "sl", "st", "p", "b"
#' amPlot(x = x, main = "Title", col = "lightblue", type = "b")
#'
#' x <- sort(rnorm(100))
#' y <- runif(100)
#' weights <- runif(100, 0, 15)
#' amPlot(x = x, y = y, weights = weights)
#' }
#' @import data.table
#' @import pipeR
#' @export
#'
amPlot.numeric <- function(x, y,
bullet = c("round","diamond", "square",
"bubble", "yError", "xError",
"triangleLeft", "triangleRight",
"triangleUp", "triangleDown"),
type = c("points", "line", "smoothedLine", "step", "both"),
col = "#0066cc", fill_alphas = 0,
weights = NULL, precision = 2, title = NULL, id, error, xlab, ylab,
lty, cex, lwd, xlim, ylim, ...)
{
# check arguments validity
# ---
bullet <- match.arg(bullet)
if (missing(lty)) lty <- 0
if (missing(lwd)) lwd <- 1
col <- as.factor(col)
# check the color
if (length(col) == 1) {
col <- rep(col, times = length(x))
} else {
.testLength(col, length(x))
levels(col) <- grDevices::topo.colors(nlevels(col))
levels(col) <- substr(levels(col), 1, 7)
}
# check (and convert) the type
if (length(type) == 1L && type == "sl") # exception to remove for the next submission
type <- "smoothedLine"
else
type <- match.arg(type)
if (missing(y)) { # the user plot a simple line or point chart
# define the dataProvider
if (type == "points" && bullet %in% c("xError", "yError")) {
if (missing(error)) error <- rep(1, length(x))
.testNumeric(error)
.testLength(error, length(x))
dt <- data.table(x = x, cat = paste("obs.", 1:length(x)), error = error)
} else {
dt <- data.table(x = x, cat = paste("obs.", 1:length(x)))
}
dt <- cbind(dt, col = col)
# define width of bullet
if (missing(cex)) cex <- 1
if(is.null(title)){
title = deparse(substitute(x))
}
# define the graph object depending on the type
graph_obj <- getGraph(type = type, col = col, fill_alphas = fill_alphas,
bullet = bullet,
title = title,
cex = cex, lwd = lwd, lty = lty)
# define axes label
if (missing(xlab)) xlab <- "index"
if (missing(ylab)) ylab <- deparse(substitute(x))
# Add category axis at the left
categoryAxis_obj <- if (!missing(xlim)) {
.testNumeric(xlim)
.testLength(xlim, 2)
categoryAxis(title = xlab, position = "bottom", id = "x",
minimum = xlim[1], maximum = xlim[2])
} else {
categoryAxis(title = xlab, position = "bottom", id = "x")
}
# test fill_alphas value
.testInterval(fill_alphas, 0, 1)
# finally build the chart
amSerialChart(categoryField = "cat", precision = precision) %>>%
setCategoryAxis(title = xlab, position = "bottom", id = "x") %>>%
addGraph(amGraph = graph_obj) %>>%
setCategoryAxis(categoryAxis = categoryAxis_obj) %>>%
setDataProvider(dataProvider = dt) %>>%
(~ chart )
} else if (is.numeric(y)) {
# the user plot an XY chart
if(is.null(title)){
title = deparse(substitute(y))
}
if (length(x) != length(y)) stop("'x' and 'y' lengths differ")
type <- match.arg(arg = type, choices = c("points", "line", "both"))
# axes label
if (missing(xlab)) xlab <- deparse(substitute(x))
if (missing(ylab)) ylab <- deparse(substitute(y))
# initialize dataProvider
if (!missing(id)) {
dt <- data.table(x = x, y = y, id = id, col = col)
labelId <- "Obs. <b>[[id]]</b><br>"
} else {
dt <- data.table(x = x, y = y, col = col)
labelId <- ""
}
if (!missing(weights)) {
.testLength(weights, length(x))
# width of bullets
weights <- round(weights, precision)
# weights <- sapply(weights, function (w) (w-min(weights)) / (max(weights) - min(weights))) * 10
cex <- max(weights)
dt <- cbind(dt, weights = weights)
weighted <- TRUE
labelWeights <- "weights:<b>[[weights]]</b>"
} else {
weighted <- FALSE
labelWeights <- NULL
if (missing(cex)) cex <- 0
}
# opacity of bullets
bulletAlpha <- ifelse (!cex, 0, 1)
balloonText <- paste0(labelId, "x:<b>[[x]]</b><br>y:<b>[[y]]</b><br>", labelWeights)
# Add common valueAxis
if (!missing(xlim)) {
.testNumeric(xlim)
.testLength(xlim, 2)
} else {
xlim <- range(x)
}
valueAxis_bottom <- valueAxis(title = xlab, position = "bottom", axisAlpha = 0,
minimum = xlim[1], maximum = xlim[2])
graph_obj <- getGraphXY(type = type, bullet = bullet, cex = cex, title = title,
lwd = lwd, lty = lty, bulletAlpha = bulletAlpha, col = col,
fill_alphas = fill_alphas, balloonText = balloonText,
weighted = weighted)
amXYChart(precision = precision) %>>%
addGraph(amGraph = graph_obj) %>>%
addValueAxis(valueAxis = valueAxis_bottom) %>>%
setDataProvider(dataProvider = dt) %>>%
(~ chart)
# since simple line chart has no tooltip, we remove the latter for simple xy line chart
# if (type == "line") chart <- setBalloon(.Object = chart, enabled = FALSE)
} else {
stop("Error in arguments x or y")
}
# Add common valueAxis at the left
if (!missing(ylim)) {
.testNumeric(ylim)
.testLength(ylim, 2)
valueAxis_left <- valueAxis(title = ylab, position = "left", axisAlpha = 0, id = "y",
minimum = ylim[1], maximum = ylim[2])
} else if (!missing(y)) {
ylim <- range(y)
valueAxis_left <- valueAxis(title = ylab, position = "left", axisAlpha = 0, id = "y",
minimum = ylim[1], maximum = ylim[2])
} else {
valueAxis_left <- valueAxis(title = ylab, position = "left", axisAlpha = 0, id = "y")
}
chart <- addValueAxis(.Object = chart, valueAxis = valueAxis_left)
# return the object
amOptions(chart, ...)
}
#' @rdname amPlot
#' @import data.table
#' @import pipeR
#' @export
#'
amPlot.character <- function(x, y,
bullet = c("round","diamond", "square",
"bubble", "yError", "xError",
"triangleLeft", "triangleRight",
"triangleUp", "triangleDown"),
type = c("points", "line", "smoothedLine", "step", "both"),
col = "#0066cc", fill_alphas = 0,
weights = NULL,
precision = 2,
parseDates = FALSE, title = NULL, dataDateFormat,
id, error, xlab, ylab,
lty, cex, lwd, xlim, ylim, ...)
{
# check arguments validity
# ---
bullet <- match.arg(bullet)
if (missing(lty)) lty <- 0
if (missing(lwd)) lwd <- 1
col <- as.factor(col)
# check the color
if (length(col) == 1) {
col <- rep(col, times = length(x))
} else {
.testLength(col, length(x))
levels(col) <- grDevices::topo.colors(nlevels(col))
levels(col) <- substr(levels(col), 1, 7)
}
if (is.numeric(y)) {
# the user plot a simple line or point chart by referencing x axis
if (length(x) != length(y)) stop("'x' and 'y' lengths differ")
# check (and convert) the type
if (length(type) == 1L && type == "sl") # exception to remove for the next submission
type <- "smoothedLine"
else
type <- match.arg(type)
# define the dataProvider
if (type == "points" && bullet %in% c("xError", "yError")) {
if (missing(error)) error <- rep(1, length(x))
.testNumeric(error)
.testLength(error, length(x))
dt <- data.table(x = y, cat = x, error = error)
} else {
dt <- data.table(x = y, cat = x)
}
dt <- cbind(dt, col = col)
# define width of bullet
if (missing(cex)) cex <- 1
if(is.null(title)){
title = deparse(substitute(y))
}
# define the graph object depending on the type
graph_obj <- getGraph(type = type, col = col, fill_alphas = fill_alphas,
bullet = bullet, title = title,
cex = cex, lwd = lwd, lty = lty)
# define axes label
if (missing(xlab)) xlab <- "index"
if (missing(ylab)) ylab <- deparse(substitute(y))
if (parseDates) {
stopifnot(!missing(dataDateFormat))
.testCharacter(dataDateFormat)
chart <- amSerialChart(categoryField = "cat",
precision = precision,
dataDateFormat = dataDateFormat)
} else {
chart <- amSerialChart(categoryField = "cat", precision = precision)
}
# test fill_alphas value
.testInterval(fill_alphas, 0, 1)
# finally build the chart
chart %>>%
addGraph(amGraph = graph_obj) %>>%
setCategoryAxis(title = xlab, position = "bottom", id = "x", parseDates = parseDates) %>>%
setDataProvider(dataProvider = dt) %>>%
(~ chart )
} else {
stop("Error of argument y")
}
# Add common valueAxis at the left
if (!missing(ylim)) {
.testNumeric(ylim)
.testLength(ylim, 2)
valueAxis_left <- valueAxis(title = ylab, position = "left", axisAlpha = 0, id = "y",
minimum = ylim[1], maximum = ylim[2])
} else if (!missing(y)) {
ylim <- range(y)
valueAxis_left <- valueAxis(title = ylab, position = "left", axisAlpha = 0, id = "y",
minimum = ylim[1], maximum = ylim[2])
} else {
valueAxis_left <- valueAxis(title = ylab, position = "left", axisAlpha = 0, id = "y")
}
chart <- addValueAxis(.Object = chart, valueAxis = valueAxis_left)
# return the object
amOptions(chart, ...)
}
#' @rdname amPlot
#'
#' @import data.table
#' @import pipeR
#' @export
#'
amPlot.factor <- function(x, y, bullet = "round", type = "p", col = "gray",
weights = NULL, precision = 2,
parseDates = FALSE, dataDateFormat = NULL,
id, error, xlab, ylab,
lty, cex, lwd, xlim, ylim, ...)
{
amPlot.character(x = as.character(x), y = y, bullet = bullet, type = type, col = col,
weights = weights, precision = precision,
parseDates = parseDates, dataDateFormat = dataDateFormat,
id = id, error = error, xlab = xlab, ylab = ylab,
lty = lty, cex = cex, lwd = lwd,
xlim = xlim, ylim = xlim, ...)
}
#' @rdname amPlot
#'
#' @param columns (optional) either a vector of \code{character} containing
#' the names of the series to draw, or a \code{numeric} vector of indices.
#' By default all numeric columns will be drawn.
#'
#' @import pipeR
#' @import data.table
#'
#' @export
#'
amPlot.data.frame <- function(x, columns, type = "l", precision = 2, xlab, ylab, fill_alphas = 0, ...)
{
if (missing(ylab)) ylab <- deparse(substitute(x))
if (missing(xlab)) xlab <- "index"
# test fill_alphas value
.testInterval(fill_alphas, 0, 1)
if (missing(columns)) {
columns <- sapply(x, is.numeric)
columns <- names(columns)[columns]
} else {}
if (is.character(columns)) columns <- which(colnames(x) %in% columns)
if (!is.data.table(x)) x <- as.data.table(x)
x <- x[, eval(columns), with = FALSE]
if (ncol(x) == 1) x <- x[[1]]
if (is.data.frame(x)) {
names <- colnames(x)
# check the type
if (length(type) > 1 && length(type) != ncol(x))
stop("Invalid argument type")
type <- sapply(X = type, FUN = function (t) {
# check (and convert) the type
if (t == "sl") # exception to remove for the next submission
return ("smoothedLine")
else
return (match.arg(t, c("points", "line", "smoothedLine", "step", "both")))
})
if (length(type) == 1) type <- rep(type, ncol(x))
# if type has been created from sapply, it is a named vector
names(type) <- NULL
graphs_ls <- lapply(1:ncol(x), FUN = function (i) {
lineAlpha <- ifelse(type[i] == "points", yes = 0, no = 1)
bulletAlpha <- ifelse(type[i] %in% c("points", "both"), yes = 1, no = 0)
maxBulletSize<- ifelse(type[i] %in% c("points", "both"), yes = 5, no = 0)
type <- type[i]
if(!type %in% c("smoothedLine", "step")) type <- "line"
graph(balloonText = "value: <b>[[value]]</b>",
title = names[i], valueField = names[i],
lineAlpha = lineAlpha, type = type, bullet = "round",
fill_alphas = fill_alphas,
bulletAlpha = bulletAlpha,
maxBulletSize = maxBulletSize)
})
x <- cbind(x, amCategory = paste("Obs.", 1:nrow(x)))
amSerialChart(precision = precision) %>>%
setCategoryField(categoryField = "amCategory") %>>%
setCategoryAxis(title = xlab, position = "bottom", id = "x") %>>%
addValueAxis(title = ylab, position = "left", id = "y") %>>%
setGraphs(graphs = graphs_ls) %>>%
setDataProvider(dataProvider = x) %>>%
(~ chart)
} else {
.testNumeric(x)
chart <- amPlot(x = x, type = type)
}
amOptions(chart, ...)
}
#' @rdname amPlot
#'
#' @param data dataset
#' @param main title
#'
#' @import pipeR
#' @export
#'
amPlot.formula <- function (x, data, type = "p", fill_alphas = 0, xlab, ylab, main = "", ...)
{
y_name <- all.vars(x[-3]) # subset variables in the lhs
x_name <- all.vars(x[-2]) # subset variables in the rhs
if (length(y_name) == 1) {
y <- data[[eval(y_name)]]
assign(y_name, y)
# define axes label
if (missing(xlab)) xlab <- x_name
if (missing(ylab)) ylab <- y_name
chart <- eval(parse(text = paste0("amPlot(x = data[[eval(x_name)]], y = ", y_name, ", main = main",
", xlab = xlab, ylab = ylab, type = type, fill_alphas = fill_alphas, ...)")))
} else {
i <- 1
y <- data[[eval(y_name[i])]]
assign(y_name[i], y)
# define axes label
if (missing(xlab)) xlab <- x_name
if (missing(ylab)) ylab <- 'multiple series'
chart <- eval(parse(text = paste0("amPlot(x = data[[eval(x_name)]], y = ", y_name[i], ", main = main",
", xlab = xlab, ylab = ylab, type = type, fill_alphas = fill_alphas, ...)")))
i <- i + 1
while(i <= length(y_name)) {
chart <- chart %>>%
amLines(y = data[[eval(y_name[i])]], title = eval(y_name[i]),
type = type, fill_alphas = fill_alphas)
i <- i + 1
}
}
amOptions(chart, ...)
}
getGraph <- function (type, col, bullet, cex, lwd, lty, title, fill_alphas)
{
if (type == "points" && bullet %in% c("xError", "yError"))
graph_obj <- graph(balloonText = "value: <b>[[value]]</b>", valueField = "x",
lineAlpha = 0, fillAlphas = fill_alphas,
errorField = "error", title = title,
bulletAxis = "y", bullet = bullet, bulletSize = cex)
else if (type == "points")
graph_obj <- graph(balloonText = "value: <b>[[value]]</b>", valueField = "x",
lineAlpha = 0, fillAlphas = fill_alphas,
bullet = bullet, bulletSize = cex, title = title)
else if (type == "both")
graph_obj <- graph(balloonText = "value: <b>[[value]]</b>", valueField = "x",
lineAlpha = 1, fillAlphas = fill_alphas,
lineThickness = lwd, title = title,
dashLength = lty, bullet = bullet, bulletSize = cex, type = "smoothedLine")
else if(type %in% c("line", "smoothedLine", "step"))
graph_obj <- graph(balloonText = "value: <b>[[value]]</b>", valueField = "x", title = title,
lineAlpha = 1, fillAlphas = fill_alphas,
dashLength = lty, lineThickness = lwd, type = type,
bullet = "round", bulletAlpha = 0)
else
graph_obj <- graph(balloonText = "value: <b>[[value]]</b>", valueField = "x", title = title,
lineAlpha = 1, fillAlphas = fill_alphas,
dashLength = lty, lineThickness = lwd, type = type)
if (nlevels(col) == 1)
setProperties(.Object = graph_obj, lineColor = levels(col))
else
setProperties(.Object = graph_obj, lineColorField = "col")
}
getGraphXY <- function (type, colorField, bullet, cex, lwd, lty, col,
bulletAlpha, balloonText, weighted, title, fill_alphas)
{
graph_obj <- switch (type,
"points" = {
graph(balloonText = balloonText, valueField = "weights",
xField = "x", yField = "y", lineAlpha = 0,
title = title, bullet = bullet)
},
"smoothedLine" = {
graph(balloonText = balloonText, valueField = "weights", title = title,
type = "smoothedLine",
xField = "x", yField = "y", bullet = bullet, fillAlphas = fill_alphas,
lineThickness = lwd, dashLength = lty, bulletAlpha = bulletAlpha)
},
"step" = {
graph(balloonText = balloonText, valueField = "weights", title = title,
type = "step",
xField = "x", yField = "y", bullet = bullet, fillAlphas = fill_alphas,
lineThickness = lwd, dashLength = lty, bulletAlpha = bulletAlpha)
},
"line" = {
graph(balloonText = balloonText, valueField = "weights", title = title,
xField = "x", yField = "y", bullet = "round", bulletAlpha = 0,
fillAlphas = fill_alphas, lineThickness = lwd, dashLength = lty)
},
"both" = {
graph(balloonText = balloonText, valueField = "weights", title = title,
xField = "x", yField = "y", bullet = "round", bulletAlpha = 1,
fillAlphas = fill_alphas, lineThickness = lwd, dashLength = lty)
})
if (weighted)
graph_obj <- setProperties(graph_obj, maxBulletSize = cex)
else
graph_obj <- setProperties(graph_obj, bulletSize = cex)
if (nlevels(col) == 1)
setProperties(.Object = graph_obj, lineColor = levels(col))
else
setProperties(.Object = graph_obj, lineColorField = "col")
}
#' @title amLines adds a serie to a graph.
#' @description amLines adds a new serie to an existing serial chart.
#'
#' @param chart \linkS4class{AmChart}. Chart you wish to add the new serie.
#' @param x \code{numeric}, equivalent to y, deprecated.
#' @param y \code{numeric}.
#' @param type (optionnal) \code{character}. Possible values are : "l" for line,
#' "p" for points, "b" for both, "sl" for smoothed line, "st" for step
#' @param col \code{character}, color of the new serie.
#' @param fill_alphas a \code{numeric} between 0 and 1 for printed area.
#' @param title \code{character}, name of the new serie, used when legend is enabled.
#' @param balloon \code{logical}, add balloon with value or not
#'
#' @examples
#' if (requireNamespace("pipeR", quietly = TRUE)) {
#' require(pipeR)
#' amPlot(x = rnorm(100), type = 'sl') %>>%
#' amLines(x = rnorm(100), type = "p")
#' }
#'
#' \dontrun{
#' amPlot(x = rnorm(100), type = 'sl') %>>%
#' amLines(x = rnorm(100), col = "blue") %>>%
#' amLines(x = rnorm(100), type = "sl") %>>%
#' amLines(x = rnorm(100), type = "p")
#'
#' # For an XY chart
#' x <- sort(rnorm(100))
#' y1 <- rnorm(100, sd = 10)
#' y2 <- rnorm(100, sd = 10)
#' y3 <- rnorm(100, sd = 10)
#' amPlot(x = x, y = y1) %>>%
#' amLines(x = y2, col = "blue") %>>%
#' amLines(x = y3, type = "p")
#' }
#'
#' @rdname amLines
#' @export
#'
#' @note It is supposed here that x or y corresponds to the y-axis, and the x-axis
#' is automatically linked to the x values of the chart "chart". That is why it makes
#' sense to give the y argument.
#'
amLines <- function(chart, x = NULL, y = NULL,
type = c("points", "line", "smoothedLine", "both", "step"),
col = "#0066cc", title, fill_alphas = 0, balloon = T)
{
if (!is.null(x) && !is.null(y))
stop("Please use only y, x is deprecated.")
if (is.null(x)) {
if (is.null(y)) {
stop("y is necessary")
} else {
if (missing(title)) title <- deparse(substitute(y))
x <- y
}
} else {
if (missing(title)) title <- deparse(substitute(x))
}
# check the arguments
stopifnot(is(chart, "AmChart"))
.testNumeric(x)
if (length(type) == 1L && type == "sl") # exception to remove for the next submission
type <- "smoothedLine"
else
type <- match.arg(type)
lineAlpha <- ifelse(type == "points", yes = 0, no = 1)
if (!missing(col)) {
.testCharacterLength1(col)
} else {
col <- ""
}
# test the length of the vector
dataProvider <- chart@dataProvider
l <- length(dataProvider)
.testLength(x, l)
# define the new name for the serie
# here we suppose that each element of the list have the same names
# consequently this method won't work if the dataProvider has been set
# with NA values for the first line
names <- names(dataProvider[[1]])
i <- 1
repeat {
name <- paste0("amLines", i)
if (!(name %in% names)) break
else i <- i + 1
}
# append the new element to the dataProvider
chart@dataProvider <- lapply(1:l, function(i) {
dataProvider[[i]][[name]] <- x[i]
dataProvider[[i]]
})
if(balloon) {
balloonText <- ifelse(chart@type == "xy", paste0("x:<b>[[x]]</b><br>", title,": <b>[[", name, "]]</b><br>"),
paste0(title,": <b>[[", name, "]]</b><br>"))
} else {
balloonText <- ""
}
# initialize the graph object
graph_obj <- graph(title = title, valueField = name,
lineAlpha = lineAlpha, fillAlphas = fill_alphas,
lineColor = col,
balloonText = balloonText)
# the field where to find the new values depend on the chart type
if (chart@type != "serial")
graph_obj <- setProperties(.Object = graph_obj, xField = "x", yField = name)
if (type %in% c("points", "both"))
graph_obj <- setProperties(.Object = graph_obj, bullet = "round", maxBulletSize = 5)
if(!type %in% c("points", "both"))
graph_obj <- setProperties(.Object = graph_obj, bullet = "round", maxBulletSize = 5, bulletAlpha = 0)
# set the type if necessary
if (type %in% c("smoothedLine", "step"))
graph_obj <- setType(.Object = graph_obj, type = type)
# add the graph
addGraph(.Object = chart, amGraph = graph_obj)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.