Browse Source

initial commit

master
boB Rudis 5 years ago
commit
27e4a5b75a
No known key found for this signature in database GPG Key ID: 1D7529BE14E2BBA9
  1. 11
      .Rbuildignore
  2. 1
      .codecov.yml
  3. 8
      .gitignore
  4. 6
      .travis.yml
  5. 30
      DESCRIPTION
  6. 2
      LICENSE
  7. 8
      NAMESPACE
  8. 2
      NEWS.md
  9. 16
      R/freebase-package.R
  10. 15
      R/use-infix-helpers.R
  11. 16
      R/use-keepers.R
  12. 15
      R/use-mappers.R
  13. 15
      R/use-safely.R
  14. 20
      R/utils.R
  15. 47
      README.Rmd
  16. 40
      README.md
  17. 21
      freebase.Rproj
  18. 3
      inst/templates/infix-helpers.R
  19. 17
      inst/templates/keepers.R
  20. 129
      inst/templates/mappers.R
  21. 90
      inst/templates/safely.R
  22. 19
      man/freebase.Rd
  23. 18
      man/use_infix_helpers.Rd
  24. 19
      man/use_keepers.Rd
  25. 18
      man/use_mappers.Rd
  26. 18
      man/use_safely.Rd
  27. 2
      tests/test-all.R
  28. 6
      tests/testthat/test-freebase.R

11
.Rbuildignore

@ -0,0 +1,11 @@
^.*\.Rproj$
^\.Rproj\.user$
^\.travis\.yml$
^README\.*Rmd$
^README\.*html$
^NOTES\.*Rmd$
^NOTES\.*html$
^\.codecov\.yml$
^README_files$
^doc$
^tmp$

1
.codecov.yml

@ -0,0 +1 @@
comment: false

8
.gitignore

