Permalink
Browse files

init the package

  • Loading branch information...
earowang committed Jul 20, 2017
1 parent 2d12e0f commit aba1cfc2eec88966c43232fe5d249522f88e1e27
Showing with 1,150 additions and 674 deletions.
  1. +5 −0 .Rbuildignore
  2. +5 −0 .gitignore
  3. +28 −0 DESCRIPTION
  4. +0 −674 LICENSE
  5. +20 −0 Makefile
  6. +63 −0 NAMESPACE
  7. +165 −0 R/dplyr-verbs.R
  8. +11 −0 R/imports.R
  9. +133 −0 R/interval.R
  10. +54 −0 R/parse.R
  11. +32 −0 R/reexports.R
  12. +279 −0 R/tsibble.R
  13. +9 −0 R/type-sum.R
  14. +14 −0 R/utilities-rlang.R
  15. +28 −0 R/utilities.R
  16. +27 −0 README.Rmd
  17. +16 −0 README.md
  18. +50 −0 data-raw/read.R
  19. +58 −0 man/as-tsibble.Rd
  20. +42 −0 man/reexports.Rd
  21. +46 −0 man/summarise.Rd
  22. +44 −0 man/tsibble.Rd
  23. +21 −0 tsibble.Rproj
View
@@ -0,0 +1,5 @@
^.*\.Rproj$
^\.Rproj\.user$
^Makefile$
^data-raw$
^README\.Rmd$
View
@@ -0,0 +1,5 @@
.Rproj.user
.Rhistory
.RData
.Ruserdata
.DS_Store
View
@@ -0,0 +1,28 @@
Package: tsibble
Type: Package
Title: Temporal Data Frames
Version: 0.0.0.9000
Authors@R: person("Earo", "Wang", email = "earo.wang@gmail.com", role = c("aut", "cre"))
Description: The 'tsibble' provides and works with tidy temporal data.
Depends:
R (>= 3.1.3)
Imports:
zoo,
rlang,
tidyr,
purrr,
tibble,
magrittr,
lubridate,
dplyr (>= 0.7.0)
Suggests:
knitr,
rmarkdown
VignetteBuilder: knitr
License: GPL (>= 3)
URL: http://pkg.earo.me/tsibble
BugReports: https://github.com/earowang/tsibble/issues
Encoding: UTF-8
LazyData: true
RoxygenNote: 6.0.1
Roxygen: list(markdown = TRUE)
View
674 LICENSE

This file was deleted.

