init the package

.Rbuildignore

@@ -0,0 +1,5 @@
+^.*\.Rproj$
+^\.Rproj\.user$
+^Makefile$
+^data-raw$
+^README\.Rmd$

.gitignore

@@ -0,0 +1,5 @@
+.Rproj.user
+.Rhistory
+.RData
+.Ruserdata
+.DS_Store

DESCRIPTION

@@ -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)

Makefile

@@ -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()"

NAMESPACE

@@ -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)

R/dplyr-verbs.R

@@ -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"
+  ))
+}
+

R/imports.R

@@ -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