zeallot/ 0000755 0001762 0000144 00000000000 13233373325 011730 5 ustar ligges users zeallot/inst/ 0000755 0001762 0000144 00000000000 13233123577 012707 5 ustar ligges users zeallot/inst/doc/ 0000755 0001762 0000144 00000000000 13233123577 013454 5 ustar ligges users zeallot/inst/doc/unpacking-assignment.html 0000644 0001762 0000144 00000154073 13233132151 020465 0 ustar ligges users
Unpacking Assignment
Unpacking Assignment
2018-01-27
Getting Started
The zeallot package defines an operator for unpacking assignment, sometimes called parallel assignment or destructuring assignment in other programming languages. The operator is written as %<-%
and used like this.
The result is that the list is unpacked into its elements, and the elements are assigned to lat
and lng
.
You can also unpack the elements of a vector.
You can unpack much longer structures, too, of course, such as the 6-part summary of a vector.
If the left-hand side and right-hand sides do not match, an error is raised. This guards against missing or unexpected values.
Unpacking a returned value
A common use-case is when a function returns a list of values and you want to extract the individual values. In this example, the list of values returned by coords_list()
is unpacked into the variables lat
and lng
.
In this next example, we call a function that returns a vector.
Example: Intercept and slope of regression
You can directly unpack the coefficients of a simple linear regression into the intercept and slope.
Example: Unpacking the result of safely
The purrr package includes the safely
function. It wraps a given function to create a new, “safe” version of the original function.
The safe version returns a list of two items. The first item is the result of calling the original function, assuming no error occurred; or NULL
if an error did occur. The second item is the error, if an error occurred; or NULL
if no error occurred. Whether or not the original function would have thrown an error, the safe version will never throw an error.
You can tighten and clarify calls to the safe function by using %<-%
.
Unpacking a data frame
A data frame is simply a list of columns, so the zeallot assignment does what you expect. It unpacks the data frame into individual columns.
Example: List of data frames
Bear in mind that a list of data frames is still just a list. The assignment will extract the list elements (which are data frames) but not unpack the data frames themselves.
The %<-%
operator assigned four data frames to four variables, leaving the data frames intact.
Unpacking nested values
In addition to unpacking flat lists, you can unpack lists of lists.
Not only does this simplify extracting individual elements, it also adds a level of checking. If the described list structure does not match the actual list structure, an error is raised.
Splitting a value into its parts
The previous examples dealt with unpacking a list or vector into its elements. You can also split certain kinds of individual values into subvalues.
Character vectors
You can assign individual characters of a string to variables.
Dates
You can split a Date into its year, month, and day, and assign the parts to variables.
Class objects
zeallot includes implementations of destructure
for character strings, complex numbers, data frames, date objects, and linear model summaries. However, because destructure
is a generic function, you can define new implementations for custom classes. When defining a new implementation keep in mind the implementation needs to return a list so that values are properly unpacked.
Trailing values: the “everything else” clause
In some cases, you want the first few elements of a list or vector but do not care about the trailing elements. The summary
function of lm
, for example, returns a list of 11 values, and you might want only the first few. Fortunately, there is a way to capture those first few and say “don’t worry about everything else”.
f <- lm(mpg ~ cyl, data = mtcars)
c(fcall, fterms, resids, ...rest) %<-% summary(f)
fcall
#> lm(formula = mpg ~ cyl, data = mtcars)
fterms
#> mpg ~ cyl
#> attr(,"variables")
#> list(mpg, cyl)
#> attr(,"factors")
#> cyl
#> mpg 0
#> cyl 1
#> attr(,"term.labels")
#> [1] "cyl"
#> attr(,"order")
#> [1] 1
#> attr(,"intercept")
#> [1] 1
#> attr(,"response")
#> [1] 1
#> attr(,".Environment")
#> <environment: R_GlobalEnv>
#> attr(,"predvars")
#> list(mpg, cyl)
#> attr(,"dataClasses")
#> mpg cyl
#> "numeric" "numeric"
head(resids)
#> Mazda RX4 Mazda RX4 Wag Datsun 710 Hornet 4 Drive
#> 0.3701643 0.3701643 -3.5814159 0.7701643
#> Hornet Sportabout Valiant
#> 3.8217446 -2.5298357
Here, rest
will capture everything else.
The assignment operator noticed that ...rest
is prefixed with ...
, and it created a variable called rest
for the trailing values of the list. If you omitted the “everything else” prefix, there would be an error because the lengths of the left- and right-hand sides of the assignment would be mismatched.
If multiple collector variables are specified at a particular depth it is ambiguous which values to assign to which collector and an error will be raised.
Leading values and middle values
In addition to collecting trailing values, you can also collect initial values and assign specific remaining values.
Or you can assign the first value, skip values, and then assign the last value.
Skipped values: anonymous elements
You can skip one or more values without raising an error by using a period (.
) instead of a variable name. For example, you might care only about the min, mean, and max values of a vector’s summary
.
By combining an anonymous element (.
) with the collector prefix, (...
), you can ignore whole sublists.
You can mix periods and collectors together to selectively keep and discard elements.
It is important to note that although value(s) are skipped they are still expected. The next section touches on how to handle missing values.
Default values: handle missing values
You can specify a default value for a left-hand side variable using =
, similar to specifying the default value of a function argument. This comes in handy when the number of elements returned by a function cannot be guaranteed. tail
for example may return fewer elements than asked for.
However, if we tried to get 3 elements and assign them an error would be raised because tail(nums, 3)
still returns only 2 values.
We can fix the problem and resolve the error by specifying a default value for z
.
Swapping values
A handy trick is swapping values without the use of a temporary variable.
or
Right operator
The magrittr
package provides a pipe operator %>%
which allows functions to be called in succession instead of nested. The left operator %<-%
does not work well with these function chains. Instead, the right operator %->%
is recommended. The below example is adapted from the magrittr
readme.
zeallot/inst/doc/unpacking-assignment.Rmd 0000644 0001762 0000144 00000021751 13233124322 020240 0 ustar ligges users ---
title: "Unpacking Assignment"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{Unpacking Assignment}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
```{R, include = FALSE}
knitr::opts_chunk$set(collapse = TRUE, comment = "#>")
library(zeallot)
```
## Getting Started
The *zeallot* package defines an operator for *unpacking assignment*, sometimes
called *parallel assignment* or *destructuring assignment* in other programming
languages. The operator is written as `%<-%` and used like this.
```{r}
c(lat, lng) %<-% list(38.061944, -122.643889)
```
The result is that the list is unpacked into its elements,
and the elements are assigned to `lat` and `lng`.
```{r}
lat
lng
```
You can also unpack the elements of a vector.
```{r}
c(lat, lng) %<-% c(38.061944, -122.643889)
lat
lng
```
You can unpack much longer structures, too, of course, such as the 6-part
summary of a vector.
```{r}
c(min_wt, q1_wt, med_wt, mean_wt, q3_wt, max_wt) %<-% summary(mtcars$wt)
min_wt
q1_wt
med_wt
mean_wt
q3_wt
max_wt
```
If the left-hand side and right-hand sides do not match, an error is raised.
This guards against missing or unexpected values.
```{r, error=TRUE}
c(stg1, stg2, stg3) %<-% list("Moe", "Donald")
```
```{r, error=TRUE}
c(stg1, stg2, stg3) %<-% list("Moe", "Larry", "Curley", "Donald")
```
### Unpacking a returned value
A common use-case is when a function returns a list of values
and you want to extract the individual values.
In this example, the list of values returned by `coords_list()` is unpacked
into the variables `lat` and `lng`.
```{r}
#
# A function which returns a list of 2 numeric values.
#
coords_list <- function() {
list(38.061944, -122.643889)
}
c(lat, lng) %<-% coords_list()
lat
lng
```
In this next example, we call a function that returns a vector.
```{r}
#
# Convert cartesian coordinates to polar
#
to_polar = function(x, y) {
c(sqrt(x^2 + y^2), atan(y / x))
}
c(radius, angle) %<-% to_polar(12, 5)
radius
angle
```
### Example: Intercept and slope of regression
You can directly unpack the coefficients of a simple linear regression
into the intercept and slope.
```{r}
c(inter, slope) %<-% coef(lm(mpg ~ cyl, data = mtcars))
inter
slope
```
### Example: Unpacking the result of `safely`
The *purrr* package includes the `safely` function.
It wraps a given function to create a new, "safe" version of the original function.
```{R, eval = require("purrr")}
safe_log <- purrr::safely(log)
```
The safe version returns a list of two items. The first item is the result of
calling the original function, assuming no error occurred; or `NULL` if an error
did occur. The second item is the error, if an error occurred; or `NULL` if no
error occurred. Whether or not the original function would have thrown an error,
the safe version will never throw an error.
```{r, eval = require("purrr")}
pair <- safe_log(10)
pair$result
pair$error
```
```{r, eval = require("purrr")}
pair <- safe_log("donald")
pair$result
pair$error
```
You can tighten and clarify calls to the safe function by using `%<-%`.
```{r, eval = require("purrr")}
c(res, err) %<-% safe_log(10)
res
err
```
## Unpacking a data frame
A data frame is simply a list of columns, so the *zeallot* assignment does
what you expect. It unpacks the data frame into individual columns.
```{r}
c(mpg, cyl, disp, hp) %<-% mtcars[, 1:4]
head(mpg)
head(cyl)
head(disp)
head(hp)
```
### Example: List of data frames
Bear in mind that a list of data frames is still just a list. The assignment
will extract the list elements (which are data frames) but not unpack the data
frames themselves.
```{R}
quartet <- lapply(1:4, function(i) anscombe[, c(i, i + 4)])
c(an1, an2, an3, an4) %<-% lapply(quartet, head, n = 3)
an1
an2
an3
an4
```
The `%<-%` operator assigned four data frames to four variables, leaving the
data frames intact.
## Unpacking nested values
In addition to unpacking flat lists, you can unpack lists of lists.
```{r}
c(a, c(b, d), e) %<-% list("begin", list("middle1", "middle2"), "end")
a
b
d
e
```
Not only does this simplify extracting individual elements, it also adds a level
of checking. If the described list structure does not match the actual list
structure, an error is raised.
```{r, error=TRUE}
c(a, c(b, d, e), f) %<-% list("begin", list("middle1", "middle2"), "end")
```
## Splitting a value into its parts
The previous examples dealt with unpacking a list or vector into its elements.
You can also split certain kinds of individual values into subvalues.
### Character vectors
You can assign individual characters of a string to variables.
```{r}
c(ch1, ch2, ch3) %<-% "abc"
ch1
ch2
ch3
```
### Dates
You can split a Date into its year, month, and day, and assign the parts to
variables.
```{r}
c(y, m, d) %<-% Sys.Date()
y
m
d
```
### Class objects
*zeallot* includes implementations of `destructure` for character strings,
complex numbers, data frames, date objects, and linear model summaries.
However, because `destructure` is a generic function, you can define new
implementations for custom classes. When defining a new implementation keep in
mind the implementation needs to return a list so that values are properly
unpacked.
## Trailing values: the "everything else" clause
In some cases, you want the first few elements of a list or vector but do not
care about the trailing elements. The `summary` function of `lm`, for example,
returns a list of 11 values, and you might want only the first few. Fortunately,
there is a way to capture those first few and say "don't worry about everything
else".
```{r}
f <- lm(mpg ~ cyl, data = mtcars)
c(fcall, fterms, resids, ...rest) %<-% summary(f)
fcall
fterms
head(resids)
```
Here, `rest` will capture everything else.
```{r}
str(rest)
```
The assignment operator noticed that `...rest` is prefixed with `...`, and it
created a variable called `rest` for the trailing values of the list. If you
omitted the "everything else" prefix, there would be an error because the
lengths of the left- and right-hand sides of the assignment would be mismatched.
```{r, error = TRUE}
c(fcall, fterms, resids, rest) %<-% summary(f)
```
If multiple collector variables are specified at a particular depth it is
ambiguous which values to assign to which collector and an error will be raised.
## Leading values and middle values
In addition to collecting trailing values, you can also collect initial values
and assign specific remaining values.
```{r}
c(...skip, e, f) %<-% list(1, 2, 3, 4, 5)
skip
e
f
```
Or you can assign the first value, skip values, and then assign the last value.
```{r}
c(begin, ...middle, end) %<-% list(1, 2, 3, 4, 5)
begin
middle
end
```
## Skipped values: anonymous elements
You can skip one or more values without raising an error by using a period (`.`)
instead of a variable name. For example, you might care only about the min,
mean, and max values of a vector's `summary`.
```{r}
c(min_wt, ., ., mean_wt, ., max_wt) %<-% summary(mtcars$wt)
min_wt
mean_wt
max_wt
```
By combining an anonymous element (`.`) with the collector prefix, (`...`), you
can ignore whole sublists.
```{r}
c(begin, ..., end) %<-% list("hello", "blah", list("blah"), "blah", "world!")
begin
end
```
You can mix periods and collectors together to selectively keep and discard
elements.
```{r}
c(begin, ., ...middle, end) %<-% as.list(1:5)
begin
middle
end
```
It is important to note that although value(s) are skipped they are still
expected. The next section touches on how to handle missing values.
## Default values: handle missing values
You can specify a default value for a left-hand side variable using `=`, similar
to specifying the default value of a function argument. This comes in handy when
the number of elements returned by a function cannot be guaranteed. `tail` for
example may return fewer elements than asked for.
```{r}
nums <- 1:2
c(x, y) %<-% tail(nums, 2)
x
y
```
However, if we tried to get 3 elements and assign them an error would be raised
because `tail(nums, 3)` still returns only 2 values.
```{r, error = TRUE}
c(x, y, z) %<-% tail(nums, 3)
```
We can fix the problem and resolve the error by specifying a default value for
`z`.
```{r}
c(x, y, z = NULL) %<-% tail(nums, 3)
x
y
z
```
## Swapping values
A handy trick is swapping values without the use of a temporary variable.
```{r}
c(first, last) %<-% c("Ai", "Genly")
first
last
c(first, last) %<-% c(last, first)
first
last
```
or
```{r}
cat <- "meow"
dog <- "bark"
c(cat, dog, fish) %<-% c(dog, cat, dog)
cat
dog
fish
```
## Right operator
The `magrittr` package provides a pipe operator `%>%` which allows functions
to be called in succession instead of nested. The left operator `%<-%`
does not work well with these function chains. Instead, the right operator
`%->%` is recommended. The below example is adapted from the `magrittr` readme.
```{r, eval = require("magrittr")}
library(magrittr)
mtcars %>%
subset(hp > 100) %>%
aggregate(. ~ cyl, data = ., FUN = . %>% mean() %>% round(2)) %>%
transform(kpl = mpg %>% multiply_by(0.4251)) %->%
c(cyl, mpg, ...rest)
cyl
mpg
rest
```
zeallot/inst/doc/unpacking-assignment.R 0000644 0001762 0000144 00000011672 13233132150 017716 0 ustar ligges users ## ---- include = FALSE----------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>")
library(zeallot)
## ------------------------------------------------------------------------
c(lat, lng) %<-% list(38.061944, -122.643889)
## ------------------------------------------------------------------------
lat
lng
## ------------------------------------------------------------------------
c(lat, lng) %<-% c(38.061944, -122.643889)
lat
lng
## ------------------------------------------------------------------------
c(min_wt, q1_wt, med_wt, mean_wt, q3_wt, max_wt) %<-% summary(mtcars$wt)
min_wt
q1_wt
med_wt
mean_wt
q3_wt
max_wt
## ---- error=TRUE---------------------------------------------------------
c(stg1, stg2, stg3) %<-% list("Moe", "Donald")
## ---- error=TRUE---------------------------------------------------------
c(stg1, stg2, stg3) %<-% list("Moe", "Larry", "Curley", "Donald")
## ------------------------------------------------------------------------
#
# A function which returns a list of 2 numeric values.
#
coords_list <- function() {
list(38.061944, -122.643889)
}
c(lat, lng) %<-% coords_list()
lat
lng
## ------------------------------------------------------------------------
#
# Convert cartesian coordinates to polar
#
to_polar = function(x, y) {
c(sqrt(x^2 + y^2), atan(y / x))
}
c(radius, angle) %<-% to_polar(12, 5)
radius
angle
## ------------------------------------------------------------------------
c(inter, slope) %<-% coef(lm(mpg ~ cyl, data = mtcars))
inter
slope
## ---- eval = require("purrr")--------------------------------------------
safe_log <- purrr::safely(log)
## ---- eval = require("purrr")--------------------------------------------
pair <- safe_log(10)
pair$result
pair$error
## ---- eval = require("purrr")--------------------------------------------
pair <- safe_log("donald")
pair$result
pair$error
## ---- eval = require("purrr")--------------------------------------------
c(res, err) %<-% safe_log(10)
res
err
## ------------------------------------------------------------------------
c(mpg, cyl, disp, hp) %<-% mtcars[, 1:4]
head(mpg)
head(cyl)
head(disp)
head(hp)
## ------------------------------------------------------------------------
quartet <- lapply(1:4, function(i) anscombe[, c(i, i + 4)])
c(an1, an2, an3, an4) %<-% lapply(quartet, head, n = 3)
an1
an2
an3
an4
## ------------------------------------------------------------------------
c(a, c(b, d), e) %<-% list("begin", list("middle1", "middle2"), "end")
a
b
d
e
## ---- error=TRUE---------------------------------------------------------
c(a, c(b, d, e), f) %<-% list("begin", list("middle1", "middle2"), "end")
## ------------------------------------------------------------------------
c(ch1, ch2, ch3) %<-% "abc"
ch1
ch2
ch3
## ------------------------------------------------------------------------
c(y, m, d) %<-% Sys.Date()
y
m
d
## ------------------------------------------------------------------------
f <- lm(mpg ~ cyl, data = mtcars)
c(fcall, fterms, resids, ...rest) %<-% summary(f)
fcall
fterms
head(resids)
## ------------------------------------------------------------------------
str(rest)
## ---- error = TRUE-------------------------------------------------------
c(fcall, fterms, resids, rest) %<-% summary(f)
## ------------------------------------------------------------------------
c(...skip, e, f) %<-% list(1, 2, 3, 4, 5)
skip
e
f
## ------------------------------------------------------------------------
c(begin, ...middle, end) %<-% list(1, 2, 3, 4, 5)
begin
middle
end
## ------------------------------------------------------------------------
c(min_wt, ., ., mean_wt, ., max_wt) %<-% summary(mtcars$wt)
min_wt
mean_wt
max_wt
## ------------------------------------------------------------------------
c(begin, ..., end) %<-% list("hello", "blah", list("blah"), "blah", "world!")
begin
end
## ------------------------------------------------------------------------
c(begin, ., ...middle, end) %<-% as.list(1:5)
begin
middle
end
## ------------------------------------------------------------------------
nums <- 1:2
c(x, y) %<-% tail(nums, 2)
x
y
## ---- error = TRUE-------------------------------------------------------
c(x, y, z) %<-% tail(nums, 3)
## ------------------------------------------------------------------------
c(x, y, z = NULL) %<-% tail(nums, 3)
x
y
z
## ------------------------------------------------------------------------
c(first, last) %<-% c("Ai", "Genly")
first
last
c(first, last) %<-% c(last, first)
first
last
## ------------------------------------------------------------------------
cat <- "meow"
dog <- "bark"
c(cat, dog, fish) %<-% c(dog, cat, dog)
cat
dog
fish
## ---- eval = require("magrittr")-----------------------------------------
library(magrittr)
mtcars %>%
subset(hp > 100) %>%
aggregate(. ~ cyl, data = ., FUN = . %>% mean() %>% round(2)) %>%
transform(kpl = mpg %>% multiply_by(0.4251)) %->%
c(cyl, mpg, ...rest)
cyl
mpg
rest
zeallot/tests/ 0000755 0001762 0000144 00000000000 13233122505 013062 5 ustar ligges users zeallot/tests/testthat.R 0000644 0001762 0000144 00000000072 13233122505 015044 0 ustar ligges users library(testthat)
library(zeallot)
test_check("zeallot")
zeallot/tests/testthat/ 0000755 0001762 0000144 00000000000 13233373325 014732 5 ustar ligges users zeallot/tests/testthat/test-utils.R 0000644 0001762 0000144 00000003317 13233123122 017162 0 ustar ligges users context(" * testing utils")
test_that("is_list returns TRUE for list object", {
expect_true(is_list(list(1, 2, 3)))
})
test_that("is_list returns FALSE for objects with multiple classes", {
expect_false(is_list(summary(x ~ y)))
expect_silent(is_list(summary(x ~ y)))
})
test_that("is_list returns FALSE for S3 objects", {
sumry <- summary(lm(mpg ~ disp, data = mtcars))
expect_false(is_list(sumry))
})
test_that("is_list returns FALSE for data frames", {
expect_false(is_list(mtcars))
})
test_that("is_extract_op returns TRUE for valid operators", {
expect_true(is_extract_op("$"))
expect_true(is_extract_op("["))
expect_true(is_extract_op("[["))
})
test_that("is_extract_op returns FALSE for 0 length argument", {
expect_false(is_extract_op(character(0)))
expect_false(is_extract_op(NULL))
})
test_that("is_valid_call returns TRUE for all valid calls", {
expect_true(is_valid_call("c"))
expect_true(is_valid_call("="))
expect_true(is_valid_call("$"))
expect_false(is_valid_call(2))
expect_false(is_valid_call("mean"))
})
test_that("is_valid_call returns FALSE for 0 length argument", {
expect_false(is_valid_call(NULL))
expect_false(is_valid_call(integer(0)))
})
test_that("car throws error for non-list or 0 length list", {
expect_error(car(1), "cons")
expect_error(car(list()), "length")
})
test_that("car returns first element of list", {
expect_equal(car(list(1, 2)), 1)
expect_equal(car(list(list(1, 2), 3)), list(1, 2))
})
test_that("traverse_to_extractee gets flat and nested extractees", {
s1 <- substitute(x[[1]])
expect_equal(as.character(traverse_to_extractee(s1)), "x")
s2 <- substitute(y[[1]][[3030]])
expect_equal(as.character(traverse_to_extractee(s2)), "y")
})
zeallot/tests/testthat/test-pipe.R 0000644 0001762 0000144 00000001455 13233122505 016764 0 ustar ligges users context(' * testing %>% expressions')
test_that('%<-% and %>% caveat', {
skip('must wrap piped expressions in parentheses or use right operator')
})
test_that('%<-% assign magrittr chain vector', {
skip_if_not_installed('magrittr')
library(magrittr)
expect_silent(
c(a, b, c, d, e) %<-% (
1:5 %>%
vapply(`+`, numeric(1), 5) %>%
as.character
)
)
expect_equal(a, '6')
expect_equal(b, '7')
expect_equal(c, '8')
expect_equal(d, '9')
expect_equal(e, '10')
})
test_that('%<-% assign magrittr chain list', {
skip_if_not_installed('magrittr')
library(magrittr)
expect_silent(
c(a, ...b) %<-% (
1:5 %>%
vapply(`==`, logical(1), 1) %>%
as.list
)
)
expect_equal(a, TRUE)
expect_equal(b, list(FALSE, FALSE, FALSE, FALSE))
})
zeallot/tests/testthat/test-collect.R 0000644 0001762 0000144 00000002406 13233122505 017451 0 ustar ligges users context(" * testing collect")
test_that("collect throws error if no collector variable specified", {
expect_error(collect(list("a", "b"), list(1, 2)), "no collector variable")
})
test_that("collect names and values of equal lengths", {
expect_equal(collect(list("a", "...b"), list(1, 2)), list(1, 2))
})
test_that("collect beginning of values", {
expect_equal(
collect(list("...first", "a"), list(1, 2, 3)),
list(list(1, 2), 3)
)
expect_equal(
collect(list("...first", "a", "b"), as.list(1:5)),
list(list(1, 2, 3), 4, 5)
)
})
test_that("collect middle of values", {
expect_equal(
collect(list("a", "...mid", "b"), list(1, 2, 3, 4)),
list(1, list(2, 3), 4))
expect_equal(
collect(list("a", "b", "...mid", "c"), as.list(1:6)),
list(1, 2, list(3, 4, 5), 6)
)
expect_equal(
collect(list("a", "...mid", "b", "c"), as.list(1:6)),
list(1, list(2, 3, 4), 5, 6)
)
expect_equal(
collect(list("a", "b", "...mid", "c", "d"), as.list(1:6)),
list(1, 2, list(3, 4), 5, 6)
)
})
test_that("collect rest of values", {
expect_equal(
collect(list("a", "...rest"), list(1, 2, 3)),
list(1, list(2, 3))
)
expect_equal(
collect(list("a", "b", "...rest"), list(1, 2, 3, 4)),
list(1, 2, list(3, 4))
)
})
zeallot/tests/testthat/test-operator.R 0000644 0001762 0000144 00000014750 13233122505 017664 0 ustar ligges users context(" * testing assignment operator")
test_that("%<-% can perform standard assignment", {
a %<-% "foo"
expect_equal(a, "foo")
b %<-% list(1, 2, 3)
expect_equal(b, list(1, 2, 3))
})
test_that("%->% can perform standard assignment, too", {
1 %->% a
2 %->% b
expect_equal(a, 1)
expect_equal(b, 2)
})
test_that("%<-% can assign list element, variable in specific environment", {
a <- list()
a[[1]] %<-% "b"
expect_equal(a[[1]], "b")
e <- new.env(parent = emptyenv())
e$a %<-% "b"
expect_equal(e$a, "b")
})
test_that("%<-% can assign nested list elements", {
a <- list(list())
a[[1]][[1]] %<-% "hello, world"
expect_equal(a, list(list("hello, world")))
c(a[[1]][[2]], b) %<-% list("goodnight, moon", 2)
expect_equal(a, list(list("hello, world", "goodnight, moon")))
expect_equal(b, 2)
e <- new.env(parent = emptyenv())
e$f <- new.env(parent = emptyenv())
e$f$hello %<-% list()
expect_equal(e$f$hello, list())
c(e$f$hello[[1]], b) %<-% list("world", 4)
expect_equal(e$f$hello, list("world"))
expect_equal(b, 4)
})
test_that("%<-% handles single name assigned single value", {
c(a) %<-% list("foo")
expect_equal(a, "foo")
c(b) %<-% c("bar")
expect_equal(b, "bar")
})
test_that("%<-% assigns collected vector as vector", {
c(a, ...b) %<-% 1:5
expect_equal(a, 1)
expect_equal(b, 2:5)
c(...c, d) %<-% c(TRUE, FALSE, FALSE)
expect_equal(c, c(TRUE, FALSE))
expect_equal(d, FALSE)
})
test_that("%<-% assigns multiple list elements", {
x <- list()
y <- list()
c(x$a, y[[2]]) %<-% c(1, 2)
expect_equal(x$a, 1)
expect_equal(y[[2]], 2)
})
test_that("%<-% unpacks vector", {
c(a, b) %<-% c("hello", "world")
expect_equal(a, "hello")
expect_equal(b, "world")
})
test_that("%<-% does not unpack nested vectors", {
expect_error(
c(c(a, b), c(d, e)) %<-% list(c(1, 2), c(3, 4)),
"^invalid `%<-%` right-hand side, incorrect number of values$"
)
c(a, b) %<-% list(c(1, 2), c(3, 4))
expect_equal(a, c(1, 2))
expect_equal(b, c(3, 4))
})
test_that("%<-% unpacks list", {
c(a, b) %<-% list("hello", 3030)
expect_equal(a, "hello")
expect_equal(b, 3030)
})
test_that("%<-% unpack only top-level", {
c(a, b) %<-% list(list("hello", "world"), list("goodnight", "moon"))
expect_equal(a, list("hello", "world"))
expect_equal(b, list("goodnight", "moon"))
c(d, e) %<-% list(list("hello", "world"), 1:5)
expect_equal(d, list("hello", "world"))
expect_equal(e, 1:5)
})
test_that("%<-% unpacks nested values using nested names", {
c(a, c(b, d)) %<-% list("hello", list("moon", list("world", "!")))
expect_equal(a, "hello")
expect_equal(b, "moon")
expect_equal(d, list("world", "!"))
})
test_that("%<-% handles S3 objects with underlying list structure", {
shape <- function(sides = 4, color = "red") {
structure(
list(
sides = sides,
color = color
),
class = "shape"
)
}
expect_error(
c(a, b) %<-% shape(),
"^invalid `%<-%` right-hand side, incorrect number of values$"
)
})
test_that("%<-% skips values using .", {
c(a, ., c) %<-% list(1, 2, 3)
expect_equal(a, 1)
expect_false(exists(".", inherits = FALSE))
expect_equal(c, 3)
c(d, c(e, ., f), g) %<-% list(4, list(5, 6, 7), 8)
expect_equal(d, 4)
expect_equal(e, 5)
expect_false(exists(".", inherits = FALSE))
expect_equal(f, 7)
expect_equal(g, 8)
})
test_that("%<-% skips multiple values using ...", {
c(a, ...) %<-% list(1, 2, 3, 4)
expect_equal(a, 1)
c(..., b) %<-% list(1, 2, 3, 4)
expect_equal(b, 4)
})
test_that("%<-% assigns default values", {
c(a, b = 1) %<-% c(3)
expect_equal(a, 3)
expect_equal(b, 1)
c(d, e = iris, f = 3030) %<-% 5
expect_equal(d, 5)
expect_equal(e, iris)
expect_equal(f, 3030)
})
test_that("%<-% assign default value of NULL", {
c(a, b = NULL) %<-% c(3)
expect_equal(a, 3)
expect_equal(b, NULL)
})
test_that("%<-% default values do not override specified values", {
c(a = 1, b = 4) %<-% 2
expect_equal(a, 2)
expect_equal(b, 4)
c(d = 5, e = 6) %<-% c(8, 9)
expect_equal(d, 8)
expect_equal(e, 9)
})
test_that("%<-% collector variables may have defaults", {
c(a, ...b = 4) %<-% c(1)
expect_equal(a, 1)
expect_equal(b, 4)
c(d, ...e = list(3030)) %<-% c(1)
expect_equal(d, 1)
expect_equal(e, list(3030))
})
test_that("%<-% throws error on unequal number of variables and values", {
expect_error(
c(a, b) %<-% list(1),
"^invalid `%<-%` right-hand side, incorrect number of values$"
)
expect_error(
c(a, b, c) %<-% list(1),
"^invalid `%<-%` right-hand side, incorrect number of values$"
)
expect_error(
c(a, b, c) %<-% list(1, 2),
"^invalid `%<-%` right-hand side, incorrect number of values$"
)
expect_error(
c(c(a, b), c(d, e, f)) %<-% list(list(1, 2), list(3, 4)),
"^invalid `%<-%` right-hand side, incorrect number of values$"
)
})
test_that("%<-% throws error when invalid calls on LHS", {
expect_error(
c(a + b) %<-% list(1),
"^invalid `%<-%` left-hand side, unexpected call `\\+`$"
)
expect_error(
c(a, c(quote(d), c)) %<-% list(1, list(2, 3)),
"^invalid `%<-%` left-hand side, unexpected call `quote`$"
)
})
test_that("%<-% throws error when blank variable names", {
expect_error(
c( , a) %<-% c(1, 2),
"^invalid `%<-%` left-hand side, found empty variable, check for extraneous commas$"
)
})
test_that('%<-% throws error when invalid "variables" on LHS', {
expect_error(
c(mean(1, 2), a) %<-% list(1, 2),
"^invalid `%<-%` left-hand side, unexpected call `mean`$"
)
expect_error(
c(a, f()) %<-% list(1, 2),
"^invalid `%<-%` left-hand side, expected symbol, but found call$"
)
expect_error(
f() %<-% list(1),
"^invalid `%<-%` left-hand side, expected symbol, but found call$"
)
})
test_that("%<-% throws error when assigning empty list", {
expect_error(
c(a, b) %<-% list(),
"^invalid `%<-%` right-hand side, incorrect number of values$"
)
})
test_that("%->% errors include %->% in message, flips lhs and rhs", {
expect_error(
c(1, 2) %->% {x:y},
"^invalid `%->%` right-hand side, unexpected call `\\{`$"
)
expect_error(
1 %->% c(x, y),
"^invalid `%->%` left-hand side, incorrect number of values$"
)
})
test_that("extractees on left-hand side must exist", {
expect_error(
a[[1]] %<-% 3030,
"^invalid `%<-%` left-hand side, object `a` does not exist in calling environment$"
)
f <- function() {
"hello" + 9
}
expect_error(
b %<-% f(),
'^non-numeric argument to binary operator$'
)
})
zeallot/tests/testthat/test-destructure.R 0000644 0001762 0000144 00000003222 13233122505 020372 0 ustar ligges users context(" * testing destructure")
test_that("destructure atomics", {
expect_equal(destructure("hello"), list("h", "e", "l", "l", "o"))
expect_equal(destructure(complex(1, 33, -7)), list(33, -7))
expect_error(
destructure(1),
"incorrect number of values"
)
})
test_that("destructure data.frame converts data.frame to list", {
sample_df <- head(iris)
expect_equal(destructure(sample_df), as.list(sample_df))
expect_equal(length(sample_df), NCOL(sample_df))
expect_true(all(lengths(destructure(sample_df)) == NROW(sample_df)))
for (i in seq_len(NCOL(sample_df))) {
expect_equal(destructure(sample_df)[[i]], sample_df[[i]])
}
})
test_that("destructure converts Date to list of year, month, day", {
today <- Sys.Date()
year <- as.numeric(format(today, "%Y"))
month <- as.numeric(format(today, "%m"))
day <- as.numeric(format(today, "%d"))
expect_equal(destructure(today), list(year, month, day))
})
test_that("destructure summary.lm converts to list", {
f <- lm(disp ~ mpg, data = mtcars)
expect_equal(destructure(summary(f)), lapply(summary(f), identity))
})
test_that("destructure throws error for multi-length vectors of atomics", {
expect_error(
assert_destruction(character(2)),
"invalid `destructure` argument, cannot destructure character vector of length greater than 1"
)
expect_error(
destructure(c(Sys.Date(), Sys.Date())),
"invalid `destructure` argument, cannot destructure Date vector of length greater than 1"
)
})
test_that("destructure throws error as default", {
random <- structure(list(), class = "random")
expect_error(
destructure(random),
"incorrect number of values"
)
})
zeallot/tests/testthat/test-pair-off.R 0000644 0001762 0000144 00000006363 13233122505 017535 0 ustar ligges users context(" * testing pair_off")
expect_equalish <- function(object, expected) {
eval(bquote(expect_equal(.(object), .(expected), check.attributes = FALSE)))
}
test_that("pair_off single item lists", {
expect_equalish(
pair_off(list("a"), list(1)),
list(list("a", 1))
)
})
test_that("pair_off multi-item lists", {
expect_equalish(
pair_off(list("a", "b", "c"), list(1, 2, 3)),
list(list("a", 1), list("b", 2), list("c", 3))
)
})
test_that("pair_off list with one nested element", {
expect_equalish(
pair_off(list("a", list("b")), list(1, list(2))),
list(list("a", 1), list("b", 2))
)
expect_equalish(
pair_off(list("a", list("b"), "c"), list(1, list(2), 3)),
list(list("a", 1), list("b", 2), list("c", 3))
)
expect_equalish(
pair_off(list("a", "b", list("c")), list(1, 2, list(3))),
list(list("a", 1), list("b", 2), list("c", 3))
)
})
test_that("pair_off list with multiple nested elements", {
expect_equalish(
pair_off(list(list("a"), list("b"), "c"), list(list(1), list(2), 3)),
list(list("a", 1), list("b", 2), list("c", 3))
)
})
test_that("pair_off heavily nested list", {
expect_equalish(
pair_off(list("a", list("b", list("c", list("d")))), list(1, list(2, list(3, list(4))))),
list(list("a", 1), list("b", 2), list("c", 3), list("d", 4))
)
})
test_that("pair_off collects values when ... specified", {
expect_equalish(
pair_off(list("a", "...mid", "d"), list(1, 2, 3, 4)),
list(list("a", 1), list("mid", list(2, 3)), list("d", 4))
)
expect_equalish(
pair_off(list("a", "b", "...rest"), list(1, 2, 3, 4)),
list(list("a", 1), list("b", 2), list("rest", list(3, 4)))
)
expect_equalish(
pair_off(list("a", "...rest"), list(1, 2, 3, 4)),
list(list("a", 1), list("rest", list(2, 3, 4)))
)
})
test_that("pair_off list of multi length items", {
expect_equalish(
pair_off(list("a", "b"), list(head(iris), 1:5)),
list(list("a", head(iris)), list("b", 1:5))
)
})
test_that("pair_off unpacks strings and data frames", {
expect_equalish(
pair_off(list("a", "b", "c"), list("foo")),
list(list("a", "f"), list("b", "o"), list("c", "o"))
)
})
test_that("pair_off throws error for atomic vector of length > 1", {
expect_error(
pair_off(list("a", "b"), list(character(2))),
"invalid `destructure` argument, cannot destructure character vector of length greater than 1"
)
})
test_that("pair_off throws error for flat lists of different lengths", {
expect_error(
pair_off(list("a", "b"), list(1)),
"incorrect number of values"
)
expect_error(
pair_off(list("a", "b"), list(1, 2, 3)),
"incorrect number of values"
)
})
test_that("pair_off throws error for nested lists of different lengths, depths", {
expect_error(
pair_off(list(list("a"), list("b", "c")), list(list(1), list(2), list(3))),
"incorrect number of values"
)
})
test_that("pair_off throws error for extra names, including a collector", {
expect_error(
pair_off(list("a", "...mid", "b"), list(1, 2)),
"incorrect number of values"
)
})
test_that("pair_off throws error for multiple collectors at one depth", {
expect_error(
pair_off(list("a", "...b", "...c"), list(1, 2, 3, 4)),
"multiple collector variables at the same depth"
)
})
zeallot/NAMESPACE 0000644 0001762 0000144 00000000431 13233122505 013135 0 ustar ligges users # Generated by roxygen2: do not edit by hand
S3method(destructure,Date)
S3method(destructure,character)
S3method(destructure,complex)
S3method(destructure,data.frame)
S3method(destructure,default)
S3method(destructure,summary.lm)
export("%->%")
export("%<-%")
export(destructure)
zeallot/NEWS.md 0000644 0001762 0000144 00000005332 13233126163 013025 0 ustar ligges users # zeallot 0.1.0
## Major Improvements
* Bumped to stable version.
## Minor Improvements
* Removed outdate language in the unpacking assignment vignette. (#36)
## Bug Fixes
* Destructuring objects with multiple classes will no longer raise a
warning. (#35)
# zeallot 0.0.6.1
## Bug Fixes
* Resolved problem where collector variables would not be assigned the correct default value. (#34)
# zeallot 0.0.6
## Major Improvements
* The left-hand side may now contain calls to `[[`, `[`, and `$` allowing
assignment of parts of objects. The parent object must already
exist, otherwise an error is raised. (@rafaqz, #32)
# zeallot 0.0.5
## Major Changes
* The bracket and colon syntax has been completely removed, users will now see
an "unexpected call `{`" error message when attempting to use the old syntax.
Please use the `c()` syntax for the name structure.
## Major Improvements
* A `%->%` operator has been added. The right operator performs the same
operation as `%<-%` with the name structure on the right-hand side and
the values to assign on the left-hand side.
* `=` may be used to specify the default value of a variable. A default value
is used when there are an insufficient number of values.
# zeallot 0.0.4
## Major Changes
* The bracket and colon syntax has been deprecated in favor of a lighter syntax
which uses calls to `c()`. Documentation and vignettes has been updated
accordingly. Using the old syntax now raises a warning and will be removed in
future versions of zeallot. (@hadley, #21)
## Minor Improvements
* `%<-%` can now be used for regular assignment. (@hadley, #17)
* `...` can now be used to skip multiple values without assigning those values
and is recommended over the previously suggested `....`. (@hadley, #18)
## Miscellaneous Changes
* `massign()` is no longer exported.
## Bug Fixes
* Numerics on left-hand side are no longer unintentionally quoted, thus no
longer treated as valid variable names, and will now raise an error.
(@hadley, #20)
* Language objects on left-hand side are no longer treated as symbols and will
now raise an error. (@hadley, #20)
# zeallot 0.0.3
* see 0.0.2.1 notes for additional updates
## Minor Improvements
* Examples now consistently put spaces around colons separating left-hand side
variables, e.g. `a : b` instead of `a: b`.
## Bug Fixes
* When unpacking an atomic vector, a collector variable will now collect values
as a vector. Previously, values were collected as a list (#14).
# zeallot 0.0.2.1
* Not on CRAN, changes will appear under version 0.0.3
* Added missing URL and BugReports fields to DESCRIPTION
* Fixed broken badges in README
# zeallot 0.0.2
* Initial CRAN release
* zeallot 0.0.1 may be installed from GitHub
zeallot/R/ 0000755 0001762 0000144 00000000000 13233122576 012131 5 ustar ligges users zeallot/R/zeallot.R 0000644 0001762 0000144 00000000603 13233122505 013715 0 ustar ligges users #' Multiple, unpacking, and destructuring assignment in R
#'
#' zeallot provides a \code{\link{\%<-\%}} operator to perform multiple
#' assignment in R. To get started with zeallot be sure to read over the
#' introductory vignette on unpacking assignment,
#' \code{vignette('unpacking-assignment')}.
#'
#' @seealso \code{\link{\%<-\%}}
#'
#' @docType package
#' @name zeallot
"_PACKAGE"
zeallot/R/collect.R 0000644 0001762 0000144 00000002444 13233122505 013675 0 ustar ligges users is_collector <- function(x) {
if (!is.character(x)) {
return(FALSE)
}
grepl("^\\.\\.\\.", x)
}
has_collector <- function(x) {
any(vapply(x, is_collector, logical(1)))
}
collect <- function(names, values) {
if (!any(grepl("^\\.\\.\\.", names))) {
stop("no collector variable specified", call. = FALSE)
}
if (length(names) == length(values)) {
return(values)
}
if (length(names) == 1) {
# ...alone
return(list(values))
}
c_index <- which(grepl('^\\.\\.\\.', names))
if (length(c_index) != 1) {
stop(
"invalid `%<-%` left-hand side, multiple collector variables at the ",
"same depth",
call. = FALSE
)
}
if (c_index == 1) {
# ...firsts, a, b
post <- rev(
seq.int(
from = length(values),
length.out = length(names) - 1,
by = -1
)
)
c(list(values[-post]), values[post])
} else if (c_index == length(names)) {
# a, b, ...rest
pre <- seq.int(1, c_index - 1)
c(values[pre], list(values[-pre]))
} else {
# a, ...mid, b
pre <- seq.int(1, c_index - 1)
post <- rev(
seq.int(
from = length(values),
length.out = length(names) - length(pre) - 1,
by = -1
)
)
c(values[pre], list(values[-c(pre, post)]), values[post])
}
}
zeallot/R/utils.R 0000644 0001762 0000144 00000011505 13233122576 013416 0 ustar ligges users is_list <- function(x) {
length(class(x)) == 1 && class(x) == 'list'
}
car <- function(cons) {
stopifnot(is.list(cons), length(cons) > 0)
cons[[1]]
}
cdr <- function(cons) {
stopifnot(is.list(cons), length(cons) > 0)
cons[-1]
}
names2 <- function(x) {
if (is.null(names(x))) rep.int("", length(x)) else names(x)
}
#
# the default attribute is used by `variables()` and `pair_off()` to know when
# to assign a variable its default value
#
get_default <- function(x) {
attr(x, "default", exact = TRUE)
}
has_default <- function(x) {
vapply(x, function(i) !is.null(get_default(i)), logical(1))
}
#
# append any default values onto the end of a list of values, used in
# `pair_off()` to extend the current set of values thereby avoiding an
# incorrect number of values error
#
add_defaults <- function(names, values, env) {
where <- which(has_default(names))
defaults <- lapply(names[where], get_default)[where > length(values)]
evaled <- lapply(
defaults,
function(d) {
deval <- eval(d, envir = env)
if (is.null(deval)) {
return(deval)
}
attr(deval, "default") <- TRUE
deval
}
)
append(values, evaled)
}
#
# traverse nested extract op calls to find the extractee, e.g. `x[[1]][[1]]`
#
traverse_to_extractee <- function(call) {
if (is.language(call) && is.symbol(call)) {
return(call)
}
traverse_to_extractee(call[[2]])
}
#
# used by multi_assign to confirm all extractees exist
#
check_extract_calls <- function(lhs, envir) {
if (is.character(lhs)) {
return()
}
if (is.language(lhs)) {
extractee <- traverse_to_extractee(lhs)
if (!exists(as.character(extractee), envir = envir, inherits = FALSE)) {
stop_invalid_lhs(object_does_not_exist(extractee))
} else {
return()
}
}
unlist(lapply(lhs, check_extract_calls, envir = envir))
}
is_extract_op <- function(x) {
if (length(x) < 1) {
return(FALSE)
}
(as.character(x) %in% c("[", "[[", "$"))
}
is_valid_call <- function(x) {
if (length(x) < 1) {
return(FALSE)
}
(x == "c" || x == "=" || is_extract_op(x))
}
#
# used by multi_assign to assign list elements in the calling environment
#
assign_extract <- function(call, value, envir = parent.frame()) {
replacee <- call("<-", call, value)
eval(replacee, envir = envir)
invisible(value)
}
#
# parses a substituted expression to create a tree-like list structure,
# perserves calls to extract ops instead of converting them to lists
#
tree <- function(x) {
if (length(x) == 1) {
return(x)
}
if (is_extract_op(x[[1]])) {
return(x)
}
lapply(
seq_along(as.list(x)),
function(i) {
if (names2(x[i]) != "") {
return(list(as.symbol("="), names2(x[i]), x[[i]]))
} else {
tree(x[[i]])
}
}
)
}
#
# given a tree-like list structure returns a character vector of the function
# calls, used by multi_assign to determine if performing standard assignment or
# multiple assignment
#
calls <- function(x) {
if (!is_list(x)) {
return(NULL)
}
this <- car(x)
if (!is_valid_call(this)) {
stop_invalid_lhs(unexpected_call(this))
}
c(as.character(this), unlist(lapply(cdr(x), calls)))
}
#
# given a tree-like list structure, returns a nested list of the variables
# in the tree, will also associated default values with variables
#
variables <- function(x) {
if (!is_list(x)) {
if (x == "") {
stop_invalid_lhs(empty_variable(x))
}
if (is.language(x) && length(x) > 1 && is_extract_op(x[[1]])) {
return(x)
}
if (!is.symbol(x)) {
stop_invalid_lhs(unexpected_variable(x))
}
return(as.character(x))
}
if (car(x) == "=") {
var <- as.character(car(cdr(x)))
default <- car(cdr(cdr(x)))
if (is.null(default)) {
default <- quote(pairlist())
}
attr(var, "default") <- default
return(var)
}
lapply(cdr(x), variables)
}
#
# error helpers below
#
incorrect_number_of_values <- function() {
"incorrect number of values"
}
object_does_not_exist <- function(obj) {
paste0("object `", obj, "` does not exist in calling environment")
}
empty_variable <- function(obj) {
paste("found empty variable, check for extraneous commas")
}
unexpected_variable <- function(obj) {
paste("expected symbol, but found", class(obj))
}
unexpected_call <- function(obj) {
paste0("unexpected call `", as.character(obj), "`")
}
# thank you Advanced R
condition <- function(subclass, message, call = sys.call(-1), ...) {
structure(
class = c(subclass, "condition"),
list(message = message, call = call),
...
)
}
stop_invalid_lhs <- function(message, call = sys.call(-1), ...) {
cond <- condition(c("invalid_lhs", "error"), message, call, ...)
stop(cond)
}
stop_invalid_rhs <- function(message, call = sys.call(-1), ...) {
cond <- condition(c("invalid_rhs", "error"), message, call, ...)
stop(cond)
}
zeallot/R/pair-off.R 0000644 0001762 0000144 00000003630 13233122505 013751 0 ustar ligges users pair_off <- function(names, values, env) {
if (is.character(names) || is.language(names)) {
if (names == ".") {
return()
}
attributes(names) <- NULL
return(list(list(name = names, value = values)))
}
if (is_list(names) && length(names) == 0 &&
is_list(values) && length(values) == 0) {
return()
}
#
# mismatch between variables and values
#
if (length(names) != length(values)) {
if (any(has_default(names))) {
values <- add_defaults(names, values, env)
names <- lapply(names, `attributes<-`, value = NULL)
return(pair_off(names, values))
}
#
# mismatch could be resolved by destructuring the values, in this case
# values must be a single element list
#
if (is_list(values) && length(values) == 1) {
return(pair_off(names, destructure(car(values))))
}
#
# if there is no collector the mismatch is a problem *or* if collector,
# and still more variables than values the collector is useless and
# mismatch is a problem
#
if (!has_collector(names) || length(names) > length(values)) {
stop_invalid_rhs(incorrect_number_of_values())
}
}
if (is_collector(car(names))) {
collected <- collect(names, values)
name <- sub("^\\.\\.\\.", "", car(names))
#
# skip unnamed collector variable and corresponding values
#
if (name == "") {
return(pair_off(cdr(names), cdr(collected)))
}
return(
c(pair_off(name, car(collected)), pair_off(cdr(names), cdr(collected)))
)
}
#
# multiple nested variables and nested vector of values same length, but
# a nested vector is not unpacked, mismatch
#
if (is_list(names) && !is_list(values)) {
stop_invalid_rhs(incorrect_number_of_values())
}
if (length(names) == 1) {
return(pair_off(car(names), car(values)))
}
c(pair_off(car(names), car(values)), pair_off(cdr(names), cdr(values)))
}
zeallot/R/destructure.R 0000644 0001762 0000144 00000007232 13233122505 014621 0 ustar ligges users #' Destructure an object
#'
#' `destructure` is used during unpacking assignment to coerce an object
#' into a list. Individual elements of the list are assigned to names on the
#' left-hand side of the unpacking assignment expression.
#'
#' @param x An \R object.
#'
#' @details
#'
#' If `x` is atomic `destructure` expects `length(x)` to be 1. If a vector with
#' length greater than 1 is passed to `destructure` an error is raised.
#'
#' New implementations of `destructure` can be very simple. A new
#' `destructure` implementation might only strip away the class of a custom
#' object and return the underlying list structure. Alternatively, an object
#' might destructure into a nested set of values and may require a more
#' complicated implementation. In either case, new implementations must return a
#' list object so \code{\%<-\%} can handle the returned value(s).
#'
#' @seealso \code{\link{\%<-\%}}
#'
#' @export
#' @examples
#' # data frames become a list of columns
#' destructure(
#' data.frame(x = 0:4, y = 5:9)
#' )
#'
#' # strings are split into list of characters
#' destructure("abcdef")
#'
#' # dates become list of year, month, and day
#' destructure(Sys.Date())
#'
#' # create a new destructure implementation
#' shape <- function(sides = 4, color = "red") {
#' structure(
#' list(sides = sides, color = color),
#' class = "shape"
#' )
#' }
#'
#' \dontrun{
#' # cannot destructure the shape object yet
#' c(sides, color) %<-% shape()
#' }
#'
#' # implement `destructure` for shapes
#' destructure.shape <- function(x) {
#' list(x$sides, x$color)
#' }
#'
#' # now we can destructure shape objects
#' c(sides, color) %<-% destructure(shape())
#'
#' sides # 4
#' color # "red"
#'
#' c(sides, color) %<-% destructure(shape(3, "green"))
#'
#' sides # 3
#' color # 'green'
#'
destructure <- function(x) {
UseMethod("destructure")
}
#' Included Implementations of `destructure`
#'
#' zeallot includes `destructure` methods for the following classes:
#' `character`, `complex`, `Date`, `data.frame`, and
#' `summary.lm`. See details for how each object is transformed into a
#' list.
#'
#' @inheritParams destructure
#'
#' @details
#'
#' `character` values are split into a list of individual characters.
#'
#' `complex` values are split into a list of two values, the real and the
#' imaginary part.
#'
#' `Date` values are split into a list of three numeric values, the year,
#' month, and day.
#'
#' `data.frame` values are coerced into a list using `as.list`.
#'
#' `summary.lm` values are coerced into a list of values, one element for
#' each of the eleven values returned by `summary.lm`.
#'
#' @return
#'
#' A list of elements from `x`.
#'
#' @seealso [destructure]
#'
#' @keywords internal
#'
#' @name destructure-methods
#' @export
destructure.character <- function(x) {
assert_destruction(x)
as.list(strsplit(x, "")[[1]])
}
#' @rdname destructure-methods
#' @export
destructure.complex <- function(x) {
assert_destruction(x)
list(Re(x), Im(x))
}
#' @rdname destructure-methods
#' @export
destructure.Date <- function(x) {
assert_destruction(x)
as.list(as.numeric(strsplit(format(x, "%Y-%m-%d"), "-", fixed = TRUE)[[1]]))
}
#' @rdname destructure-methods
#' @export
destructure.data.frame <- function(x) {
as.list(x)
}
#' @rdname destructure-methods
#' @export
destructure.summary.lm <- function(x) {
lapply(x, identity)
}
#' @rdname destructure-methods
#' @export
destructure.default <- function(x) {
stop_invalid_rhs(incorrect_number_of_values())
}
assert_destruction <- function(x) {
if (length(x) > 1) {
stop(
"invalid `destructure` argument, cannot destructure ", class(x),
" vector of length greater than 1",
call. = FALSE
)
}
}
zeallot/R/operator.R 0000644 0001762 0000144 00000016510 13233122505 014102 0 ustar ligges users #' Multiple assignment operators
#'
#' Assign values to name(s).
#'
#' @param x A name structure, see section below.
#'
#' @param value A list of values, vector of values, or \R object to assign.
#'
#' @section Name Structure:
#'
#' **the basics**
#'
#' At its simplest, the name structure may be a single variable name, in which
#' case \code{\%<-\%} and \code{\%->\%} perform regular assignment, \code{x
#' \%<-\% list(1, 2, 3)} or \code{list(1, 2, 3) \%->\% x}.
#'
#' To specify multiple variable names use a call to `c()`, for example
#' \code{c(x, y, z) \%<-\% c(1, 2, 3)}.
#'
#' When `value` is neither an atomic vector nor a list, \code{\%<-\%} and
#' \code{\%->\%} will try to destructure `value` into a list before assigning
#' variables, see [destructure()].
#'
#' **object parts**
#'
#' Like assigning a variable, one may also assign part of an object, \code{c(x,
#' x[[1]]) \%<-\% list(list(), 1)}.
#'
#' **nested names**
#'
#' One can also nest calls to `c()` when needed, `c(x, c(y, z))`. This nested
#' structure is used to unpack nested values,
#' \code{c(x, c(y, z)) \%<-\% list(1, list(2, 3))}.
#'
#' **collector variables**
#'
#' To gather extra values from the beginning, middle, or end of `value` use a
#' collector variable. Collector variables are indicated with a `...`
#' prefix, \code{c(...start, z) \%<-\% list(1, 2, 3, 4)}.
#'
#' **skipping values**
#'
#' Use `.` in place of a variable name to skip a value without raising an error
#' or assigning the value, \code{c(x, ., z) \%<-\% list(1, 2, 3)}.
#'
#' Use `...` to skip multiple values without raising an error or assigning the
#' values, \code{c(w, ..., z) \%<-\% list(1, NA, NA, 4)}.
#'
#' **default values**
#'
#' Use `=` to specify a default value for a variable, \code{c(x, y = NULL)
#' \%<-\% tail(1, 2)}.
#'
#' When assigning part of an object a default value may not be specified because
#' of the syntax enforced by \R. The following would raise an `"unexpected '='
#' ..."` error, \code{c(x, x[[1]] = 1) \%<-\% list(list())}.
#'
#' @return
#'
#' \code{\%<-\%} and \code{\%->\%} invisibly return `value`.
#'
#' These operators are used primarily for their assignment side-effect.
#' \code{\%<-\%} and \code{\%->\%} assign into the environment in which they
#' are evaluated.
#'
#' @seealso
#'
#' For more on unpacking custom objects please refer to
#' [destructure()].
#'
#' @name operator
#' @export
#' @examples
#' # basic usage
#' c(a, b) %<-% list(0, 1)
#'
#' a # 0
#' b # 1
#'
#' # unpack and assign nested values
#' c(c(e, f), c(g, h)) %<-% list(list(2, 3), list(3, 4))
#'
#' e # 2
#' f # 3
#' g # 4
#' h # 5
#'
#' # can assign more than 2 values at once
#' c(j, k, l) %<-% list(6, 7, 8)
#'
#' # assign columns of data frame
#' c(erupts, wait) %<-% faithful
#'
#' erupts # 3.600 1.800 3.333 ..
#' wait # 79 54 74 ..
#'
#' # assign only specific columns, skip
#' # other columns
#' c(mpg, cyl, disp, ...) %<-% mtcars
#'
#' mpg # 21.0 21.0 22.8 ..
#' cyl # 6 6 4 ..
#' disp # 160.0 160.0 108.0 ..
#'
#' # skip initial values, assign final value
#' TODOs <- list("make food", "pack lunch", "save world")
#'
#' c(..., task) %<-% TODOs
#'
#' task # "save world"
#'
#' # assign first name, skip middle initial,
#' # assign last name
#' c(first, ., last) %<-% c("Ursula", "K", "Le Guin")
#'
#' first # "Ursula"
#' last # "Le Guin"
#'
#' # simple model and summary
#' mod <- lm(hp ~ gear, data = mtcars)
#'
#' # extract call and fstatistic from
#' # the summary
#' c(modcall, ..., modstat, .) %<-% summary(mod)
#'
#' modcall
#' modstat
#'
#' # unpack nested values w/ nested names
#' fibs <- list(1, list(2, list(3, list(5))))
#'
#' c(f2, c(f3, c(f4, c(f5)))) %<-% fibs
#'
#' f2 # 1
#' f3 # 2
#' f4 # 3
#' f5 # 5
#'
#' # unpack first numeric, leave rest
#' c(f2, fibcdr) %<-% fibs
#'
#' f2 # 1
#' fibcdr # list(2, list(3, list(5)))
#'
#' # swap values without using temporary variables
#' c(a, b) %<-% c("eh", "bee")
#'
#' a # "eh"
#' b # "bee"
#'
#' c(a, b) %<-% c(b, a)
#'
#' a # "bee"
#' b # "eh"
#'
#' # unpack `strsplit` return value
#' names <- c("Nathan,Maria,Matt,Polly", "Smith,Peterson,Williams,Jones")
#'
#' c(firsts, lasts) %<-% strsplit(names, ",")
#'
#' firsts # c("Nathan", "Maria", ..
#' lasts # c("Smith", "Peterson", ..
#'
#' # handle missing values with default values
#' parse_time <- function(x) {
#' strsplit(x, " ")[[1]]
#' }
#'
#' c(hour, period = NA) %<-% parse_time("10:00 AM")
#'
#' hour # "10:00"
#' period # "AM"
#'
#' c(hour, period = NA) %<-% parse_time("15:00")
#'
#' hour # "15:00"
#' period # NA
#'
#' # right operator
#' list(1, 2, "a", "b", "c") %->% c(x, y, ...chars)
#'
#' x # 1
#' y # 2
#' chars # list("a", "b", "c")
#'
#' # magrittr chains, install.packages("magrittr") for this example
#' if (requireNamespace("magrittr", quietly = TRUE)) {
#' library(magrittr)
#'
#' c("hello", "world!") %>%
#' paste0("\n") %>%
#' lapply(toupper) %->%
#' c(greeting, subject)
#'
#' greeting # "HELLO\n"
#' subject # "WORLD!\n"
#' }
#'
`%<-%` <- function(x, value) {
tryCatch(
multi_assign(substitute(x), value, parent.frame()),
invalid_lhs = function(e) {
stop("invalid `%<-%` left-hand side, ", e$message, call. = FALSE)
},
invalid_rhs = function(e) {
stop("invalid `%<-%` right-hand side, ", e$message, call. = FALSE)
}
)
}
#' @rdname operator
#' @export
`%->%` <- function(value, x) {
tryCatch(
multi_assign(substitute(x), value, parent.frame()),
invalid_lhs = function(e) {
stop("invalid `%->%` right-hand side, ", e$message, call. = FALSE)
},
invalid_rhs = function(e) {
stop("invalid `%->%` left-hand side, ", e$message, call. = FALSE)
}
)
}
# The real power behind %->% and %<-%
#
# Within the function `lhs` and `rhs` refer to the left- and right-hand side of
# a call to %<-% operator. For %->% the lhs and rhs from the original call are
# swapped when passed to `multi_assign`.
#
# @param x A name structure, converted into a tree-like structure with `tree`.
#
# @param value The values to assign.
#
# @param env The environment where the variables will be assigned.
#
multi_assign <- function(x, value, env) {
ast <- tree(x)
internals <- calls(ast)
lhs <- variables(ast)
rhs <- value
#
# all lists or environemnts referenced in lhs must already exist
#
check_extract_calls(lhs, env)
#
# standard assignment
#
if (is.null(internals)) {
if (is.language(lhs)) {
assign_extract(lhs, value, envir = env)
} else {
assign(lhs, value, envir = env)
}
return(invisible(value))
}
#
# *error* multiple assignment, but sinle RHS value
#
if (length(value) == 0) {
stop_invalid_rhs(incorrect_number_of_values())
}
#
# edge cases when RHS is not a list
#
if (!is_list(value)) {
if (is.atomic(value)) {
rhs <- as.list(value)
} else {
rhs <- destructure(value)
}
}
#
# tuples in question are variable names and value to assign
#
tuples <- pair_off(lhs, rhs, env)
for (t in tuples) {
name <- t[["name"]]
val <- t[["value"]]
if (is.language(name)) {
assign_extract(name, val, envir = env)
next
}
if (is.atomic(value)) {
if (is.null(attr(val, "default", TRUE))) {
val <- unlist(val, recursive = FALSE)
} else if (attr(val, "default", TRUE) == TRUE) {
attr(val, "default") <- NULL
}
}
assign(name, val, envir = env)
}
invisible(value)
}
zeallot/vignettes/ 0000755 0001762 0000144 00000000000 13233132151 013726 5 ustar ligges users zeallot/vignettes/unpacking-assignment.Rmd 0000644 0001762 0000144 00000021751 13233124322 020526 0 ustar ligges users ---
title: "Unpacking Assignment"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{Unpacking Assignment}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
```{R, include = FALSE}
knitr::opts_chunk$set(collapse = TRUE, comment = "#>")
library(zeallot)
```
## Getting Started
The *zeallot* package defines an operator for *unpacking assignment*, sometimes
called *parallel assignment* or *destructuring assignment* in other programming
languages. The operator is written as `%<-%` and used like this.
```{r}
c(lat, lng) %<-% list(38.061944, -122.643889)
```
The result is that the list is unpacked into its elements,
and the elements are assigned to `lat` and `lng`.
```{r}
lat
lng
```
You can also unpack the elements of a vector.
```{r}
c(lat, lng) %<-% c(38.061944, -122.643889)
lat
lng
```
You can unpack much longer structures, too, of course, such as the 6-part
summary of a vector.
```{r}
c(min_wt, q1_wt, med_wt, mean_wt, q3_wt, max_wt) %<-% summary(mtcars$wt)
min_wt
q1_wt
med_wt
mean_wt
q3_wt
max_wt
```
If the left-hand side and right-hand sides do not match, an error is raised.
This guards against missing or unexpected values.
```{r, error=TRUE}
c(stg1, stg2, stg3) %<-% list("Moe", "Donald")
```
```{r, error=TRUE}
c(stg1, stg2, stg3) %<-% list("Moe", "Larry", "Curley", "Donald")
```
### Unpacking a returned value
A common use-case is when a function returns a list of values
and you want to extract the individual values.
In this example, the list of values returned by `coords_list()` is unpacked
into the variables `lat` and `lng`.
```{r}
#
# A function which returns a list of 2 numeric values.
#
coords_list <- function() {
list(38.061944, -122.643889)
}
c(lat, lng) %<-% coords_list()
lat
lng
```
In this next example, we call a function that returns a vector.
```{r}
#
# Convert cartesian coordinates to polar
#
to_polar = function(x, y) {
c(sqrt(x^2 + y^2), atan(y / x))
}
c(radius, angle) %<-% to_polar(12, 5)
radius
angle
```
### Example: Intercept and slope of regression
You can directly unpack the coefficients of a simple linear regression
into the intercept and slope.
```{r}
c(inter, slope) %<-% coef(lm(mpg ~ cyl, data = mtcars))
inter
slope
```
### Example: Unpacking the result of `safely`
The *purrr* package includes the `safely` function.
It wraps a given function to create a new, "safe" version of the original function.
```{R, eval = require("purrr")}
safe_log <- purrr::safely(log)
```
The safe version returns a list of two items. The first item is the result of
calling the original function, assuming no error occurred; or `NULL` if an error
did occur. The second item is the error, if an error occurred; or `NULL` if no
error occurred. Whether or not the original function would have thrown an error,
the safe version will never throw an error.
```{r, eval = require("purrr")}
pair <- safe_log(10)
pair$result
pair$error
```
```{r, eval = require("purrr")}
pair <- safe_log("donald")
pair$result
pair$error
```
You can tighten and clarify calls to the safe function by using `%<-%`.
```{r, eval = require("purrr")}
c(res, err) %<-% safe_log(10)
res
err
```
## Unpacking a data frame
A data frame is simply a list of columns, so the *zeallot* assignment does
what you expect. It unpacks the data frame into individual columns.
```{r}
c(mpg, cyl, disp, hp) %<-% mtcars[, 1:4]
head(mpg)
head(cyl)
head(disp)
head(hp)
```
### Example: List of data frames
Bear in mind that a list of data frames is still just a list. The assignment
will extract the list elements (which are data frames) but not unpack the data
frames themselves.
```{R}
quartet <- lapply(1:4, function(i) anscombe[, c(i, i + 4)])
c(an1, an2, an3, an4) %<-% lapply(quartet, head, n = 3)
an1
an2
an3
an4
```
The `%<-%` operator assigned four data frames to four variables, leaving the
data frames intact.
## Unpacking nested values
In addition to unpacking flat lists, you can unpack lists of lists.
```{r}
c(a, c(b, d), e) %<-% list("begin", list("middle1", "middle2"), "end")
a
b
d
e
```
Not only does this simplify extracting individual elements, it also adds a level
of checking. If the described list structure does not match the actual list
structure, an error is raised.
```{r, error=TRUE}
c(a, c(b, d, e), f) %<-% list("begin", list("middle1", "middle2"), "end")
```
## Splitting a value into its parts
The previous examples dealt with unpacking a list or vector into its elements.
You can also split certain kinds of individual values into subvalues.
### Character vectors
You can assign individual characters of a string to variables.
```{r}
c(ch1, ch2, ch3) %<-% "abc"
ch1
ch2
ch3
```
### Dates
You can split a Date into its year, month, and day, and assign the parts to
variables.
```{r}
c(y, m, d) %<-% Sys.Date()
y
m
d
```
### Class objects
*zeallot* includes implementations of `destructure` for character strings,
complex numbers, data frames, date objects, and linear model summaries.
However, because `destructure` is a generic function, you can define new
implementations for custom classes. When defining a new implementation keep in
mind the implementation needs to return a list so that values are properly
unpacked.
## Trailing values: the "everything else" clause
In some cases, you want the first few elements of a list or vector but do not
care about the trailing elements. The `summary` function of `lm`, for example,
returns a list of 11 values, and you might want only the first few. Fortunately,
there is a way to capture those first few and say "don't worry about everything
else".
```{r}
f <- lm(mpg ~ cyl, data = mtcars)
c(fcall, fterms, resids, ...rest) %<-% summary(f)
fcall
fterms
head(resids)
```
Here, `rest` will capture everything else.
```{r}
str(rest)
```
The assignment operator noticed that `...rest` is prefixed with `...`, and it
created a variable called `rest` for the trailing values of the list. If you
omitted the "everything else" prefix, there would be an error because the
lengths of the left- and right-hand sides of the assignment would be mismatched.
```{r, error = TRUE}
c(fcall, fterms, resids, rest) %<-% summary(f)
```
If multiple collector variables are specified at a particular depth it is
ambiguous which values to assign to which collector and an error will be raised.
## Leading values and middle values
In addition to collecting trailing values, you can also collect initial values
and assign specific remaining values.
```{r}
c(...skip, e, f) %<-% list(1, 2, 3, 4, 5)
skip
e
f
```
Or you can assign the first value, skip values, and then assign the last value.
```{r}
c(begin, ...middle, end) %<-% list(1, 2, 3, 4, 5)
begin
middle
end
```
## Skipped values: anonymous elements
You can skip one or more values without raising an error by using a period (`.`)
instead of a variable name. For example, you might care only about the min,
mean, and max values of a vector's `summary`.
```{r}
c(min_wt, ., ., mean_wt, ., max_wt) %<-% summary(mtcars$wt)
min_wt
mean_wt
max_wt
```
By combining an anonymous element (`.`) with the collector prefix, (`...`), you
can ignore whole sublists.
```{r}
c(begin, ..., end) %<-% list("hello", "blah", list("blah"), "blah", "world!")
begin
end
```
You can mix periods and collectors together to selectively keep and discard
elements.
```{r}
c(begin, ., ...middle, end) %<-% as.list(1:5)
begin
middle
end
```
It is important to note that although value(s) are skipped they are still
expected. The next section touches on how to handle missing values.
## Default values: handle missing values
You can specify a default value for a left-hand side variable using `=`, similar
to specifying the default value of a function argument. This comes in handy when
the number of elements returned by a function cannot be guaranteed. `tail` for
example may return fewer elements than asked for.
```{r}
nums <- 1:2
c(x, y) %<-% tail(nums, 2)
x
y
```
However, if we tried to get 3 elements and assign them an error would be raised
because `tail(nums, 3)` still returns only 2 values.
```{r, error = TRUE}
c(x, y, z) %<-% tail(nums, 3)
```
We can fix the problem and resolve the error by specifying a default value for
`z`.
```{r}
c(x, y, z = NULL) %<-% tail(nums, 3)
x
y
z
```
## Swapping values
A handy trick is swapping values without the use of a temporary variable.
```{r}
c(first, last) %<-% c("Ai", "Genly")
first
last
c(first, last) %<-% c(last, first)
first
last
```
or
```{r}
cat <- "meow"
dog <- "bark"
c(cat, dog, fish) %<-% c(dog, cat, dog)
cat
dog
fish
```
## Right operator
The `magrittr` package provides a pipe operator `%>%` which allows functions
to be called in succession instead of nested. The left operator `%<-%`
does not work well with these function chains. Instead, the right operator
`%->%` is recommended. The below example is adapted from the `magrittr` readme.
```{r, eval = require("magrittr")}
library(magrittr)
mtcars %>%
subset(hp > 100) %>%
aggregate(. ~ cyl, data = ., FUN = . %>% mean() %>% round(2)) %>%
transform(kpl = mpg %>% multiply_by(0.4251)) %->%
c(cyl, mpg, ...rest)
cyl
mpg
rest
```
zeallot/README.md 0000644 0001762 0000144 00000011465 13233122505 013206 0 ustar ligges users # zeallot
Variable assignment with zeal!
[travis]: https://travis-ci.org/nteetor/zeallot.svg?branch=master "shake and bake"
[appveyor]: https://ci.appveyor.com/api/projects/status/github/nteetor/zeallot?branch=master&svg=true "frappe!"
[coverage]: https://codecov.io/gh/nteetor/zeallot/branch/master/graph/badge.svg "deep fat fry"
[cran]: https://www.r-pkg.org/badges/version/zeallot "green means go!"
[downloads]: https://cranlogs.r-pkg.org/badges/last-month/zeallot "[====] 100%"
![alt text][travis] ![alt text][appveyor] ![alt text][coverage] ![alt text][cran] ![alt text][downloads]
## What's there to be excited about?
zeallot allows multiple, unpacking, or destructuring assignment in R by
providing the `%<-%` operator. With zeallot you can tighten code with explicit
variable names, unpack pieces of a lengthy list or the entirety of a small list,
destructure and assign object elements, or do it all at once.
Unpack a vector of values.
```R
c(x, y) %<-% c(0, 1)
#> x
#[1] 0
#> y
#[1] 1
```
Unpack a list of values.
```R
c(r, d) %<-% list(2, 2)
#> r
#[1] 2
#> d
#[1] 2
```
Destructure a data frame and assign its columns.
```R
c(duration, wait) %<-% head(faithful)
#> duration
#[1] 3.600 1.800 3.333 2.283 4.533 2.883
#> wait
#[1] 79 54 74 62 85 55
```
Unpack a nested list into nested left-hand side variables.
```R
c(c(a, b), c(c, d)) %<-% list(list(1, 2), list(3, 4))
#> a
#[1] 1
#> b
#[1] 2
#> c
#[1] 3
#> d
#[1] 4
```
Destructure and partially unpack a list. "a" is assigned to `first`, but
"b", "c", "d", and "e" are grouped and assigned to one variable.
```R
c(first, ...rest) %<-% list("a", "b", "c", "d", "e")
first
#[1] "a"
rest
#[[1]]
#[1] "b"
#
#[[2]]
#[1] "c"
#
#[[3]]
#[1] "d"
#
#[[4]]
#[1] "e"
```
### Installation
You can install zeallot from CRAN.
```R
install.packages("zeallot")
```
Use devtools to install the latest, development version of zeallot from GitHub.
```R
devtools::install_github("nteetor/zeallot")
```
## Getting Started
Below is a simple example using the [purrr](https://github.com/hadley/purrr)
package and the safely function.
### Safe Functions
The `purrr::safely` function returns a "safe" version of a function. The
following example is borrowed from the safely documentation. In this example a
safe version of the log function is created.
```R
safe_log <- purrr::safely(log)
safe_log(10)
#$result
#[1] 2.302585
#
#$error
#NULL
safe_log("a")
#$result
#NULL
#
#$error
#
```
A safe function always returns a list of two elements and will not throw an
error. Instead of throwing an error, the error element of the return list is set
and the value element is NULL. When called successfully the result element is
set and the error element is NULL.
Safe functions are a great way to write self-documenting code. However, dealing
with a return value that is always a list could prove tedious and may undo
efforts to write concise, readable code. Enter zeallot.
### The `%<-%` Operator
With zeallot's unpacking operator `%<-%` we can unpack a safe function's return
value into two explicit variables and avoid dealing with the list return value
all together.
```R
c(res, err) %<-% safe_log(10)
res
#[1] 2.302585
err
#NULL
```
The name structure of the operator is a flat or nested set of bare variable
names built with calls to `c()`. . These variables do not need to be previously
defined. On the right-hand side is a vector, list, or other R object to unpack.
`%<-%` unpacks the right-hand side, checks the number of variable names against
the number of unpacked values, and then assigns each unpacked value to a
variable. The result, instead of dealing with a list of values there are two
distinct variables, `res` and `err`.
### Further Reading and Examples
For more on the above example, other examples, and a thorough introduction to
zeallot check out the vignette on [unpacking
assignment](vignettes/unpacking-assignment.Rmd).
Below are links to discussions about multiple, unpacking, and destructuring
assignment in R,
* https://stackoverflow.com/questions/7519790/assign-multiple-new-variables-on-lhs-in-a-single-line-in-r
* https://stackoverflow.com/questions/1826519/how-to-assign-from-a-function-which-returns-more-than-one-value
## Related work
The [vadr](https://github.com/crowding/vadr) package includes a
[bind](https://github.com/crowding/vadr/blob/master/R/bind.R#L65) operation
with much of the same functionality as `%<-%`. As the author states, "[they]
strongly prefer there to be a `<-` anywhere that there is a modification to the
environment." If you feel similarly I suggest looking at vadr. Unfortunately the
vadr package is not on CRAN and will need to be installed using
`devtools::install_github()`.
---
Thank you to Paul Teetor for inspiring me to build zeallot.
Without his encouragement nothing would have gotten off the ground.
zeallot/MD5 0000644 0001762 0000144 00000002700 13233373325 012237 0 ustar ligges users 317ddec42e638f853885c396a3d07600 *DESCRIPTION
81bb22d15833c773c4959b88d9eeb041 *LICENSE
13c129150527cd8c972cde2c129d2985 *NAMESPACE
7d9e1f677ef76e0b51d87e04ad18b9cf *NEWS.md
5163d33f078bee29ae4f87c6ddb183f4 *R/collect.R
b8c5d6d36bee4f9ab596689b5041e243 *R/destructure.R
cd52cb32be20bdb1436361db1c039895 *R/operator.R
1b857645b00f2e030c5ba19f6339d8ab *R/pair-off.R
64e5ddbe29e60976311d84adaae05263 *R/utils.R
0367c69e86a410f4a7ce6a75f99c44c4 *R/zeallot.R
c5e63ff40e12ef56258c1e47a50549c2 *README.md
540f319bd2c335683fcf4c1a81ce04d6 *build/vignette.rds
731e0182f364bc8e2629444930cffcfe *inst/doc/unpacking-assignment.R
3ab91313520fa8d4d508d605ab0efcc9 *inst/doc/unpacking-assignment.Rmd
8d51d36667d582b3fafcdf088933a0b8 *inst/doc/unpacking-assignment.html
f9dfc8b999b7a00e992ab27c49b82c6f *man/destructure-methods.Rd
78cc76e31b4b292ff7abd649d88745fe *man/destructure.Rd
f348cedce406c7399b9c3ce695d1e0ff *man/operator.Rd
5cc3ba27d0d4c252738c60686717cf24 *man/zeallot.Rd
6a5da9164f3f30e99da941b75a0b3dd2 *tests/testthat.R
dbfe3ed8c61b4026e36e2da7e916dfd9 *tests/testthat/test-collect.R
5a630a2bfaa988fd3409f2fcca3622d3 *tests/testthat/test-destructure.R
f782871fd5c7cb748ae7826dca28e6a2 *tests/testthat/test-operator.R
1d162f606d9c17d84c3a35cc6f9d7201 *tests/testthat/test-pair-off.R
23c882c0f378c9169614ea143728844b *tests/testthat/test-pipe.R
a9badc2bae635af784c02c7bd9eae7e1 *tests/testthat/test-utils.R
3ab91313520fa8d4d508d605ab0efcc9 *vignettes/unpacking-assignment.Rmd
zeallot/build/ 0000755 0001762 0000144 00000000000 13233132151 013015 5 ustar ligges users zeallot/build/vignette.rds 0000644 0001762 0000144 00000000327 13233132151 015356 0 ustar ligges users b```b`faf`b2 1#'(+HLKM,.LM+MAS'
SWFY%9h
Ű[
t0XD50!bKM-F3% 5/$~hZ8S+`zPAհe
,s\ܠL t7`~r=xAq $GsjĒD"~u zeallot/DESCRIPTION 0000644 0001762 0000144 00000002004 13233373325 013432 0 ustar ligges users Package: zeallot
Type: Package
Title: Multiple, Unpacking, and Destructuring Assignment
Version: 0.1.0
Authors@R: c(
person(given = "Nathan", family = "Teetor", email = "nathanteetor@gmail.com", role = c("aut", "cre")),
person(given = "Paul", family = "Teetor", role = "ctb"))
Description: Provides a %<-% operator to perform multiple,
unpacking, and destructuring assignment in R. The
operator unpacks the right-hand side of an assignment
into multiple values and assigns these values to
variables on the left-hand side of the assignment.
URL: https://github.com/nteetor/zeallot
BugReports: https://github.com/nteetor/zeallot/issues
License: MIT + file LICENSE
Encoding: UTF-8
RoxygenNote: 6.0.1
VignetteBuilder: knitr
Suggests: testthat, knitr, rmarkdown, purrr, magrittr
NeedsCompilation: no
Packaged: 2018-01-27 17:18:33 UTC; nteetor
Author: Nathan Teetor [aut, cre],
Paul Teetor [ctb]
Maintainer: Nathan Teetor
Repository: CRAN
Date/Publication: 2018-01-28 16:14:13 UTC
zeallot/man/ 0000755 0001762 0000144 00000000000 13233122505 012473 5 ustar ligges users zeallot/man/operator.Rd 0000644 0001762 0000144 00000011444 13233122505 014621 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/operator.R
\name{operator}
\alias{operator}
\alias{\%<-\%}
\alias{\%->\%}
\title{Multiple assignment operators}
\usage{
x \%<-\% value
value \%->\% x
}
\arguments{
\item{x}{A name structure, see section below.}
\item{value}{A list of values, vector of values, or \R object to assign.}
}
\value{
\code{\%<-\%} and \code{\%->\%} invisibly return \code{value}.
These operators are used primarily for their assignment side-effect.
\code{\%<-\%} and \code{\%->\%} assign into the environment in which they
are evaluated.
}
\description{
Assign values to name(s).
}
\section{Name Structure}{
\strong{the basics}
At its simplest, the name structure may be a single variable name, in which
case \code{\%<-\%} and \code{\%->\%} perform regular assignment, \code{x
\%<-\% list(1, 2, 3)} or \code{list(1, 2, 3) \%->\% x}.
To specify multiple variable names use a call to \code{c()}, for example
\code{c(x, y, z) \%<-\% c(1, 2, 3)}.
When \code{value} is neither an atomic vector nor a list, \code{\%<-\%} and
\code{\%->\%} will try to destructure \code{value} into a list before assigning
variables, see \code{\link[=destructure]{destructure()}}.
\strong{object parts}
Like assigning a variable, one may also assign part of an object, \code{c(x,
x[[1]]) \%<-\% list(list(), 1)}.
\strong{nested names}
One can also nest calls to \code{c()} when needed, \code{c(x, c(y, z))}. This nested
structure is used to unpack nested values,
\code{c(x, c(y, z)) \%<-\% list(1, list(2, 3))}.
\strong{collector variables}
To gather extra values from the beginning, middle, or end of \code{value} use a
collector variable. Collector variables are indicated with a \code{...}
prefix, \code{c(...start, z) \%<-\% list(1, 2, 3, 4)}.
\strong{skipping values}
Use \code{.} in place of a variable name to skip a value without raising an error
or assigning the value, \code{c(x, ., z) \%<-\% list(1, 2, 3)}.
Use \code{...} to skip multiple values without raising an error or assigning the
values, \code{c(w, ..., z) \%<-\% list(1, NA, NA, 4)}.
\strong{default values}
Use \code{=} to specify a default value for a variable, \code{c(x, y = NULL)
\%<-\% tail(1, 2)}.
When assigning part of an object a default value may not be specified because
of the syntax enforced by \R. The following would raise an \code{"unexpected '=' ..."} error, \code{c(x, x[[1]] = 1) \%<-\% list(list())}.
}
\examples{
# basic usage
c(a, b) \%<-\% list(0, 1)
a # 0
b # 1
# unpack and assign nested values
c(c(e, f), c(g, h)) \%<-\% list(list(2, 3), list(3, 4))
e # 2
f # 3
g # 4
h # 5
# can assign more than 2 values at once
c(j, k, l) \%<-\% list(6, 7, 8)
# assign columns of data frame
c(erupts, wait) \%<-\% faithful
erupts # 3.600 1.800 3.333 ..
wait # 79 54 74 ..
# assign only specific columns, skip
# other columns
c(mpg, cyl, disp, ...) \%<-\% mtcars
mpg # 21.0 21.0 22.8 ..
cyl # 6 6 4 ..
disp # 160.0 160.0 108.0 ..
# skip initial values, assign final value
TODOs <- list("make food", "pack lunch", "save world")
c(..., task) \%<-\% TODOs
task # "save world"
# assign first name, skip middle initial,
# assign last name
c(first, ., last) \%<-\% c("Ursula", "K", "Le Guin")
first # "Ursula"
last # "Le Guin"
# simple model and summary
mod <- lm(hp ~ gear, data = mtcars)
# extract call and fstatistic from
# the summary
c(modcall, ..., modstat, .) \%<-\% summary(mod)
modcall
modstat
# unpack nested values w/ nested names
fibs <- list(1, list(2, list(3, list(5))))
c(f2, c(f3, c(f4, c(f5)))) \%<-\% fibs
f2 # 1
f3 # 2
f4 # 3
f5 # 5
# unpack first numeric, leave rest
c(f2, fibcdr) \%<-\% fibs
f2 # 1
fibcdr # list(2, list(3, list(5)))
# swap values without using temporary variables
c(a, b) \%<-\% c("eh", "bee")
a # "eh"
b # "bee"
c(a, b) \%<-\% c(b, a)
a # "bee"
b # "eh"
# unpack `strsplit` return value
names <- c("Nathan,Maria,Matt,Polly", "Smith,Peterson,Williams,Jones")
c(firsts, lasts) \%<-\% strsplit(names, ",")
firsts # c("Nathan", "Maria", ..
lasts # c("Smith", "Peterson", ..
# handle missing values with default values
parse_time <- function(x) {
strsplit(x, " ")[[1]]
}
c(hour, period = NA) \%<-\% parse_time("10:00 AM")
hour # "10:00"
period # "AM"
c(hour, period = NA) \%<-\% parse_time("15:00")
hour # "15:00"
period # NA
# right operator
list(1, 2, "a", "b", "c") \%->\% c(x, y, ...chars)
x # 1
y # 2
chars # list("a", "b", "c")
# magrittr chains, install.packages("magrittr") for this example
if (requireNamespace("magrittr", quietly = TRUE)) {
library(magrittr)
c("hello", "world!") \%>\%
paste0("\\n") \%>\%
lapply(toupper) \%->\%
c(greeting, subject)
greeting # "HELLO\\n"
subject # "WORLD!\\n"
}
}
\seealso{
For more on unpacking custom objects please refer to
\code{\link[=destructure]{destructure()}}.
}
zeallot/man/destructure.Rd 0000644 0001762 0000144 00000003516 13233122505 015340 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/destructure.R
\name{destructure}
\alias{destructure}
\title{Destructure an object}
\usage{
destructure(x)
}
\arguments{
\item{x}{An \R object.}
}
\description{
\code{destructure} is used during unpacking assignment to coerce an object
into a list. Individual elements of the list are assigned to names on the
left-hand side of the unpacking assignment expression.
}
\details{
If \code{x} is atomic \code{destructure} expects \code{length(x)} to be 1. If a vector with
length greater than 1 is passed to \code{destructure} an error is raised.
New implementations of \code{destructure} can be very simple. A new
\code{destructure} implementation might only strip away the class of a custom
object and return the underlying list structure. Alternatively, an object
might destructure into a nested set of values and may require a more
complicated implementation. In either case, new implementations must return a
list object so \code{\%<-\%} can handle the returned value(s).
}
\examples{
# data frames become a list of columns
destructure(
data.frame(x = 0:4, y = 5:9)
)
# strings are split into list of characters
destructure("abcdef")
# dates become list of year, month, and day
destructure(Sys.Date())
# create a new destructure implementation
shape <- function(sides = 4, color = "red") {
structure(
list(sides = sides, color = color),
class = "shape"
)
}
\dontrun{
# cannot destructure the shape object yet
c(sides, color) \%<-\% shape()
}
# implement `destructure` for shapes
destructure.shape <- function(x) {
list(x$sides, x$color)
}
# now we can destructure shape objects
c(sides, color) \%<-\% destructure(shape())
sides # 4
color # "red"
c(sides, color) \%<-\% destructure(shape(3, "green"))
sides # 3
color # 'green'
}
\seealso{
\code{\link{\%<-\%}}
}
zeallot/man/destructure-methods.Rd 0000644 0001762 0000144 00000002635 13233122505 017002 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/destructure.R
\name{destructure-methods}
\alias{destructure-methods}
\alias{destructure.character}
\alias{destructure.complex}
\alias{destructure.Date}
\alias{destructure.data.frame}
\alias{destructure.summary.lm}
\alias{destructure.default}
\title{Included Implementations of \code{destructure}}
\usage{
\method{destructure}{character}(x)
\method{destructure}{complex}(x)
\method{destructure}{Date}(x)
\method{destructure}{data.frame}(x)
\method{destructure}{summary.lm}(x)
\method{destructure}{default}(x)
}
\arguments{
\item{x}{An \R object.}
}
\value{
A list of elements from \code{x}.
}
\description{
zeallot includes \code{destructure} methods for the following classes:
\code{character}, \code{complex}, \code{Date}, \code{data.frame}, and
\code{summary.lm}. See details for how each object is transformed into a
list.
}
\details{
\code{character} values are split into a list of individual characters.
\code{complex} values are split into a list of two values, the real and the
imaginary part.
\code{Date} values are split into a list of three numeric values, the year,
month, and day.
\code{data.frame} values are coerced into a list using \code{as.list}.
\code{summary.lm} values are coerced into a list of values, one element for
each of the eleven values returned by \code{summary.lm}.
}
\seealso{
\link{destructure}
}
\keyword{internal}
zeallot/man/zeallot.Rd 0000644 0001762 0000144 00000001235 13233122505 014435 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/zeallot.R
\docType{package}
\name{zeallot}
\alias{zeallot}
\alias{zeallot-package}
\alias{zeallot-package}
\title{Multiple, unpacking, and destructuring assignment in R}
\description{
zeallot provides a \code{\link{\%<-\%}} operator to perform multiple
assignment in R. To get started with zeallot be sure to read over the
introductory vignette on unpacking assignment,
\code{vignette('unpacking-assignment')}.
}
\seealso{
\code{\link{\%<-\%}}
}
\author{
\strong{Maintainer}: Nathan Teetor \email{nathanteetor@gmail.com}
Other contributors:
\itemize{
\item Paul Teetor [contributor]
}
}
zeallot/LICENSE 0000644 0001762 0000144 00000000053 13233122505 012723 0 ustar ligges users YEAR: 2017
COPYRIGHT HOLDER: Nathan Teetor