Oops, something went wrong.
View
@@ -0,0 +1,20 @@
document:
Rscript -e "devtools::document()"
readme:
Rscript -e "rmarkdown::render('README.Rmd')"
build:
Rscript -e "devtools::build()"
check:
Rscript -e "devtools::check()"
install:
Rscript -e "devtools::install(build_vignettes = TRUE, upgrade_dependencies = FALSE)"
winbuild:
Rscript -e "devtools::build_win(version = 'R-devel', quiet = TRUE)"
pkgdown:
Rscript -e "pkgdown::clean_site(); pkgdown::build_site()"
View
@@ -0,0 +1,63 @@
# Generated by roxygen2: do not edit by hand
S3method(as_tsibble,default)
S3method(as_tsibble,gts)
S3method(as_tsibble,hts)
S3method(as_tsibble,mts)
S3method(as_tsibble,ts)
S3method(filter,tbl_ts)
S3method(group_by,tbl_ts)
S3method(mutate,tbl_ts)
S3method(print,tbl_ts)
S3method(rep,yearmon)
S3method(rep,yearqtr)
S3method(select,tbl_ts)
S3method(summarise,tbl_ts)
S3method(summarize,tbl_ts)
S3method(type_sum,yearmon)
S3method(type_sum,yearqtr)
export("%>%")
export(as.yearmon)
export(as.yearqtr)
export(as_date)
export(as_tsibble)
export(filter)
export(group_by)
export(key_vars)
export(mutate)
export(select)
export(summarise)
export(summarize)
export(tsibble)
export(year)
import(rlang)
importFrom(dplyr,bind_cols)
importFrom(dplyr,filter)
importFrom(dplyr,group_by)
importFrom(dplyr,groups)
importFrom(dplyr,is.grouped_df)
importFrom(dplyr,mutate)
importFrom(dplyr,select)
importFrom(dplyr,select_vars)
importFrom(dplyr,summarise)
importFrom(dplyr,summarize)
importFrom(dplyr,ungroup)
importFrom(lubridate,as_date)
importFrom(lubridate,date_decimal)
importFrom(lubridate,seconds_to_period)
importFrom(lubridate,year)
importFrom(magrittr,"%>%")
importFrom(purrr,map)
importFrom(purrr,map_chr)
importFrom(purrr,map_int)
importFrom(purrr,map_lgl)
importFrom(stats,frequency)
importFrom(stats,time)
importFrom(tibble,as_tibble)
importFrom(tibble,lst)
importFrom(tibble,tibble)
importFrom(tibble,type_sum)
importFrom(tidyr,gather)
importFrom(tidyr,nest)
importFrom(zoo,as.yearmon)
importFrom(zoo,as.yearqtr)
View
@@ -0,0 +1,165 @@
#' @seealso [dplyr::filter]
#' @export
# ToDo: filter(pkgs_ts, ~ year() == 2016)? => tbl_ts
# ToDo: filter(pkgs_ts, ~ month() == 1)? => tbl_df
filter.tbl_ts <- function(.data, ...) {
key <- get_key(.data)
index <- get_index(.data)
interval <- get_interval(.data)
cls <- class(.data)
.data <- NextMethod()
return(structure(
.data, key = key, index = index, interval = interval, class = cls
))
}
#' @seealso [dplyr::select]
#' @export
# ToDo: select should work with everything(), ends_with() and etc. too
select.tbl_ts <- function(.data, ...) {
cls <- class(.data)
key <- get_key(.data)
index <- get_index(.data)
interval <- get_interval(.data)
.data <- NextMethod()
dots_cap <- quos(...)
idx_there <- any(map_lgl(dots_cap, function(x) x == index))
key_there <- any(rlang::flatten_lgl(map(key, function(x)
map_lgl(dots_cap, function(y) y == x)
)))
if (idx_there && key_there) {
return(structure(
.data, key = key, index = index, interval = interval, class = cls
))
} else {
return(structure(.data, class = c("tbl_df", "tbl", "data.frame")))
}
}
#' @seealso [dplyr::mutate]
#' @export
mutate.tbl_ts <- function(.data, ...) {
key <- get_key(.data)
index <- get_index(.data)
interval <- get_interval(.data)
cls <- class(.data)
.data <- NextMethod()
return(structure(
.data, key = key, index = index, interval = interval, class = cls
))
}
#' @seealso [dplyr::group_by]
#' @export
group_by.tbl_ts <- function(.data, ..., add = FALSE) {
key <- get_key(.data)
index <- get_index(.data)
interval <- get_interval(.data)
.data <- NextMethod(.Generic, object = .data, add = add)
cls <- c("tbl_ts", class(.data))
return(structure(
.data, key = key, index = index, interval = interval, class = cls
))
}
#' @title Aggregate over calendar periods
#'
#' @description It computes summary statistics for a tsibble over calendar
#' periods, usually used in combination of [group_by].
#'
#' @param .data A tsibble (of `tbl_ts` class).
#' @param ... Name-value pairs of summary functions. To aggregate tsibble over
#' a certain calendar period, for example yearly aggregates, `~ year()` needs
#' passing to `...`. Please see details.
#'
#' @author Earo Wang
#' @rdname summarise
#' @seealso [dplyr::summarise]
#' @details It's S3 method implemented for [tsibble()] (`tbl_ts`) obtained from
#' [dplyr::summarise()]. A formula with `~` followed by one of calendar component
#' functions from base, [lubridate] and [zoo] specifies the period when summary
#' functions are carried out. Currently `~ year()` indicates yearly aggregates.
#' `~ yearqtr()` indicates quarterly aggregates. `~ yearmon()` indicates
#' monthly aggregates. `~ as_date()` or `as.Date()` indicates daily aggregates.
#' @return A tsibble class when the `~` is present.
#'
#' @examples
#' # pkgs_ts <- as_tsibble(tidypkgs, key = key_vars(package), index = date)
#' # pkgs_ts %>%
#' # group_by(package) %>%
#' # summarise(avg_count = mean(count), month = ~ as.yearmon())
#'
#' @export
summarise.tbl_ts <- function(.data, ...) {
cls <- class(.data)
grped <- is.grouped_df(.data)
if (grped) grps <- groups(.data)
index <- get_index(.data)
dots_cap <- quos(..., .named = TRUE)
# Find the special formula from a set of quos
sp_f <- tilde_detect(dots_cap)
idx <- sp_f$index
if (is_empty(idx)) { # if there's no ~ in ..., tbl_ts is dropped
.data <- NextMethod()
# drop tbl_ts
return(structure(.data, class = c("tbl_ts", "tbl_df", "data.frame")))
} else {
str_time <- sp_f$var_name
sym_time <- sym(str_time)
fun <- sp_f$fun
# check whether fun is in the dictionary
if (is_false(fun %in% builtin_dict())) {
abort(paste(fun, "is not supported yet."))
}
# using group_by, sometimes it drops class attributes, e.g. as.yearmon
.data <- .data %>%
ungroup() %>%
dplyr::mutate(!!str_time := UQ(sym(fun))(!!index))
sum_args <- dots_cap[-idx] # used for summarise
if (grped) {
.data <- .data %>%
dplyr::group_by(!!!grps) %>%
dplyr::group_by(!!sym_time, add = TRUE)
} else {
.data <- .data %>%
dplyr::group_by(!!sym_time)
}
.data <- .data %>%
dplyr::summarise(!!!sum_args)
attr(.data, "key") <- if (grped) {
# ToDo: check if grouping vars should be key variables
map(grps, as_quosure)
} else {
key_vars()
}
attr(.data, "index") <- sym_time
attr(.data, "interval") <- pull_interval(
eval_tidy(sym_time, data = .data)
)
return(structure(.data, class = cls))
}
}
#' @rdname summarise
#' @export
summarize.tbl_ts <- summarise.tbl_ts
tilde_detect <- function(...) { # x be a list of quosures
dots_names <- names2(quos_auto_name(...))
strs <- dots2str(...)
sp_f <- grepl("^~", strs) # should only length(TRUE) <= 1
sp_idx <- which(sp_f == TRUE, useNames = FALSE)
sp_time <- gsub("^~(.*)\\()", "\\1", strs[sp_idx])
return(list(
index = sp_idx,
fun = sp_time,
var_name = dots_names[sp_idx]
))
}
builtin_dict <- function() {
return(c(
"year", "as.yearmon", "as.yearqtr", "as_date", "as.Date"
))
}
View
@@ -0,0 +1,11 @@
#' @importFrom zoo as.yearmon as.yearqtr
#' @importFrom lubridate year as_date date_decimal seconds_to_period
#' @importFrom tibble tibble as_tibble lst type_sum
#' @importFrom tidyr gather nest
#' @importFrom purrr map map_chr map_int map_lgl
#' @importFrom dplyr summarise summarize filter mutate select group_by ungroup
#' @importFrom dplyr groups select_vars bind_cols is.grouped_df
#' @importFrom magrittr %>%
#' @import rlang
#' @importFrom stats frequency time
NULL
Oops, something went wrong.

0 comments on commit aba1cfc

Please sign in to comment.