vec_c() for S4 classes

[krlmlr]

Introduced in #803, breaks as of d8efb4f, works in 361667d = d8efb4f^.

.rando <- setClass("rando", contains = "numeric", slots = list(.Data = "numeric"))
rando <- function(n = 0) {
  .rando(as.numeric(seq_len(n)))
}

as_rando <- function(x) {
  rando(length(x))
}

setMethod("[", "rando", function(x, i, j, ..., drop = TRUE) {
  new_n <- length(vec_as_location(i, length(x@.Data), names(x@.Data)))
  rando(new_n)
})


library(vctrs)
vec_c(rando(), rando())
#> Error: Can't find vctrs or base methods for concatenation.
#> vctrs methods must be implemented for class `rando`.
#> See <https://vctrs.r-lib.org/articles/s3-vector.html>.


library(lubridate)
#> 
#> Attaching package: 'lubridate'
#> The following object is masked from 'package:vctrs':
#> 
#>     new_duration
#> The following object is masked from 'package:base':
#> 
#>     date
x <- interval(today(), today())
vec_c(x, x)
#> Error: Can't find vctrs or base methods for concatenation.
#> vctrs methods must be implemented for class `Interval`.
#> See <https://vctrs.r-lib.org/articles/s3-vector.html>.

^{Created on 2020-03-15 by the reprex package (v0.3.0)}

[DavisVaughan]

Lubridate Period and Interval objects both have S4 c() methods defined. Hopefully we can figure out a way to detect these like we do with S3 methods. I do not believe that rando should work with vec_c() with the way it is currently defined. If a c() method was added, it should work.

https://github.com/tidyverse/lubridate/blob/f9f36a09f5d02b3fedf478bd93e7f547cac65752/R/periods.r#L209

https://github.com/tidyverse/lubridate/blob/f9f36a09f5d02b3fedf478bd93e7f547cac65752/R/intervals.r#L84

[batpigandme]

