Merge pull request #521 from SebKrantz/development

Development

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: collapse
 Title: Advanced and Fast Data Transformation
-Version: 2.0.7
-Date: 2023-12-07
+Version: 2.0.8
+Date: 2024-01-01
 Authors@R: c(
            person("Sebastian", "Krantz", role = c("aut", "cre"), 
                   email = "[email protected]", 

NEWS.md

@@ -1,3 +1,15 @@
+# collapse 2.0.8
+
+* In `pivot(..., values = [multiple columns], labels = "new_labels_column", how = "wieder")`, if the columns selected through `values` already have variable labels, they are concatenated with the new labels provided through `"new_labels_col"` using `" - "` as a separator (similar to `names` where the separator is `"_"`). 
+
+* `whichv()` and operators `%==%`, `%!=%` now properly account for missing double values, e.g. `c(NA_real_, 1) %==% c(NA_real_, 1)` yields `c(1, 2)` rather than `2`. Thanks @eutwt for flagging this (#518). 
+
+* In `setv(X, v, R)`, if the type of `R` is greater than `X` e.g. `setv(1:10, 1:3, 9.5)`, then a warning is issued that conversion of `R` to the lower type (real to integer in this case) may incur loss of information. Thanks @tony-aw for suggesting (#498).
+
+* `frange()` has an option `finite = FALSE`, like `base::range`. Thanks @MLopez-Ibanez for suggesting (#511).
+
+* `varying.pdata.frame(..., any_group = FALSE)` now unindexes the result (as should be the case).
+
 # collapse 2.0.7
 
 * Fixed bug in full join if `verbose = 0`. Thanks @zander-prinsloo for reporting. 

R/pivot.R

@@ -93,6 +93,13 @@ melt_all <- function(vd, names, factor, na.rm, labels, check.dups) {
   res
 }
 
+# Retain labels in wider reshaping
+add_labels <- function(l, labs) {
+  ll <- .Call(C_vlabels, l, "label", FALSE)
+  if(!allNA(ll)) labs <- paste(ll, labs, sep = " - ")
+  .Call(C_setvlabels, l, "label", labs, NULL)
+}
+
 # TODO: Think about: values could be list input, names only atomic. that would make more sense...
 # Or: allow for both options... needs to be consistent with "labels" though...
 
@@ -287,7 +294,7 @@ pivot <- function(data,
           namv <- names(data)[values]
           attributes(data) <- NULL
           value_cols <- lapply(data[values], function(x) .Call(C_pivot_wide, g, g_v, x, fill, nthreads))
-          if(length(labels)) value_cols <- lapply(value_cols, `vlabels<-`, value = labels)
+          if(length(labels)) value_cols <- lapply(value_cols, add_labels, labels)
           value_cols <- unlist(if(transpose[1L]) t_list2(value_cols) else value_cols, FALSE, FALSE)
           namv_res <- if(transpose[2L]) t(outer(names, namv, paste, sep = "_")) else outer(namv, names, paste, sep = "_")
           names(value_cols) <- if(transpose[1L]) namv_res else t(namv_res)

R/varying.R

@@ -88,11 +88,11 @@ varying.pdata.frame <- function(x, effect = 1L, cols = NULL, any_group = TRUE, u
   index <- unclass(findex(x))
   g <- if(length(effect) == 1L) index[[effect]] else finteraction(index[effect], sort = !any_group && .op[["sort"]])
   x <- if(is.null(cols)) fcolsubset(x, attr(x, "names") %!in% names(index[effect])) else colsubset(x, cols)
-  if(!any_group && use.g.names) {
+  res <- if(!any_group && use.g.names) {
     lev <- attr(g, "levels")
-    return(setRnDF(.Call(Cpp_varyingl,x,length(lev),g,any_group,FALSE), lev))
-  }
-  .Call(Cpp_varyingl,x,fnlevels(g),g,any_group,drop)
+    setRnDF(.Call(Cpp_varyingl,x,length(lev),g,any_group,FALSE), lev)
+  } else .Call(Cpp_varyingl,x,fnlevels(g),g,any_group,drop)
+  return(if(any_group) res else unindex_light(res))
 }
 
 varying.grouped_df <- function(x, any_group = TRUE, use.g.names = FALSE, drop = TRUE, keep.group_vars = TRUE, ...) {