Skip to content
This repository has been archived by the owner on Feb 9, 2024. It is now read-only.

Commit

Permalink
Revert extraneous changes and style fixes
Browse files Browse the repository at this point in the history
  • Loading branch information
@wch
wch committed Sep 17, 2014
1 parent 41df0d4 commit b9d349d
Show file tree
Hide file tree
Showing 12 changed files with 157 additions and 156 deletions.
1 change: 0 additions & 1 deletion .gitignore
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,3 @@
.Rproj.user
.Rhistory
.RData
*~
3 changes: 1 addition & 2 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -71,6 +71,7 @@ S3method(extract_reactives,default)
S3method(extract_reactives,ggvis_props)
S3method(extract_reactives,prop_reactive)
S3method(filter,ggvis)
S3method(filter,reactive)
S3method(format,ggvis_axis)
S3method(format,ggvis_legend)
S3method(format,ggvis_props)
Expand Down Expand Up @@ -180,7 +181,6 @@ export(arrange.reactive)
export(auto_group)
export(axis_props)
export(band)
export(bin_vector)
export(bind_shiny)
export(bind_shiny_ui)
export(compute_align)
Expand All @@ -206,7 +206,6 @@ export(explain)
export(export_png)
export(export_svg)
export(filter)
export(filter.reactive)
export(fullseq)
export(get_data)
export(ggvis)
Expand Down
120 changes: 53 additions & 67 deletions R/compute_bin.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,26 +4,26 @@
#' grouped data frames and ggvis visualisations.
#' @param x_var,w_var Names of x and weight variables. The x variable must be
#' continuous.
#' @param width The width of the bins. The default is \code{NULL}, which
#' yields 30 bins that cover the range of the data. You should always override
#' this value, exploring multiple widths to find the best to illustrate the
#' stories in your data.
#' @param center The center of one of the bins. Note that if center is above or below
#' the range of the data, things will be shifted by an appropriate number of \code{width}s.
#' To center on integers,
#' for example, use \code{width = 1} and \code{center = 0}, even if \code{0} is
#' outside the range of the data. At most one of \code{center} and \code{boundary} may be
#' @param width The width of the bins. The default is \code{NULL}, which yields
#' 30 bins that cover the range of the data. You should always override this
#' value, exploring multiple widths to find the best to illustrate the stories
#' in your data.
#' @param center The center of one of the bins. Note that if center is above or
#' below the range of the data, things will be shifted by an appropriate
#' number of \code{width}s. To center on integers, for example, use
#' \code{width=1} and \code{center=0}, even if \code{0} is outside the range
#' of the data. At most one of \code{center} and \code{boundary} may be
#' specified.
#' @param boundary A boundary between two bins. As with \code{center}, things are shifted
#' when \code{boundary} is outside the range of the data. For example, to center on
#' integers, use \code{width = 1} and \code{boundary = 0.5}, even if \code{1} is outside
#' the range of the data. At most one of \code{center} and \code{boundary} may be
#' specified.
#' @param closed One of \code{"right"} or \code{"left"} indicating whether
#' right or left edges of bins are included in the bin.
#' @param pad If \code{TRUE}, adds empty bins at either end of x. This
#' ensures frequency polygons touch 0, and adds padding between the data
#' and axis for histograms.
#' @param boundary A boundary between two bins. As with \code{center}, things
#' are shifted when \code{boundary} is outside the range of the data. For
#' example, to center on integers, use \code{width = 1} and \code{boundary =
#' 0.5}, even if \code{1} is outside the range of the data. At most one of
#' \code{center} and \code{boundary} may be specified.
#' @param closed One of \code{"right"} or \code{"left"} indicating whether right
#' or left edges of bins are included in the bin.
#' @param pad If \code{TRUE}, adds empty bins at either end of x. This ensures
#' frequency polygons touch 0, and adds padding between the data and axis for
#' histograms.
#' @seealso \code{\link{compute_count}} For counting cases at specific locations
#' of a continuous variable. This is useful when the variable is continuous
#' but the data is granular.
Expand Down Expand Up @@ -122,25 +122,24 @@ tilelayer_origin <- function(x_range, width) {
stopifnot(is.numeric(x_range) && length(x_range) == 2)
stopifnot(is.numeric(width) && length(width) == 1)
num_central_bins <- trunc(diff(x_range) / width) - 1
side_width <- (diff(x_range) - num_central_bins * width) / 2 # width of partial tiles on either side
# width of partial tiles on either side
side_width <- (diff(x_range) - num_central_bins * width) / 2
x_range[1] + side_width - width
# adjust_breaks should be called to handle any round-off fuzziness issues
}