@ -0,0 +1,8 @@
.DS_Store
.Rproj.user
.Rhistory
.RData
.Rproj
src/*.o
src/*.so
src/*.dll

6
.travis.yml

@ -0,0 +1,6 @@
language: R
sudo: false
cache: packages
after_success:
- Rscript -e 'covr::codecov()'

30
DESCRIPTION

@ -0,0 +1,30 @@
Package: freebase
Type: Package
Title: A 'usethis'-like Package for Base Pseudo-equivalents of 'tidyverse' Code
Version: 0.1.0
Date: 2018-05-28
Authors@R: c(
person("Bob", "Rudis", email = "bob@rud.is", role = c("aut", "cre"),
comment = c(ORCID = "0000-0001-5670-2640"))
)
Maintainer: Bob Rudis <bob@rud.is>
Description: The 'tidyverse' is awesome, but can take a bit compile on systems
where there are no pre-built binary packages. Methods are provided which use
the facilities of the 'usethis' package to snap-in base versions of useful
'tidyverse' functions that are mostly equivalent (some are more complete
than others). The base R counterpart functions will likely be slower than
the 'tidyverse' equivalents but using them will decrease 'Imports'
dependencies. Use delibrately and with caution.
URL: https://github.com/hrbrmstr/freebase
BugReports: https://github.com/hrbrmstr/freebase/issues
Encoding: UTF-8
License: MIT + file LICENSE
Suggests:
testthat,
covr
Depends:
R (>= 3.2.0)
Imports:
usethis,
rprojroot
RoxygenNote: 6.0.1.9000

2
LICENSE

@ -0,0 +1,2 @@
YEAR: 2018
COPYRIGHT HOLDER: Bob Rudis

8
NAMESPACE

@ -0,0 +1,8 @@
# Generated by roxygen2: do not edit by hand
export(use_infix_helpers)
export(use_keepers)
export(use_mappers)
export(use_safely)
import(rprojroot)
import(usethis)

2
NEWS.md

@ -0,0 +1,2 @@
0.1.0
* Initial release

16
R/freebase-package.R

@ -0,0 +1,16 @@
#' A 'usethis'-like Package for Base Pseudo-equivalents of 'tidyverse' Code
#'
#' The 'tidyverse' is awesome, but can take a bit compile on systems
#' where there are no pre-built binary packages. Methods are provided which use
#' the facilities of the 'usethis' package to snap-in base versions of useful
#' 'tidyverse' functions that are mostly equivalent (some are more complete
#' than others). The base R counterpart functions will likely be slower than
#' the 'tidyverse' equivalents but using them will decrease 'Imports'
#' dependencies. Use delibrately and with caution.
#'
#' @md
#' @name freebase
#' @docType package
#' @author Bob Rudis (bob@@rud.is)
#' @import usethis rprojroot
NULL

15
R/use-infix-helpers.R

@ -0,0 +1,15 @@
#' Use infix-helpers
#'
#' * Creates `R/utils-infix-helpers.R` with base R `%XXX%` helpers
#'
#' @md
#' @param save_as Where to save/what to name the file. Defaults to "`R/utils-infix-helpers.R`"
#' @param open if `TRUE`, open the resultant file
#' @export
use_infix_helpers <- function(save_as = "R/utils-infix-helpers.R", open = TRUE) {
check_is_package("use_infix_helpers()")
use_template("infix-helpers.R", save_as = save_as , open = open, package = "freebase")
}

16
R/use-keepers.R

@ -0,0 +1,16 @@
#' Use base-ified equivalents of keep/discard/compact
#'
#' * Creates `R/utils-keepers.R` with base R pseudo-equivalents for `purrr`
#' `keep`/`discard`/`compact`
#'
#' @md
#' @param save_as Where to save/what to name the file. Defaults to "`R/utils-keepers.R`"
#' @param open if `TRUE`, open the resultant file
#' @export
use_keepers <- function(save_as = "R/utils-keepers.R", open = TRUE) {
check_is_package("use_keepers()")
use_template("keepers.R", save_as = save_as , open = open, package = "freebase")
}

15
R/use-mappers.R

@ -0,0 +1,15 @@
#' Use base-ified equivalents of 'map'-pers
#'
#' * Creates `R/utils-mappers.R` with base R pseudo-equivalents for `purrr` `map`-pers.
#'
#' @md
#' @param save_as Where to save/what to name the file. Defaults to "`R/utils-mappers.R`"
#' @param open if `TRUE`, open the resultant file
#' @export
use_mappers <- function(save_as = "R/utils-mappers.R", open = TRUE) {
check_is_package("use_mappers()")
use_template("mappers.R", save_as = save_as , open = open, package = "freebase")
}

15
R/use-safely.R

@ -0,0 +1,15 @@
#' Use base-ified equivalents of "safely"-ifiers
#'
#' * Creates `R/utils-safely.R` with base R pseudo-equivalents for `purrr` `safely` (et al).
#'
#' @md
#' @param save_as Where to save/what to name the file. Defaults to "`R/utils-safely.R`"
#' @param open if `TRUE`, open the resultant file
#' @export
use_safely <- function(save_as = "R/utils-safely.R", open = TRUE) {
check_is_package("use_safely()")
use_template("safely.R", save_as = save_as , open = open, package = "freebase")
}

20
R/utils.R

@ -0,0 +1,20 @@
check_is_package <- function (whos_asking = NULL) {
if (is_package()) return(invisible())
message <- paste0("Project ", value(project_name()), " is not an R package.")
if (!is.null(whos_asking)) {
message <- paste0(code(whos_asking), " is designed to work with packages. ",
message)
}
stop(message, call. = FALSE)
}
is_package <- function (base_path = proj_get()){
res <- tryCatch(rprojroot::find_package_root_file(path = base_path),
error = function(e) NULL)
!is.null(res)
}

47
README.Rmd

@ -0,0 +1,47 @@
---
output: rmarkdown::github_document
---
# freebase
A 'usethis'-like Package for Base Pseudo-equivalents of 'tidyverse' Code
## Description
The 'tidyverse' is awesome, but can take a bit compile on systems
where there are no pre-built binary packages. Methods are provided which use
the facilities of the 'usethis' package to snap-in base versions of useful
'tidyverse' functions that are mostly equivalent (some are more complete
than others). The base R counterpart functions will likely be slower than
the 'tidyverse' equivalents but using them will decrease 'Imports'
dependencies. Use delibrately and with caution.
## What's Inside The Tin
The following functions are implemented:
- `use_infix_helpers`: Use infix-helpers
- `use_keepers`: Use base-ified equivalents of keep/discard/compact
- `use_mappers`: Use base-ified equivalents of 'map'-pers
- `use_safely`: Use base-ified equivalents of "safely"-ifiers
## Installation
```{r eval=FALSE}
devtools::install_github("hrbrmstr/freebase")
```
```{r message=FALSE, warning=FALSE, error=FALSE, include=FALSE}
options(width=120)
```
## Usage
```{r message=FALSE, warning=FALSE, error=FALSE}
library(freebase)
# current verison
packageVersion("freebase")
```

40
README.md

@ -0,0 +1,40 @@
# freebase
A ‘usethis’-like Package for Base Pseudo-equivalents of ‘tidyverse’ Code
## Description
The ‘tidyverse’ is awesome, but can take a bit compile on systems where
there are no pre-built binary packages. Methods are provided which use
the facilities of the ‘usethis’ package to snap-in base versions of
useful ‘tidyverse’ functions that are mostly equivalent (some are more
complete than others). The base R counterpart functions will likely be
slower than the ‘tidyverse’ equivalents but using them will decrease
‘Imports’ dependencies. Use delibrately and with caution.
## What’s Inside The Tin
The following functions are implemented:
- `use_infix_helpers`: Use infix-helpers
- `use_keepers`: Use base-ified equivalents of keep/discard/compact
- `use_mappers`: Use base-ified equivalents of ‘map’-pers
- `use_safely`: Use base-ified equivalents of “safely”-ifiers
## Installation
``` r
devtools::install_github("hrbrmstr/freebase")
```
## Usage
``` r
library(freebase)
# current verison
packageVersion("freebase")
```
## [1] '0.1.0'

21
freebase.Rproj

@ -0,0 +1,21 @@
Version: 1.0
RestoreWorkspace: Default
SaveWorkspace: Default
AlwaysSaveHistory: Default
EnableCodeIndexing: Yes
UseSpacesForTab: Yes
NumSpacesForTab: 2
Encoding: UTF-8
RnwWeave: Sweave
LaTeX: pdfLaTeX
StripTrailingWhitespace: Yes
BuildType: Package
PackageUseDevtools: Yes
PackageInstallArgs: --no-multiarch --with-keep.source
PackageBuildArgs: --resave-data
PackageRoxygenize: rd,collate,namespace

3
inst/templates/infix-helpers.R

@ -0,0 +1,3 @@
`%l0%` <- function(x, y) if (length(x) == 0) y else x
`%||%` <- function(x, y) if (is.null(x)) y else x
`%@%` <- function (x, name) attr(x, name, exact = TRUE)

17
inst/templates/keepers.R

@ -0,0 +1,17 @@
# NOTE!!!
# This requires map_lgl() which requries map()
is_empty <- function(x) length(x) == 0
keep <- function(.x, .p, ...) {
.x[map_lgl(.x, .p, ...)]
}
discard <- function(.x, .p, ...) {
.x[!map_lgl(.x, .p, ...)]
}
compact <- function(.x, .p=identity) {
discard(.x, function(x) is_empty(.p(x)))
}

129
inst/templates/mappers.R

@ -0,0 +1,129 @@
# NOTE these aren't 100% equivalent to the purrr mappers but cover very common use-cases
map <- function(.x, .f, ...) {
if (inherits(.f, "formula")) {
.body <- dimnames(attr(terms(.f), "factors"))[[1]]
.f <- function(.x, .=.x) {}
body(.f) <- as.expression(parse(text=.body))
}
if (inherits(.f, "function")) {
lapply(.x, .f, ...)
} else if (is.numeric(.f)) {
lapply(.x, `[`, .f)
}
}
map2 <- function(.x, .y, .f, ...) {
if (inherits(.f, "formula")) {
.body <- dimnames(attr(terms(.f), "factors"))[[1]]
.f <- function(.x, .y, .=.x) {}
body(.f) <- as.expression(parse(text=.body))
}
if (inherits(.f, "function")) {
mapply(.f, .x, .y, ..., SIMPLIFY=FALSE, USE.NAMES=FALSE)
}
}
map_chr <- function(.x, .f, ...) {
as.character(unlist(map(.x, .f, ...), use.names = FALSE))
}
map2_chr <- function(.x, .y, .f, ...) {
as.character(unlist(map2(.x, .y, .f, ...), use.names = FALSE))
}
map_lgl <- function(.x, .f, ...) {
as.logical(unlist(map(.x, .f, ...), use.names = FALSE))
}
map2_lgl <- function(.x, .y, .f, ...) {
as.logical(unlist(map2(.x, .y, .f, ...), use.names = FALSE))
}
map_dbl <- function(.x, .f, ...) {
as.double(unlist(map(.x, .f, ...), use.names = FALSE))
}
map2_dbl <- function(.x, .y, .f, ...) {
as.double(unlist(map2(.x, .y, .f, ...), use.names = FALSE))
}
map_int <- function(.x, .f, ...) {
as.integer(unlist(map(.x, .f, ...), use.names = FALSE))
}
map2_int <- function(.x, .y, .f, ...) {
as.integer(unlist(map2(.x, .y, .f, ...), use.names = FALSE))
}
map_df <- function(.x, .f, ..., .id=NULL) {
res <- map(.x, .f, ...)
out <- bind_rows(res, .id=.id)
out
}
map2_df <- function(.x, .y, .f, ..., .id=NULL) {
res <- map(.x, .y, .f, ...)
out <- bind_rows(res, .id=.id)
out
}
# this has limitations and is more like 75% of dplyr::bind_rows()
# this is also orders of magnitude slower than dplyr::bind_rows()
bind_rows <- function(..., .id = NULL) {
res <- list(...)
if (length(res) == 1) res <- res[[1]]
cols <- unique(unlist(lapply(res, names), use.names = FALSE))
if (!is.null(.id)) {
inthere <- cols[.id %in% cols]
if (length(inthere) > 0) {
.id <- make.unique(c(inthere, .id))[2]
}
}
id_vals <- if (is.null(names(res))) 1:length(res) else names(res)
saf <- default.stringsAsFactors()
options(stringsAsFactors = FALSE)
on.exit(options(stringsAsFactors = saf))
idx <- 1
do.call(
rbind.data.frame,
lapply(res, function(.x) {
x_names <- names(.x)
moar_names <- setdiff(cols, x_names)
if (length(moar_names) > 0) {
for (i in 1:length(moar_names)) {
.x[[moar_names[i]]] <- rep(NA, length(.x[[1]]))
}
}
if (!is.null(.id)) {
.x[[.id]] <- id_vals[idx]
idx <<- idx + 1
}
.x
})
) -> out
rownames(out) <- NULL
class(out) <- c("tbl_df", "tbl", "data.frame")
out
}

90
inst/templates/safely.R

@ -0,0 +1,90 @@
# Less cool counterparts to purrr's side-effect capture-rs
#
# Most of the helper functions are 100% from output.R in purrr repo
#
# @param quiet Hide errors (`TRUE`, the default), or display them
# as they occur?
# @param otherwise Default value to use when an error occurs.
#
# @return `safely`: wrapped function instead returns a list with
# components `result` and `error`. One value is always `NULL`.
#
# `quietly`: wrapped function instead returns a list with components
# `result`, `output`, `messages` and `warnings`.
#
# `possibly`: wrapped function uses a default value (`otherwise`)
# whenever an error occurs.
safely <- function(.f, otherwise = NULL, quiet = TRUE) {
function(...) capture_error(.f(...), otherwise, quiet)
}
quietly <- function(.f) {
function(...) capture_output(.f(...))
}
possibly <- function(.f, otherwise, quiet = TRUE) {
force(otherwise)
function(...) {
tryCatch(.f(...),
error = function(e) {
if (!quiet)
message("Error: ", e$message)
otherwise
},
interrupt = function(e) {
stop("Terminated by user", call. = FALSE)
}
)
}
}
capture_error <- function(code, otherwise = NULL, quiet = TRUE) {
tryCatch(
list(result = code, error = NULL),
error = function(e) {
if (!quiet)
message("Error: ", e$message)
list(result = otherwise, error = e)
},
interrupt = function(e) {
stop("Terminated by user", call. = FALSE)
}
)
}
capture_output <- function(code) {
warnings <- character()
wHandler <- function(w) {
warnings <<- c(warnings, w$message)
invokeRestart("muffleWarning")
}
messages <- character()
mHandler <- function(m) {
messages <<- c(messages, m$message)
invokeRestart("muffleMessage")
}
temp <- file()
sink(temp)
on.exit({
sink()
close(temp)
})
result <- withCallingHandlers(
code,
warning = wHandler,
message = mHandler
)
output <- paste0(readLines(temp, warn = FALSE), collapse = "\n")
list(
result = result,
output = output,
warnings = warnings,
messages = messages
)
}

19
man/freebase.Rd

@ -0,0 +1,19 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/freebase-package.R
\docType{package}
\name{freebase}
\alias{freebase}
\alias{freebase-package}
\title{A 'usethis'-like Package for Base Pseudo-equivalents of 'tidyverse' Code}
\description{
The 'tidyverse' is awesome, but can take a bit compile on systems
where there are no pre-built binary packages. Methods are provided which use
the facilities of the 'usethis' package to snap-in base versions of useful
'tidyverse' functions that are mostly equivalent (some are more complete
than others). The base R counterpart functions will likely be slower than
the 'tidyverse' equivalents but using them will decrease 'Imports'
dependencies. Use delibrately and with caution.
}
\author{
Bob Rudis (bob@rud.is)
}

18
man/use_infix_helpers.Rd

@ -0,0 +1,18 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/use-infix-helpers.R
\name{use_infix_helpers}
\alias{use_infix_helpers}
\title{Use infix-helpers}
\usage{
use_infix_helpers(save_as = "R/utils-infix-helpers.R", open = TRUE)
}
\arguments{
\item{save_as}{Where to save/what to name the file. Defaults to "\code{R/utils-infix-helpers.R}"}
\item{open}{if \code{TRUE}, open the resultant file}
}
\description{
\itemize{
\item Creates \code{R/utils-infix-helpers.R} with base R \code{\%XXX\%} helpers
}
}

19
man/use_keepers.Rd

@ -0,0 +1,19 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/use-keepers.R
\name{use_keepers}
\alias{use_keepers}
\title{Use base-ified equivalents of keep/discard/compact}
\usage{
use_keepers(save_as = "R/utils-keepers.R", open = TRUE)
}
\arguments{
\item{save_as}{Where to save/what to name the file. Defaults to "\code{R/utils-keepers.R}"}
\item{open}{if \code{TRUE}, open the resultant file}
}
\description{
\itemize{
\item Creates \code{R/utils-keepers.R} with base R pseudo-equivalents for \code{purrr}
\code{keep}/\code{discard}/\code{compact}
}
}

18
man/use_mappers.Rd

@ -0,0 +1,18 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/use-mappers.R
\name{use_mappers}
\alias{use_mappers}
\title{Use base-ified equivalents of 'map'-pers}
\usage{
use_mappers(save_as = "R/utils-mappers.R", open = TRUE)
}
\arguments{
\item{save_as}{Where to save/what to name the file. Defaults to "\code{R/utils-mappers.R}"}
\item{open}{if \code{TRUE}, open the resultant file}
}
\description{
\itemize{
\item Creates \code{R/utils-mappers.R} with base R pseudo-equivalents for \code{purrr} \code{map}-pers.
}
}

18
man/use_safely.Rd

@ -0,0 +1,18 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/use-safely.R
\name{use_safely}
\alias{use_safely}
\title{Use base-ified equivalents of "safely"-ifiers}
\usage{
use_safely(save_as = "R/utils-safely.R", open = TRUE)
}
\arguments{
\item{save_as}{Where to save/what to name the file. Defaults to "\code{R/utils-safely.R}"}
\item{open}{if \code{TRUE}, open the resultant file}
}
\description{
\itemize{
\item Creates \code{R/utils-safely.R} with base R pseudo-equivalents for \code{purrr} \code{safely} (et al).
}
}

2
tests/test-all.R

@ -0,0 +1,2 @@
library(testthat)
test_check("freebase")

6
tests/testthat/test-freebase.R

@ -0,0 +1,6 @@
context("minimal package functionality")
test_that("we can do something", {
#expect_that(some_function(), is_a("data.frame"))
})
Loading…
Cancel
Save