Should this have also fixed the Duration and Interval issues below? (It didn't 😬 )

library(tidyverse)
library(lubridate)
test <- tibble(A=1:5, B=hours(1:5))
test
#> # A tibble: 5 x 2
#>       A B       
#>   <int> <Period>
#> 1     1 1H 0M 0S
#> 2     2 2H 0M 0S
#> 3     3 3H 0M 0S
#> 4     4 4H 0M 0S
#> 5     5 5H 0M 0S
nested <- test %>% nest(B2=B)
nested
#> # A tibble: 5 x 2
#>       A B2              
#>   <int> <list>          
#> 1     1 <tibble [1 × 1]>
#> 2     2 <tibble [1 × 1]>
#> 3     3 <tibble [1 × 1]>
#> 4     4 <tibble [1 × 1]>
#> 5     5 <tibble [1 × 1]>
unnested <- nested %>% unnest(cols=B2)
#> Error: No common type for `..1$B2$B` <Period> and `..2$B2$B` <Period>.
#> Backtrace:
#>      █
#>   1. ├─nested %>% unnest(cols = B2)
#>   2. │ ├─base::withVisible(eval(quote(`_fseq`(`_lhs`)), env, env))
#>   3. │ └─base::eval(quote(`_fseq`(`_lhs`)), env, env)
#>   4. │   └─base::eval(quote(`_fseq`(`_lhs`)), env, env)
#>   5. │     └─`_fseq`(`_lhs`)
#>   6. │       └─magrittr::freduce(value, `_function_list`)
#>   7. │         ├─base::withVisible(function_list[[k]](value))
#>   8. │         └─function_list[[k]](value)
#>   9. │           ├─tidyr::unnest(., cols = B2)
#>  10. │           └─tidyr:::unnest.data.frame(., cols = B2)
#>  11. │             └─tidyr::unchop(data, !!cols, keep_empty = keep_empty, ptype = ptype)
#>  12. │               └─vctrs::vec_rbind(!!!x, .ptype = ptype)
#>  13. ├─vctrs:::vec_ptype2_dispatch_s3(x = x, y = y, x_arg = x_arg, y_arg = y_arg)
#>  14. └─vctrs:::vec_ptype2.default(x = x, y = y, x_arg = x_arg, y_arg = y_arg)
#>  15.   └─vctrs::stop_incompatible_type(x, y, x_arg = x_arg, y_arg = y_arg)
#>  16.     └─vctrs:::stop_incompatible(...)
#>  17.       └─vctrs:::stop_vctrs(...)

library(tidyverse)
library(lubridate)
date1 <- c(ymd_hms("2009-03-08 01:59:59") - 0:4)
date2 <- c(ymd_hms("2000-02-29 12:00:00") - 0:4)
test <- tibble::tibble(a = 1:5, day1 = date1, day2 = date2)

int_tib <- test %>%
  mutate(b = interval(day2, day1)) %>%
  select(c(a, b))


nested <- int_tib %>% nest(b2 = b)
nested
#> # A tibble: 5 x 2
#>       a b2              
#>   <int> <list>          
#> 1     1 <tibble [1 × 1]>
#> 2     2 <tibble [1 × 1]>
#> 3     3 <tibble [1 × 1]>
#> 4     4 <tibble [1 × 1]>
#> 5     5 <tibble [1 × 1]>

unnested <- nested %>% unnest(cols = b2)
#> Error: No common type for `..1$b2$b` <Interval> and `..2$b2$b` <Interval>.
#> Backtrace:
#>      █
#>   1. ├─nested %>% unnest(cols = b2)
#>   2. │ ├─base::withVisible(eval(quote(`_fseq`(`_lhs`)), env, env))
#>   3. │ └─base::eval(quote(`_fseq`(`_lhs`)), env, env)
#>   4. │   └─base::eval(quote(`_fseq`(`_lhs`)), env, env)
#>   5. │     └─`_fseq`(`_lhs`)
#>   6. │       └─magrittr::freduce(value, `_function_list`)
#>   7. │         ├─base::withVisible(function_list[[k]](value))
#>   8. │         └─function_list[[k]](value)
#>   9. │           ├─tidyr::unnest(., cols = b2)
#>  10. │           └─tidyr:::unnest.data.frame(., cols = b2)
#>  11. │             └─tidyr::unchop(data, !!cols, keep_empty = keep_empty, ptype = ptype)
#>  12. │               └─vctrs::vec_rbind(!!!x, .ptype = ptype)
#>  13. ├─vctrs:::vec_ptype2_dispatch_s3(x = x, y = y, x_arg = x_arg, y_arg = y_arg)
#>  14. └─vctrs:::vec_ptype2.default(x = x, y = y, x_arg = x_arg, y_arg = y_arg)
#>  15.   └─vctrs::stop_incompatible_type(x, y, x_arg = x_arg, y_arg = y_arg)
#>  16.     └─vctrs:::stop_incompatible(...)
#>  17.       └─vctrs:::stop_vctrs(...)

^{Created on 2020-03-18 by the reprex package (v0.3.0.9001)}

[DavisVaughan]

Nope, that one is more related to #776, which we are also working on soon

This one is pretty strictly confined to vec_c(), which is how group chunks are combined back together in a dplyr mutate()

[lionel-]

It looks like this will require a c() fall back in vec_rbind(), because this is a complex foreign class: the attributes vary by objects.

This will come a little bit later but soon.

date1 <- c(ymd_hms("2009-03-08 01:59:59") - 0:4)
date2 <- c(ymd_hms("2000-02-29 12:00:00") - 0:4)

x <- vctrs::vec_chop(interval(date1, date2))
str(x)
#> List of 5
#>  $ :Formal class 'Interval' [package "lubridate"] with 3 slots
#>   .. ..@ .Data: num -2.85e+08
#>   .. ..@ start: POSIXct[1:1], format: "2009-03-08 01:59:59"
#>   .. ..@ tzone: chr "UTC"
#>  $ :Formal class 'Interval' [package "lubridate"] with 3 slots
#>   .. ..@ .Data: num -2.85e+08
#>   .. ..@ start: POSIXct[1:1], format: "2009-03-08 01:59:58"
#>   .. ..@ tzone: chr "UTC"
#>  $ :Formal class 'Interval' [package "lubridate"] with 3 slots
#>   .. ..@ .Data: num -2.85e+08
#>   .. ..@ start: POSIXct[1:1], format: "2009-03-08 01:59:57"
#>   .. ..@ tzone: chr "UTC"
#>  $ :Formal class 'Interval' [package "lubridate"] with 3 slots
#>   .. ..@ .Data: num -2.85e+08
#>   .. ..@ start: POSIXct[1:1], format: "2009-03-08 01:59:56"
#>   .. ..@ tzone: chr "UTC"
#>  $ :Formal class 'Interval' [package "lubridate"] with 3 slots
#>   .. ..@ .Data: num -2.85e+08
#>   .. ..@ start: POSIXct[1:1], format: "2009-03-08 01:59:55"
#>   .. ..@ tzone: chr "UTC"

[david-romano]

Should this have also fixed the Duration and Interval issues below? (It didn't 😬 )

library(tidyverse)
library(lubridate)
test <- tibble(A=1:5, B=hours(1:5))
test
#> # A tibble: 5 x 2
#>       A B       
#>   <int> <Period>
#> 1     1 1H 0M 0S
#> 2     2 2H 0M 0S
#> 3     3 3H 0M 0S
#> 4     4 4H 0M 0S
#> 5     5 5H 0M 0S
nested <- test %>% nest(B2=B)
nested
#> # A tibble: 5 x 2
#>       A B2              
#>   <int> <list>          
#> 1     1 <tibble [1 × 1]>
#> 2     2 <tibble [1 × 1]>
#> 3     3 <tibble [1 × 1]>
#> 4     4 <tibble [1 × 1]>
#> 5     5 <tibble [1 × 1]>
unnested <- nested %>% unnest(cols=B2)
#> Error: No common type for `..1$B2$B` <Period> and `..2$B2$B` <Period>.
#> Backtrace:
#>      █
#>   1. ├─nested %>% unnest(cols = B2)
#>   2. │ ├─base::withVisible(eval(quote(`_fseq`(`_lhs`)), env, env))
#>   3. │ └─base::eval(quote(`_fseq`(`_lhs`)), env, env)
#>   4. │   └─base::eval(quote(`_fseq`(`_lhs`)), env, env)
#>   5. │     └─`_fseq`(`_lhs`)
#>   6. │       └─magrittr::freduce(value, `_function_list`)
#>   7. │         ├─base::withVisible(function_list[[k]](value))
#>   8. │         └─function_list[[k]](value)
#>   9. │           ├─tidyr::unnest(., cols = B2)
#>  10. │           └─tidyr:::unnest.data.frame(., cols = B2)
#>  11. │             └─tidyr::unchop(data, !!cols, keep_empty = keep_empty, ptype = ptype)
#>  12. │               └─vctrs::vec_rbind(!!!x, .ptype = ptype)
#>  13. ├─vctrs:::vec_ptype2_dispatch_s3(x = x, y = y, x_arg = x_arg, y_arg = y_arg)
#>  14. └─vctrs:::vec_ptype2.default(x = x, y = y, x_arg = x_arg, y_arg = y_arg)
#>  15.   └─vctrs::stop_incompatible_type(x, y, x_arg = x_arg, y_arg = y_arg)
#>  16.     └─vctrs:::stop_incompatible(...)
#>  17.       └─vctrs:::stop_vctrs(...)

library(tidyverse)
library(lubridate)
date1 <- c(ymd_hms("2009-03-08 01:59:59") - 0:4)
date2 <- c(ymd_hms("2000-02-29 12:00:00") - 0:4)
test <- tibble::tibble(a = 1:5, day1 = date1, day2 = date2)

int_tib <- test %>%
  mutate(b = interval(day2, day1)) %>%
  select(c(a, b))


nested <- int_tib %>% nest(b2 = b)
nested
#> # A tibble: 5 x 2
#>       a b2              
#>   <int> <list>          
#> 1     1 <tibble [1 × 1]>
#> 2     2 <tibble [1 × 1]>
#> 3     3 <tibble [1 × 1]>
#> 4     4 <tibble [1 × 1]>
#> 5     5 <tibble [1 × 1]>

unnested <- nested %>% unnest(cols = b2)
#> Error: No common type for `..1$b2$b` <Interval> and `..2$b2$b` <Interval>.
#> Backtrace:
#>      █
#>   1. ├─nested %>% unnest(cols = b2)
#>   2. │ ├─base::withVisible(eval(quote(`_fseq`(`_lhs`)), env, env))
#>   3. │ └─base::eval(quote(`_fseq`(`_lhs`)), env, env)
#>   4. │   └─base::eval(quote(`_fseq`(`_lhs`)), env, env)
#>   5. │     └─`_fseq`(`_lhs`)
#>   6. │       └─magrittr::freduce(value, `_function_list`)
#>   7. │         ├─base::withVisible(function_list[[k]](value))
#>   8. │         └─function_list[[k]](value)
#>   9. │           ├─tidyr::unnest(., cols = b2)
#>  10. │           └─tidyr:::unnest.data.frame(., cols = b2)
#>  11. │             └─tidyr::unchop(data, !!cols, keep_empty = keep_empty, ptype = ptype)
#>  12. │               └─vctrs::vec_rbind(!!!x, .ptype = ptype)
#>  13. ├─vctrs:::vec_ptype2_dispatch_s3(x = x, y = y, x_arg = x_arg, y_arg = y_arg)
#>  14. └─vctrs:::vec_ptype2.default(x = x, y = y, x_arg = x_arg, y_arg = y_arg)
#>  15.   └─vctrs::stop_incompatible_type(x, y, x_arg = x_arg, y_arg = y_arg)
#>  16.     └─vctrs:::stop_incompatible(...)
#>  17.       └─vctrs:::stop_vctrs(...)

Created on 2020-03-18 by the reprex package (v0.3.0.9001)

Duration works, but Period (what hours() creates) doesn't -- anything with more than the .Data slot seems to raise the error.

[batpigandme]

Duration works, but Period (what hours() creates) doesn't -- anything with more than the .Data slot seems to raise the error.

I think Davis was saying this will be fixed in #776

[lionel-]

@batpigandme As it turns out it won't, see #919 (comment)

[batpigandme]

Oh, shoot! Sorry, @david-romano, skipped a comment there! 🤦‍♀

[david-romano]

No worries, @batpigandme! Would it make sense to post a work-around on RStudio Community referencing @lionel-'s comment above?

[batpigandme]

Sure! Thanks for the help.