compute_origin <- function(x_range, width, boundary) {
shift <- floor( (x_range[1] - boundary) / width )
shift <- floor((x_range[1] - boundary) / width)
boundary + shift * width
}

#' @export
bin_params.numeric <- function(x_range, width = NULL,
center = NULL,
boundary = NULL,
closed = c("right", "left")) {
bin_params.numeric <- function(x_range, width = NULL, center = NULL,
boundary = NULL, closed = c("right", "left")) {
closed <- match.arg(closed)
stopifnot(is.numeric(x_range) && length(x_range) == 2)
if (!is.null(boundary) && !is.null(center)) {
stop( "Only one of 'boundary' and 'center' may be specified." )
stop("Only one of 'boundary' and 'center' may be specified.")
}

if (is.null(width)) {
Expand All @@ -150,7 +149,6 @@ bin_params.numeric <- function(x_range, width = NULL,

# if neither edge nor center given, compute both using tile layer's algorithm
# this puts min and max of data in outer half of their bins.

if (is.null(boundary) && is.null(center)) {
boundary <- tilelayer_origin(x_range, width)
# center <- boundary + width / 2
Expand All @@ -159,18 +157,17 @@ bin_params.numeric <- function(x_range, width = NULL,
# if center given but not boundary, compute boundary from center
if (is.null(boundary)) boundary <- center - width / 2

origin <- compute_origin( x_range, width, boundary )
origin <- compute_origin(x_range, width, boundary)

list(binwidth = width, origin = origin, closed = closed)
}

#' @export
bin_params.POSIXct <- function(x_range, width = NULL,
center = NULL, boundary = NULL,
closed = c("right", "left")) {
bin_params.POSIXct <- function(x_range, width = NULL, center = NULL,
boundary = NULL, closed = c("right", "left")) {
closed <- match.arg(closed)
if (!is.null(boundary) && !is.null(center)) {
stop( "Only one of 'boundary' and 'center' may be specified." )
stop("Only one of 'boundary' and 'center' may be specified.")
}

x_range <- as.numeric(x_range)
Expand Down Expand Up @@ -199,22 +196,20 @@ bin_params.POSIXct <- function(x_range, width = NULL,
# if we have center but not boundary, compute boundary
if (is.null(boundary)) boundary <- center - width / 2

origin <- compute_origin( x_range, width, boundary )
origin <- compute_origin(x_range, width, boundary)

list(binwidth = width, origin = origin, closed = closed,
origin.POSIX = structure(origin, class = c("POSIXct", "POSIXt"))
)
}

### check on this -- get center in instead of origin
#' @export
bin_params.Date <- function(x_range, width = NULL, center = NULL,
boundary = NULL, closed = c("right", "left")) {

closed <- match.arg(closed)

# convert things to numeric as we go along

# convert things to numeric as we go along
x_range <- as.numeric(x_range)

if (is.null(width)) {
Expand All @@ -234,10 +229,9 @@ bin_params.Date <- function(x_range, width = NULL, center = NULL,
boundary <- center - width / 2
}

origin <- compute_origin( x_range, width, boundary )
origin <- compute_origin(x_range, width, boundary)

# do we need to convert this back to date format?

list(binwidth = width, origin = origin, closed = closed)
}

Expand All @@ -248,16 +242,16 @@ bin_params.integer <- function(x_range, width = NULL,
closed = c("right", "left")) {

closed <- match.arg(closed)

if (!is.null(boundary) && !is.null(center)) {
stop( "Only one of 'boundary' and 'center' may be specified." )
stop("Only one of 'boundary' and 'center' may be specified.")
}

if (is.null(width)) {
width <- max(pretty(round(diff(x_range) / 30)))
if (width <= 1) width <- 1
num_bins <- ceiling( diff(x_range) / width )
notify_guess(width, paste0("approximately range/", num_bins) )
if (width < 1) width <- 1
num_bins <- ceiling(diff(x_range) / width)
notify_guess(width, paste0("approximately range/", num_bins))
}

if (is.null(boundary) && is.null(center)) {
Expand All @@ -268,7 +262,7 @@ bin_params.integer <- function(x_range, width = NULL,
# if we have center but not boundary, compute boundary
if (is.null(boundary)) boundary <- center - width / 2

origin <- compute_origin( x_range, width, boundary )
origin <- compute_origin(x_range, width, boundary)

list(binwidth = width, origin = origin, closed = closed)
}
Expand All @@ -279,36 +273,34 @@ bin_params.integer <- function(x_range, width = NULL,
#'
#' A generic and several implementations for binning vectors.
#'
#' @export
#' @param x a vector to bin
#' @param weight if specified, an integer vector of the same length as \code{x}
#' representing the number of occurances of each value in \code{x}
#' @param width the width of a bin
#' @param center the center of a bin
#' @param boundary the boundary of a bin. \code{center} and \code{boundary} should
#' not both be specified.
#' @param closed One of \code{"right"} or \code{"left"} indicating whether
#' @param closed One of \code{"right"} or \code{"left"} indicating whether
#' right or left edges of bins are included in the bin.
#' @param pad a logical indicatign whether the bins should be padded to include
#' an empty bin on each side.
#' @param ... additional arguments passed through to instances of the generic
#' @keywords internal
bin_vector <- function(x, weight = NULL, ...) {
UseMethod("bin_vector")
}

#' @rdname bin_vector
#' @export

bin_vector.numeric <- function(x, weight = NULL, ..., width = NULL,
center = NULL, boundary = NULL,
closed = c("right", "left"), pad = TRUE) {
stopifnot(is.null(width) || (is.numeric(width) && length(width) == 1))
stopifnot(is.null(center) || (is.numeric(center) && length(center) == 1))
stopifnot(is.null(boundary) || (is.numeric(boundary) && length(boundary) == 1))
stopifnot(is.character(closed))

closed <- match.arg(closed)

if (!is.null(center) && !is.null(boundary)) {
stop("Only one of 'center' and 'boundary' may be specified.")
}
Expand Down Expand Up @@ -349,9 +341,7 @@ bin_vector.numeric <- function(x, weight = NULL, ..., width = NULL,
bin_out(count, x, bin_widths)
}

#' @rdname bin_vector
#' @export

bin_vector.POSIXct <- function(x, weight = NULL, ..., width = NULL,
center = NULL, boundary = NULL,
closed = c("right", "left"), pad=TRUE) {
Expand All @@ -360,11 +350,12 @@ bin_vector.POSIXct <- function(x, weight = NULL, ..., width = NULL,
# Convert times to raw numbers (seconds since UNIX epoch), and call bin.numeric
if (inherits(width, "Period")) width <- as.numeric(as.difftime(width, units = "secs"))
if (!is.null(width)) width <- as.numeric(width)
center <- if (!is.null(center)) center <- as.numeric(center)
boundary <- if (!is.null(boundary)) boundary <- as.numeric(boundary)
if (!is.null(center)) center <- as.numeric(center)
if (!is.null(boundary)) boundary <- as.numeric(boundary)

results <- bin_vector(as.numeric(x), weight = weight, width = width,
center = center, boundary = boundary, closed = closed, pad=pad)
center = center, boundary = boundary, closed = closed,
pad = pad)

# Convert some columns from numeric back to POSIXct objects
tz <- attr(x, "tzone", TRUE)
Expand All @@ -381,19 +372,14 @@ bin_vector.Date <- function(x, weight = NULL, ..., width = NULL, center=NULL,
boundary = NULL, closed = c("right", "left"), pad = TRUE) {

closed <- match.arg(closed)

# Convert times to raw numbers, and call bin_vector.numeric

if (!is.null(width))
width <- as.numeric(width)
if (!is.null(center))
center<- as.numeric(center)
if (!is.null(boundary))
boundary <- as.numeric(boundary)
# Convert times to raw numbers, and call bin_vector.numeric
if (!is.null(width)) width <- as.numeric(width)
if (!is.null(center)) center<- as.numeric(center)
if (!is.null(boundary)) boundary <- as.numeric(boundary)

results <- bin_vector(as.numeric(x), weight = weight,
width = width,
center=center, boundary = boundary,
results <- bin_vector(as.numeric(x), weight = weight, width = width,
center = center, boundary = boundary,
closed = closed, pad = pad)

# Convert some columns from numeric back to Date objects
Expand Down
4 changes: 2 additions & 2 deletions R/layer_bins.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,8 +23,8 @@
#' mtcars %>% ggvis(~mpg, stroke = ~factor(cyl)) %>% group_by(cyl) %>%
#' layer_freqpolys(width = 2)
layer_histograms <- function(vis, ..., width = NULL, center = NULL,
boundary = NULL, closed = c("right", "left"), stack = TRUE)
{
boundary = NULL, closed = c("right", "left"),
stack = TRUE) {
closed <- match.arg(closed)
new_props <- merge_props(cur_props(vis), props(...))

Expand Down
11 changes: 1 addition & 10 deletions man/bin_vector.Rd
View file
Original file line number Diff line number Diff line change
@@ -1,19 +1,9 @@
% Generated by roxygen2 (4.0.2): do not edit by hand
\name{bin_vector}
\alias{bin_vector}
\alias{bin_vector.POSIXct}
\alias{bin_vector.numeric}
\title{Bin vectors}
\usage{
bin_vector(x, weight = NULL, ...)

\method{bin_vector}{numeric}(x, weight = NULL, ..., width = NULL,
center = NULL, boundary = NULL, closed = c("right", "left"),
pad = TRUE)

\method{bin_vector}{POSIXct}(x, weight = NULL, ..., width = NULL,
center = NULL, boundary = NULL, closed = c("right", "left"),
pad = TRUE)
}
\arguments{
\item{x}{a vector to bin}
Expand All @@ -39,4 +29,5 @@ an empty bin on each side.}
\description{
A generic and several implementations for binning vectors.
}
\keyword{internal}

4 changes: 2 additions & 2 deletions tests/specs/layer.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,13 +2,13 @@ library(ggvis)

mtcars %>%
ggvis(x = ~wt) %>%
layer_histograms(width = 1) %>%
layer_histograms(binwidth = 1) %>%
save_spec("layer/histogram.json")

mtcars %>%
ggvis(x = ~wt, stroke = ~cyl) %>%
group_by(cyl) %>%
layer_freqpolys(width = 1) %>%
layer_freqpolys(binwidth = 1) %>%
save_spec("layer/freqpoly-grouped.json")

mtcars %>%
Expand Down
6 changes: 3 additions & 3 deletions tests/specs/layer/freqpoly-grouped.json
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@
"count_" : "number"
}
},
"values" : "\"cyl\",\"x_\",\"count_\"\n4,0.9685,0\n4,1.9685,8\n4,2.9685,3\n4,3.9685,0\n6,1.9685,0\n6,2.9685,7\n6,3.9685,0\n8,1.9685,0\n8,2.9685,3\n8,3.9685,8\n8,4.9685,3\n8,5.9685,0"
"values" : "\"cyl\",\"x_\",\"count_\"\n4,0.5,0\n4,1.5,4\n4,2.5,5\n4,3.5,2\n4,4.5,0\n6,0.5,0\n6,1.5,0\n6,2.5,3\n6,3.5,4\n6,4.5,0\n8,0.5,0\n8,1.5,0\n8,2.5,0\n8,3.5,10\n8,4.5,1\n8,5.5,3\n8,6.5,0"
},
{
"name" : "mtcars0/regroup1/bin2",
Expand Down Expand Up @@ -42,7 +42,7 @@
"domain" : "number"
}
},
"values" : "\"domain\"\n0.7185\n6.2185"
"values" : "\"domain\"\n0.2\n6.8"
},
{
"name" : "scale/y",
Expand All @@ -52,7 +52,7 @@
"domain" : "number"
}
},
"values" : "\"domain\"\n-0.4\n8.4"
"values" : "\"domain\"\n-0.5\n10.5"
}
],
"scales" : [
Expand Down
Loading

0 comments on commit b9d349d

Please sign in to comment.