-
Notifications
You must be signed in to change notification settings - Fork 177
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request #237 from olivroy/lubridate
- Loading branch information
Showing
40 changed files
with
554 additions
and
201 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,210 @@ | ||
| # Taken from tidyverse | ||
| core <- c("xts", "quantmod", "TTR", "PerformanceAnalytics") | ||
|
|
||
| core_unloaded <- function() { | ||
| search <- paste0("package:", core) | ||
| core[!search %in% search()] | ||
| } | ||
|
|
||
| # Attach the package from the same package library it was | ||
| # loaded from before. https://github.com/tidyverse/tidyverse/issues/171 | ||
| same_library <- function(pkg) { | ||
| loc <- if (pkg %in% loadedNamespaces()) dirname(getNamespaceInfo(pkg, "path")) | ||
| library(pkg, lib.loc = loc, character.only = TRUE, warn.conflicts = FALSE) | ||
| } | ||
|
|
||
| tidyquant_attach <- function() { | ||
| to_load <- core_unloaded() | ||
|
|
||
| suppressPackageStartupMessages( | ||
| lapply(to_load, same_library) | ||
| ) | ||
|
|
||
| invisible(to_load) | ||
| } | ||
|
|
||
| tidyquant_attach_message <- function(to_load) { | ||
| if (length(to_load) == 0) { | ||
| return(NULL) | ||
| } | ||
|
|
||
| header <- cli::rule( | ||
| left = cli::style_bold("Attaching core tidyquant packages"), | ||
| right = paste0("tidyquant ", package_version_h("tidyquant")) | ||
| ) | ||
|
|
||
| to_load <- sort(to_load) | ||
| versions <- vapply(to_load, package_version_h, character(1)) | ||
|
|
||
| packages <- paste0( | ||
| cli::col_green(cli::symbol$tick), " ", cli::col_blue(format(to_load)), " ", | ||
| cli::ansi_align(versions, max(cli::ansi_nchar(versions))) | ||
| ) | ||
|
|
||
| if (length(packages) %% 2 == 1) { | ||
| packages <- append(packages, "") | ||
| } | ||
| col1 <- seq_len(length(packages) / 2) | ||
| info <- paste0(packages[col1], " ", packages[-col1]) | ||
|
|
||
| paste0(header, "\n", paste(info, collapse = "\n")) | ||
| } | ||
|
|
||
| package_version_h <- function(pkg) { | ||
| highlight_version(utils::packageVersion(pkg)) | ||
| } | ||
|
|
||
| highlight_version <- function(x) { | ||
| x <- as.character(x) | ||
|
|
||
| is_dev <- function(x) { | ||
| x <- suppressWarnings(as.numeric(x)) | ||
| !is.na(x) & x >= 9000 | ||
| } | ||
|
|
||
| pieces <- strsplit(x, ".", fixed = TRUE) | ||
| pieces <- lapply(pieces, function(x) ifelse(is_dev(x), cli::col_red(x), x)) | ||
| vapply(pieces, paste, collapse = ".", FUN.VALUE = character(1)) | ||
| } | ||
|
|
||
| #' Conflicts between the tidyquant and other packages | ||
| #' | ||
| #' This function lists all the conflicts between packages in the tidyverse | ||
| #' and other packages that you have loaded. | ||
| #' | ||
| #' There are four conflicts that are deliberately ignored: \code{intersect}, | ||
| #' \code{union}, \code{setequal}, and \code{setdiff} from dplyr. These functions | ||
| #' make the base equivalents generic, so shouldn't negatively affect any | ||
| #' existing code. | ||
| #' | ||
| #' @export | ||
| #' @param only Set this to a character vector to restrict to conflicts only | ||
| #' with these packages. | ||
| #' @examples | ||
| #' tidyquant_conflicts() | ||
| tidyquant_conflicts <- function(only = NULL) { | ||
| envs <- grep("^package:", search(), value = TRUE) | ||
| envs <- purrr::set_names(envs) | ||
|
|
||
| if (!is.null(only)) { | ||
| only <- union(only, core) | ||
| envs <- envs[names(envs) %in% paste0("package:", only)] | ||
| } | ||
|
|
||
| objs <- invert(lapply(envs, ls_env)) | ||
|
|
||
| conflicts <- purrr::keep(objs, ~ length(.x) > 1) | ||
|
|
||
| tidy_names <- paste0("package:", tidyquant_packages()) | ||
| conflicts <- purrr::keep(conflicts, ~ any(.x %in% tidy_names)) | ||
|
|
||
| conflict_funs <- purrr::imap(conflicts, confirm_conflict) | ||
| conflict_funs <- purrr::compact(conflict_funs) | ||
|
|
||
| structure(conflict_funs, class = "tidyquant_conflicts") | ||
| } | ||
|
|
||
| tidyquant_conflict_message <- function(x) { | ||
| header <- cli::rule( | ||
| left = cli::style_bold("Conflicts"), | ||
| right = "tidyquant_conflicts()" | ||
| ) | ||
|
|
||
| pkgs <- x %>% purrr::map(~ gsub("^package:", "", .)) | ||
| others <- pkgs %>% purrr::map(`[`, -1) | ||
| other_calls <- purrr::map2_chr( | ||
| others, names(others), | ||
| ~ paste0(cli::col_blue(.x), "::", .y, "()", collapse = ", ") | ||
| ) | ||
|
|
||
| winner <- pkgs %>% purrr::map_chr(1) | ||
| funs <- format(paste0(cli::col_blue(winner), "::", cli::col_green(paste0(names(x), "()")))) | ||
| bullets <- paste0( | ||
| cli::col_red(cli::symbol$cross), " ", funs, " masks ", other_calls, | ||
| collapse = "\n" | ||
| ) | ||
|
|
||
| conflicted <- paste0( | ||
| cli::col_cyan(cli::symbol$info), " ", | ||
| cli::format_inline("Use the {.href [conflicted package](http://conflicted.r-lib.org/)} to force all conflicts to become errors" | ||
| )) | ||
|
|
||
| paste0( | ||
| header, "\n", | ||
| bullets, "\n", | ||
| conflicted | ||
| ) | ||
| } | ||
|
|
||
| #' @export | ||
| print.tidyquant_conflicts <- function(x, ..., startup = FALSE) { | ||
| cli::cat_line(tidyquant_conflict_message(x)) | ||
| invisible(x) | ||
| } | ||
|
|
||
| #' @importFrom magrittr %>% | ||
| confirm_conflict <- function(packages, name) { | ||
| # Only look at functions | ||
| objs <- packages %>% | ||
| purrr::map(~ get(name, pos = .)) %>% | ||
| purrr::keep(is.function) | ||
|
|
||
| if (length(objs) <= 1) | ||
| return() | ||
|
|
||
| # Remove identical functions | ||
| objs <- objs[!duplicated(objs)] | ||
| packages <- packages[!duplicated(packages)] | ||
| if (length(objs) == 1) | ||
| return() | ||
|
|
||
| packages | ||
| } | ||
|
|
||
| ls_env <- function(env) { | ||
| x <- ls(pos = env) | ||
|
|
||
| # intersect, setdiff, setequal, union come from generics | ||
| if (env %in% c("package:dplyr", "package:lubridate")) { | ||
| x <- setdiff(x, c("intersect", "setdiff", "setequal", "union")) | ||
| } | ||
|
|
||
| if (env == "package:lubridate") { | ||
| x <- setdiff(x, c( | ||
| "as.difftime", # lubridate makes into an S4 generic | ||
| "date" # matches base behavior | ||
| )) | ||
| } | ||
|
|
||
| x | ||
| } | ||
|
|
||
| inform_startup <- function(msg, ...) { | ||
| if (is.null(msg)) { | ||
| return() | ||
| } | ||
| if (isTRUE(getOption("tidyquant.quiet"))) { | ||
| return() | ||
| } | ||
|
|
||
| rlang::inform(msg, ..., class = "packageStartupMessage") | ||
| } | ||
| tidyquant_packages <- function(include_self = TRUE) { | ||
| raw <- utils::packageDescription("tidyquant")$Imports | ||
| imports <- strsplit(raw, ",")[[1]] | ||
| parsed <- gsub("^\\s+|\\s+$", "", imports) | ||
| names <- vapply(strsplit(parsed, "\\s+"), "[[", 1, FUN.VALUE = character(1)) | ||
|
|
||
| if (include_self) { | ||
| names <- c(names, "tidyquant") | ||
| } | ||
|
|
||
| names | ||
| } | ||
|
|
||
| invert <- function(x) { | ||
| if (length(x) == 0) return() | ||
| stacked <- utils::stack(x) | ||
| tapply(as.character(stacked$ind), stacked$values, list) | ||
| } | ||
|
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.