zeallot/0000755000176200001440000000000013233373325011730 5ustar liggesuserszeallot/inst/0000755000176200001440000000000013233123577012707 5ustar liggesuserszeallot/inst/doc/0000755000176200001440000000000013233123577013454 5ustar liggesuserszeallot/inst/doc/unpacking-assignment.html0000644000176200001440000015407313233132151020465 0ustar liggesusers 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.

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.

lat
#> [1] 38.06194
lng
#> [1] -122.6439

You can also unpack the elements of a vector.

c(lat, lng) %<-% c(38.061944, -122.643889)
lat
#> [1] 38.06194
lng
#> [1] -122.6439

You can unpack much longer structures, too, of course, such as the 6-part summary of a vector.

c(min_wt, q1_wt, med_wt, mean_wt, q3_wt, max_wt) %<-% summary(mtcars$wt)
min_wt
#> [1] 1.513
q1_wt
#> [1] 2.58125
med_wt
#> [1] 3.325
mean_wt
#> [1] 3.21725
q3_wt
#> [1] 3.61
max_wt
#> [1] 5.424

If the left-hand side and right-hand sides do not match, an error is raised. This guards against missing or unexpected values.

c(stg1, stg2, stg3) %<-% list("Moe", "Donald")
#> Error: invalid `%<-%` right-hand side, incorrect number of values
c(stg1, stg2, stg3) %<-% list("Moe", "Larry", "Curley", "Donald")
#> Error: invalid `%<-%` right-hand side, incorrect number of 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.

c(mpg, cyl, disp, hp) %<-% mtcars[, 1:4]

head(mpg)
#> [1] 21.0 21.0 22.8 21.4 18.7 18.1

head(cyl)
#> [1] 6 6 4 6 8 6

head(disp)
#> [1] 160 160 108 258 360 225

head(hp)
#> [1] 110 110  93 110 175 105

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.

c(a, c(b, d), e) %<-% list("begin", list("middle1", "middle2"), "end")
a
#> [1] "begin"
b
#> [1] "middle1"
d
#> [1] "middle2"
e
#> [1] "end"

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.

c(a, c(b, d, e), f) %<-% list("begin", list("middle1", "middle2"), "end")
#> Error: invalid `%<-%` right-hand side, incorrect number of values

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.

str(rest)
#> List of 8
#>  $ coefficients : num [1:2, 1:4] 37.885 -2.876 2.074 0.322 18.268 ...
#>   ..- attr(*, "dimnames")=List of 2
#>   .. ..$ : chr [1:2] "(Intercept)" "cyl"
#>   .. ..$ : chr [1:4] "Estimate" "Std. Error" "t value" "Pr(>|t|)"
#>  $ aliased      : Named logi [1:2] FALSE FALSE
#>   ..- attr(*, "names")= chr [1:2] "(Intercept)" "cyl"
#>  $ sigma        : num 3.21
#>  $ df           : int [1:3] 2 30 2
#>  $ r.squared    : num 0.726
#>  $ adj.r.squared: num 0.717
#>  $ fstatistic   : Named num [1:3] 79.6 1 30
#>   ..- attr(*, "names")= chr [1:3] "value" "numdf" "dendf"
#>  $ cov.unscaled : num [1:2, 1:2] 0.4185 -0.0626 -0.0626 0.0101
#>   ..- attr(*, "dimnames")=List of 2
#>   .. ..$ : chr [1:2] "(Intercept)" "cyl"
#>   .. ..$ : chr [1:2] "(Intercept)" "cyl"

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.

c(fcall, fterms, resids, rest) %<-% summary(f)
#> Error: invalid `%<-%` right-hand side, incorrect number of values

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.

c(...skip, e, f) %<-% list(1, 2, 3, 4, 5)
skip
#> [[1]]
#> [1] 1
#> 
#> [[2]]
#> [1] 2
#> 
#> [[3]]
#> [1] 3
e
#> [1] 4
f
#> [1] 5

Or you can assign the first value, skip values, and then assign the last value.

c(begin, ...middle, end) %<-% list(1, 2, 3, 4, 5)
begin
#> [1] 1
middle
#> [[1]]
#> [1] 2
#> 
#> [[2]]
#> [1] 3
#> 
#> [[3]]
#> [1] 4
end
#> [1] 5

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.

c(min_wt, ., ., mean_wt, ., max_wt) %<-% summary(mtcars$wt)
min_wt
#> [1] 1.513
mean_wt
#> [1] 3.21725
max_wt
#> [1] 5.424

By combining an anonymous element (.) with the collector prefix, (...), you can ignore whole sublists.

c(begin, ..., end) %<-% list("hello", "blah", list("blah"), "blah", "world!")
begin
#> [1] "hello"
end
#> [1] "world!"

You can mix periods and collectors together to selectively keep and discard elements.

c(begin, ., ...middle, end) %<-% as.list(1:5)
begin
#> [1] 1
middle
#> [[1]]
#> [1] 3
#> 
#> [[2]]
#> [1] 4
end
#> [1] 5

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.

nums <- 1:2
c(x, y) %<-% tail(nums, 2)
x
#> [1] 1
y
#> [1] 2

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.

