Merge pull request #30 from tdhock/alevels

add alevels, tests, examples, version++

Author: tdhock

.github/workflows/test-coverage.yaml

@@ -15,7 +15,7 @@ jobs:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
 
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-r@v2
         with:
@@ -44,7 +44,7 @@ jobs:
 
       - name: Upload test results
         if: failure()
-        uses: actions/upload-artifact@v3
+        uses: actions/upload-artifact@v4
         with:
           name: coverage-test-failures
           path: ${{ runner.temp }}/package

DESCRIPTION

@@ -3,7 +3,7 @@ Authors@R: c(
     person("Toby", "Hocking",
      email="toby.hocking@r-project.org",
      role=c("aut", "cre")))
-Version: 2025.1.21
+Version: 2025.3.24
 License: GPL-3
 Title: Named Capture to Data Tables
 Description: User-friendly functions for extracting a data

NAMESPACE

@@ -1,3 +1,4 @@
+export(alevels)
 export(altlist)
 export(alternatives_with_shared_groups)
 export(measure)

NEWS

@@ -1,3 +1,7 @@
+Changes in version 2025.3.24
+
+- alevels() helper creates a pattern string that matches literal alternatives, and a conversion function that outputs a factor.
+
 Changes in version 2025.1.21
 
 - capture_first_vec, capture_all_str, capture_first_df, capture_first_glob, measure, capture_melt_single, capture_melt_multiple now support type.convert argument. TRUE means to use utils::type.convert(x,as.is=TRUE) as default conversion function (as.is=TRUE means to return character instead of factor), FALSE means identity, and otherwise can be any function to use as default conversion.

R/alevels.R

@@ -0,0 +1,55 @@
+alevels <- structure(function # Alternative levels
+### Create a pattern and a conversion function based on alternative
+### string literals.
+(...
+### Optional names are string literals to match; values are
+### corresponding factor levels.
+){
+  old2new <- c(...)
+  if(is.null(names(old2new))){
+    names(old2new) <- old2new
+  }
+  to.rep <- names(old2new)==""
+  names(old2new)[to.rep] <- old2new[to.rep]
+  list(
+    paste(names(old2new), collapse="|"),
+    function(x)factor(old2new[x], old2new))
+### List of pattern and conversion function that returns factor.
+}, ex=function(){
+
+  ## Example 0: melt iris data with literal alternatives -> chr columns.
+  ichr <- nc::capture_melt_single(
+    iris[1,],
+    part="Sepal|Petal",
+    "[.]",
+    dim="Length|Width")
+  factor(ichr$part)#default factor levels are alphabetical.
+
+  ## Example 1: melt iris data with alevels() -> factor columns.
+  (ifac <- nc::capture_melt_single(
+    iris[1,],
+    part=nc::alevels("Sepal","Petal"),
+    "[.]",
+    dim=nc::alevels("Length","Width")))
+  ifac$part #factor with levels in same order as given in alevels().
+
+  ## Example 2: alevels(literals_to_match="levels_to_use_in_output").
+  tv_wide <- data.frame(
+    id=0,
+    train.classif.logloss = 1, train.classif.ce = 2, 
+    valid.classif.logloss = 3, valid.classif.ce = 4)
+  nc::capture_melt_single(
+    tv_wide, 
+    set=nc::alevels(valid="validation", train="subtrain"),
+    "[.]classif[.]",
+    measure=nc::alevels(ce="error_prop", auc="AUC", "logloss"))
+
+  ## Example 3: additional groups which output character columns.
+  nc::capture_melt_single(
+    tv_wide, 
+    set_chr=list(set_fac=nc::alevels(valid="validation", train="subtrain")),
+    "[.]classif[.]",
+    measure_chr=list(measure_fac=nc::alevels(ce="error_prop", auc="AUC", "logloss")))
+
+})
+

man/alevels.Rd

@@ -0,0 +1,55 @@
+\name{alevels}
+\alias{alevels}
+\title{Alternative levels}
+\description{Create a pattern and a conversion function based on alternative
+string literals.}
+\usage{alevels(...)}
+\arguments{
+  \item{\dots}{Optional names are string literals to match; values are
+corresponding factor levels.}
+}
+
+\value{List of pattern and conversion function that returns factor.}
+
+\author{Toby Hocking <toby.hocking@r-project.org> [aut, cre]}
+
+
+
+
+\examples{
+
+## Example 0: melt iris data with literal alternatives -> chr columns.
+ichr <- nc::capture_melt_single(
+  iris[1,],
+  part="Sepal|Petal",
+  "[.]",
+  dim="Length|Width")
+factor(ichr$part)#default factor levels are alphabetical.
+
+## Example 1: melt iris data with alevels() -> factor columns.
+(ifac <- nc::capture_melt_single(
+  iris[1,],
+  part=nc::alevels("Sepal","Petal"),
+  "[.]",
+  dim=nc::alevels("Length","Width")))
+ifac$part #factor with levels in same order as given in alevels().
+
+## Example 2: alevels(literals_to_match="levels_to_use_in_output").
+tv_wide <- data.frame(
+  id=0,
+  train.classif.logloss = 1, train.classif.ce = 2, 
+  valid.classif.logloss = 3, valid.classif.ce = 4)
+nc::capture_melt_single(
+  tv_wide, 
+  set=nc::alevels(valid="validation", train="subtrain"),
+  "[.]classif[.]",
+  measure=nc::alevels(ce="error_prop", auc="AUC", "logloss"))
+
+## Example 3: additional groups which output character columns.
+nc::capture_melt_single(
+  tv_wide, 
+  set_chr=list(set_fac=nc::alevels(valid="validation", train="subtrain")),
+  "[.]classif[.]",
+  measure_chr=list(measure_fac=nc::alevels(ce="error_prop", auc="AUC", "logloss")))
+
+}

tests/testthat/test-CRAN-alternatives.R

@@ -172,3 +172,29 @@ test_that("alternatives_with_shared_groups ok with 1 subject", {
   expect_identical(match.dt[["day"]], "17")
   expect_identical(match.dt[["year"]], "1983")
 })
+
+test_that("alevels ok with no names", {
+  ifac <- nc::capture_melt_single(
+    iris[1,],
+    part=nc::alevels("Sepal","Petal"),
+    "[.]",
+    dim=nc::alevels("Length","Width"))
+  expect_identical(levels(ifac$part), c("Sepal","Petal"))
+  expect_identical(levels(ifac$dim), c("Length","Width"))
+})
+
+test_that("alevels() ok with all and some names", {
+  tv_wide <- data.frame(
+    id=0,
+    train.classif.logloss = 1, train.classif.ce = 2,
+    valid.classif.logloss = 3, valid.classif.ce = 4)
+  tv_long <- nc::capture_melt_single(
+    tv_wide,
+    set_chr=list(set_fac=nc::alevels(valid="validation", train="subtrain")),
+    "[.]classif[.]",
+    measure_chr=list(measure_fac=nc::alevels(ce="error_prop", auc="AUC", "logloss")))
+  expect_is(tv_long$set_chr, "character")
+  expect_is(tv_long$measure_chr, "character")
+  expect_identical(levels(tv_long$set_fac), c("validation","subtrain"))
+  expect_identical(levels(tv_long$measure_fac), c("error_prop","AUC","logloss"))
+})