Skip to content

Commit

Permalink
as_tauchart
Browse files Browse the repository at this point in the history
  • Loading branch information
hrbrmstr committed Aug 13, 2015
1 parent 81b6b07 commit 653df2e
Show file tree
Hide file tree
Showing 10 changed files with 186 additions and 10 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: taucharts
Title: Create Interactive Charts with the JavaScript 'TauCharts' Library
Version: 0.3.4.9000
Version: 0.4.9000
Authors@R: c(
person("Bob", "Rudis", email = "[email protected]", role = c("aut", "cre")),
person("Kent", "Russell", email = "[email protected]", role = c("aut", "ctb")),
Expand Down
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@

export("%>%")
export(JS)
export(as_tauchart)
export(renderTaucharts)
export(run_tau_app)
export(saveWidget)
Expand Down
96 changes: 96 additions & 0 deletions R/as_tauchart.r
Original file line number Diff line number Diff line change
@@ -0,0 +1,96 @@
#' Turn a simple (single-geom) ggplot plot into an tauchart object
#'
#' Takes a ggplot object that has a single geom (it can be geom_line,
#' geom_point or geom_histogram) and converts it to it's taucahrt counterpart.
#' It will do it's best to identify plot labels, mapped size & color aesthetics,
#' and x/y limits.\cr
#' \cr
#' If there are aesthetic mappings, \code{as_tauchart} will automaticlly add
#' a legend.
#'
#' @note More aesthetic mappings are planned
#' @param gg ggplot object
#' @return tauchart object
#' @export
#' @examples
#' dat <- data.frame(year=seq(1790, 1970, 10),
#' uspop=as.numeric(usp
#' set.seed(5689)
#' data(movies, package="ggplot2")
#' movies <- movies[sample(nrow(movies), 1000), ]
#'
#' gg <- ggplot(dat, aes(x=year, y=uspop)) + geom_line()
#' as_tauchart(gg)
#'
#' gg <- ggplot(dat, aes(x=year, y=uspop)) + geom_point()
#' as_tauchart(gg)
#'
#' gg <- ggplot(dplyr::count(movies, rating), aes(rating, n)) + geom_bar(stat="identity")
#' as_tauchart(gg)
#'
#' gg <- ggplot(mtcars) + geom_point(aes(x=mpg, y=wt, color=cyl))
#' as_tauchart(gg)
#'
#' gg <- ggplot(mtcars, aes(x=mpg, y=wt, color=am, size=wt)) + geom_point()
#' as_tauchart(gg_m2)
#'
#' data(economics, package="ggplot2")
#' gg <- ggplot(economics) + geom_line(aes(x=date, y=unemploy))
#' as_tauchart(gg) %>% tau_guide_x(tick_format="%Y")
as_tauchart <- function(gg) {

if (!inherits(gg, c("gg", "ggplot"))) {
stop("as_tauchart only works with ggplot objects", call.=FALSE)
}

gb <- ggplot_build(gg)

if (length(gb$plot$layers) > 1) {
stop("as_tauchart only works with single-layer-geoms", call.=FALSE)
}

plot_type <- gb$plot$layers[[1]]$geom$objname

x <- as.character(gb$plot$mapping$x %||% gb$plot$layers[[1]]$mapping$x %||% NULL)
y <- as.character(gb$plot$mapping$y %||% gb$plot$layers[[1]]$mapping$y %||% NULL)
color <- gb$plot$mapping$colour %||% gb$plot$layers[[1]]$mapping$colour %||% NULL
size <- gb$plot$mapping$size %||% gb$plot$layers[[1]]$mapping$size %||% NULL

color <- grep("factor", as.character(color), value=TRUE, invert=TRUE) %||% NULL
size <- grep("factor", as.character(size), value=TRUE, invert=TRUE) %||% NULL

r_x <- gb$panel$ranges[[1]]$x.range
r_y <- gb$panel$ranges[[1]]$y.range

data <- gb$plot$data

tc <- NULL

if (plot_type=="line") {
tau_guide_y(
tau_guide_x(
tau_line(tauchart(data), x=x, y=y, color=color, size=size),
auto_scale=FALSE, label=gb$plot$labels$x, min=r_x[1], max=r_x[2]),
auto_scale=FALSE, label=gb$plot$labels$y, min=r_y[1], max=r_y[2]) -> tc
} else if (plot_type=="point") {
tau_guide_y(
tau_guide_x(
tau_point(tauchart(data), x=x, y=y, color=color, size=size),
auto_scale=FALSE, label=gb$plot$labels$x, min=r_x[1], max=r_x[2]),
auto_scale=FALSE, label=gb$plot$labels$y, min=r_y[1], max=r_y[2]) -> tc
} else if (plot_type=="bar") {
tau_guide_y(
tau_guide_x(
tau_bar(tauchart(data), x=x, y=y, color=color, size=size),
auto_scale=FALSE, label=gb$plot$labels$x, min=r_x[1], max=r_x[2]),
auto_scale=FALSE, label=gb$plot$labels$y, min=r_y[1], max=r_y[2]) -> tc
} else {
stop("as_tauchart only works with geom_line, geom_point and geom_histogram", call.=FALSE)
}

if (!is.null(color) | !is.null(size)) tc <- tau_legend(tc)

tc

}

16 changes: 11 additions & 5 deletions R/guides.r
Original file line number Diff line number Diff line change
Expand Up @@ -55,16 +55,19 @@ tau_guide_gridlines <- function(tau, show_x=TRUE, show_y=TRUE) {
#' tau_guide_y(label="Weight", auto_scale=FALSE)
tau_guide_x <- function(tau, padding=NULL,
label=NULL, label_padding=NULL,
auto_scale=TRUE, tick_period=NULL, tick_format=NULL,
min = NULL, max = NULL ) {
tau$x$guide$x$autoScale <- auto_scale
auto_scale=NULL, tick_period=NULL, tick_format=NULL,
min=NULL, max=NULL ) {

tau$x$guide$x$autoScale <- auto_scale %^^% tau[["x"]][["guide"]][["x"]][["autoScale"]] %^^% TRUE

if (!is.null(label_padding)) tau$x$guide$x$label <- list(padding=label_padding)
if (!is.null(label)) tau$x$guide$x$label$text <- label
if (!is.null(tick_format)) tau$x$guide$x$tickFormat <- tick_format
if (!is.null(tick_period)) tau$x$guide$y$tickPeriod <- tick_period
if (!is.null(padding)) tau$x$guide$x$padding <- padding
if (!is.null(min)) tau$x$guide$x$min <- min
if (!is.null(max)) tau$x$guide$x$max <- max

tau
}

Expand Down Expand Up @@ -92,15 +95,18 @@ tau_guide_x <- function(tau, padding=NULL,
#' tau_guide_y(label="Weight", auto_scale=FALSE)
tau_guide_y <- function(tau, padding=NULL,
label=NULL, label_padding=NULL,
auto_scale=TRUE, tick_period=NULL, tick_format=NULL,
auto_scale=NULL, tick_period=NULL, tick_format=NULL,
min=NULL, max=NULL) {
tau$x$guide$y$autoScale <- auto_scale

tau$x$guide$x$autoScale <- auto_scale %^^% tau[["x"]][["guide"]][["y"]][["autoScale"]] %^^% TRUE

if (!is.null(label_padding)) tau$x$guide$y$label <- list(padding=label_padding)
if (!is.null(label)) tau$x$guide$y$label$text <- label
if (!is.null(tick_period)) tau$x$guide$y$tickPeriod <- tick_period
if (!is.null(tick_format)) tau$x$guide$y$tickFormat <- tick_format
if (!is.null(padding)) tau$x$guide$y$padding <- padding
if (!is.null(min)) tau$x$guide$y$min <- min
if (!is.null(max)) tau$x$guide$y$max <- max

tau
}
16 changes: 16 additions & 0 deletions R/utils.r
Original file line number Diff line number Diff line change
@@ -1,3 +1,19 @@
noathenb <- function(a, b) {
if (length(a) > 0) a else b
}

"%||%" <- noathenb

naathenb <- function(a, b) {
if (length(a) > 0) {
if (!is.na(a)) a else b
} else {
b
}
}

"%^^%" <- naathenb

brewers <- c("BrBG", "PiYG", "PRGn", "PuOr", "RdBu", "RdGy", "RdYlBu", "RdYlGn",
"Spectral", "Accent", "Dark2", "Paired", "Pastel1", "Pastel2",
"Set1", "Set2", "Set3", "Blues", "BuGn", "BuPu", "GnBu", "Greens",
Expand Down
2 changes: 2 additions & 0 deletions README.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -47,6 +47,7 @@ The following functions are implemented:
- `tau_tasks`: Add post-render JavaScript tasks to taucharts
- `tau_add_css_rule`: Add a CSS rule to the rendered htmlwidget
- `tau_set_font`: Set `font-family` for the chart
- `as_tauchart`: Turn a simple (single-geom) ggplot plot into an tauchart object

with many color palette options:

Expand All @@ -65,6 +66,7 @@ The following datasets are included:

### News

- Version 0.4.0.9000 released : added `as_tauchart` & updated TauCharts JS lib
- Version 0.3.4.9000 released : added warning for global targeted CSS rules and font ref fix thx to @jlewis91
- Version 0.3.3.9001 released : fix for custom colors and `tau_line`
- Version 0.3.3 released : custom font for chart (`?tau_set_font`)
Expand Down
6 changes: 4 additions & 2 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,7 @@ The following functions are implemented:
- `tau_tasks`: Add post-render JavaScript tasks to taucharts
- `tau_add_css_rule`: Add a CSS rule to the rendered htmlwidget
- `tau_set_font`: Set `font-family` for the chart
- `as_tauchart`: Turn a simple (single-geom) ggplot plot into an tauchart object

with many color palette options:

Expand All @@ -50,6 +51,7 @@ The following datasets are included:

### News

- Version 0.4.0.9000 released : added `as_tauchart` & updated TauCharts JS lib
- Version 0.3.4.9000 released : added warning for global targeted CSS rules and font ref fix thx to @jlewis91
- Version 0.3.3.9001 released : fix for custom colors and `tau_line`
- Version 0.3.3 released : custom font for chart (`?tau_set_font`)
Expand Down Expand Up @@ -78,7 +80,7 @@ library(taucharts)

# current verison
packageVersion("taucharts")
#> [1] '0.3.4.9000'
#> [1] '0.4.9000'
```

### Test Results
Expand All @@ -88,7 +90,7 @@ library(taucharts)
library(testthat)

date()
#> [1] "Wed Aug 12 16:37:18 2015"
#> [1] "Thu Aug 13 06:56:26 2015"

test_dir("tests/")
#> testthat results ========================================================================================================
Expand Down
53 changes: 53 additions & 0 deletions man/as_tauchart.Rd
Original file line number Diff line number Diff line change
@@ -0,0 +1,53 @@
% Generated by roxygen2 (4.1.1): do not edit by hand
% Please edit documentation in R/as_tauchart.r
\name{as_tauchart}
\alias{as_tauchart}
\title{Turn a simple (single-geom) ggplot plot into an tauchart object}
\usage{
as_tauchart(gg)
}
\arguments{
\item{gg}{ggplot object}
}
\value{
tauchart object
}
\description{
Takes a ggplot object that has a single geom (it can be geom_line,
geom_point or geom_histogram) and converts it to it's taucahrt counterpart.
It will do it's best to identify plot labels, mapped size & color aesthetics,
and x/y limits.\cr
\cr
If there are aesthetic mappings, \code{as_tauchart} will automaticlly add
a legend.
}
\note{
More aesthetic mappings are planned
}
\examples{
dat <- data.frame(year=seq(1790, 1970, 10),
uspop=as.numeric(usp
set.seed(5689)
data(movies, package="ggplot2")
movies <- movies[sample(nrow(movies), 1000), ]

gg <- ggplot(dat, aes(x=year, y=uspop)) + geom_line()
as_tauchart(gg)

gg <- ggplot(dat, aes(x=year, y=uspop)) + geom_point()
as_tauchart(gg)

gg <- ggplot(dplyr::count(movies, rating), aes(rating, n)) + geom_bar(stat="identity")
as_tauchart(gg)

gg <- ggplot(mtcars) + geom_point(aes(x=mpg, y=wt, color=cyl))
as_tauchart(gg)

gg <- ggplot(mtcars, aes(x=mpg, y=wt, color=am, size=wt)) + geom_point()
as_tauchart(gg_m2)

data(economics, package="ggplot2")
gg <- ggplot(economics) + geom_line(aes(x=date, y=unemploy))
as_tauchart(gg) \%>\% tau_guide_x(tick_format="\%Y")
}

2 changes: 1 addition & 1 deletion man/tau_guide_x.Rd
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@
\title{Control x-axis padding, label, scale & tick format}
\usage{
tau_guide_x(tau, padding = NULL, label = NULL, label_padding = NULL,
auto_scale = TRUE, tick_period = NULL, tick_format = NULL, min = NULL,
auto_scale = NULL, tick_period = NULL, tick_format = NULL, min = NULL,
max = NULL)
}
\arguments{
Expand Down
2 changes: 1 addition & 1 deletion man/tau_guide_y.Rd
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@
\title{Control y-axis padding, label, scale & tick format}
\usage{
tau_guide_y(tau, padding = NULL, label = NULL, label_padding = NULL,
auto_scale = TRUE, tick_period = NULL, tick_format = NULL, min = NULL,
auto_scale = NULL, tick_period = NULL, tick_format = NULL, min = NULL,
max = NULL)
}
\arguments{
Expand Down

0 comments on commit 653df2e

Please sign in to comment.