c(x, y, z) %<-% tail(nums, 3)
#> Error: invalid `%<-%` right-hand side, incorrect number of values

We can fix the problem and resolve the error by specifying a default value for z.

c(x, y, z = NULL) %<-% tail(nums, 3)
x
#> [1] 1
y
#> [1] 2
z
#> NULL

Swapping values

A handy trick is swapping values without the use of a temporary variable.

c(first, last) %<-% c("Ai", "Genly")
first
#> [1] "Ai"
last
#> [1] "Genly"

c(first, last) %<-% c(last, first)
first
#> [1] "Genly"
last
#> [1] "Ai"

or

cat <- "meow"
dog <- "bark"

c(cat, dog, fish) %<-% c(dog, cat, dog)
cat
#> [1] "bark"
dog
#> [1] "meow"
fish
#> [1] "bark"

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.

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
#> [1] 4 6 8
mpg
#> [1] 25.90 19.74 15.10
rest
#> $disp
#> [1] 108.05 183.31 353.10
#> 
#> $hp
#> [1] 111.00 122.29 209.21
#> 
#> $drat
#> [1] 3.94 3.59 3.23
#> 
#> $wt
#> [1] 2.15 3.12 4.00
#> 
#> $qsec
#> [1] 17.75 17.98 16.77
#> 
#> $vs
#> [1] 1.00 0.57 0.00
#> 
#> $am
#> [1] 1.00 0.43 0.14
#> 
#> $gear
#> [1] 4.50 3.86 3.29
#> 
#> $carb
#> [1] 2.00 3.43 3.50
#> 
#> $kpl
#> [1] 11.010090  8.391474  6.419010
zeallot/inst/doc/unpacking-assignment.Rmd0000644000176200001440000002175113233124322020240 0ustar liggesusers--- 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.R0000644000176200001440000001167213233132150017716 0ustar liggesusers## ---- 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/0000755000176200001440000000000013233122505013062 5ustar liggesuserszeallot/tests/testthat.R0000644000176200001440000000007213233122505015044 0ustar liggesuserslibrary(testthat) library(zeallot) test_check("zeallot") zeallot/tests/testthat/0000755000176200001440000000000013233373325014732 5ustar liggesuserszeallot/tests/testthat/test-utils.R0000644000176200001440000000331713233123122017162 0ustar liggesuserscontext(" * 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.R0000644000176200001440000000145513233122505016764 0ustar liggesuserscontext(' * 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.R0000644000176200001440000000240613233122505017451 0ustar liggesuserscontext(" * 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.R0000644000176200001440000001475013233122505017664 0ustar liggesuserscontext(" * 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.R0000644000176200001440000000322213233122505020372 0ustar liggesuserscontext(" * 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.R0000644000176200001440000000636313233122505017535 0ustar liggesuserscontext(" * 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/NAMESPACE0000644000176200001440000000043113233122505013135 0ustar liggesusers# 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.md0000644000176200001440000000533213233126163013025 0ustar liggesusers# 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/0000755000176200001440000000000013233122576012131 5ustar liggesuserszeallot/R/zeallot.R0000644000176200001440000000060313233122505013715 0ustar liggesusers#' 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.R0000644000176200001440000000244413233122505013675 0ustar liggesusersis_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.R0000644000176200001440000001150513233122576013416 0ustar liggesusersis_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.R0000644000176200001440000000363013233122505013751 0ustar liggesuserspair_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.R0000644000176200001440000000723213233122505014621 0ustar liggesusers#' 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.R0000644000176200001440000001651013233122505014102 0ustar liggesusers#' 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/0000755000176200001440000000000013233132151013726 5ustar liggesuserszeallot/vignettes/unpacking-assignment.Rmd0000644000176200001440000002175113233124322020526 0ustar liggesusers--- 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.md0000644000176200001440000001146513233122505013206 0ustar liggesusers# 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/MD50000644000176200001440000000270013233373325012237 0ustar liggesusers317ddec42e638f853885c396a3d07600 *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/0000755000176200001440000000000013233132151013015 5ustar liggesuserszeallot/build/vignette.rds0000644000176200001440000000032713233132151015356 0ustar liggesusersb```b`faf`b2 1# '(+HLKM,.LM+ MAS' SWFY%9h Ű[ t0XD50!bKM-F3% 5/$~hZ8S+`zP԰Aհe ,s\ܠL t7`~΢r=xAq$GsjĒD"~uzeallot/DESCRIPTION0000644000176200001440000000200413233373325013432 0ustar liggesusersPackage: 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/0000755000176200001440000000000013233122505012473 5ustar liggesuserszeallot/man/operator.Rd0000644000176200001440000001144413233122505014621 0ustar liggesusers% 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.Rd0000644000176200001440000000351613233122505015340 0ustar liggesusers% 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.Rd0000644000176200001440000000263513233122505017002 0ustar liggesusers% 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.Rd0000644000176200001440000000123513233122505014435 0ustar liggesusers% 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/LICENSE0000644000176200001440000000005313233122505012723 0ustar liggesusersYEAR: 2017 COPYRIGHT HOLDER: Nathan Teetor