Merge pull request #47 from tdhock/auto-more-units

save more units

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: atime
 Type: Package
 Title: Asymptotic Timing
-Version: 2024.4.12
+Version: 2024.4.16
 Authors@R: c(
     person("Toby", "Hocking",
      email="toby.hocking@r-project.org",

NEWS

@@ -1,3 +1,7 @@
+Changes in version 2024.4.16
+
+- If result is data frame with 1 row, save more.units.
+
 Changes in version 2024.4.12
 
 - atime_pkg gains tests.dir arg, thanks @MichaelChirico for the suggestion.

R/atime.R

@@ -103,6 +103,7 @@ atime <- function(N, setup, expr.list=NULL, times=10, seconds.limit=0.01, verbos
   elist <- c(expr.list, dots.list)
   name.tab <- table(names(elist))
   bad.names <- names(name.tab)[name.tab>1]
+  more.units <- character()
   if(length(bad.names))stop(
     "each expression must have a unique name, problems: ", 
     paste(bad.names, collapse=", "))
@@ -128,10 +129,20 @@ atime <- function(N, setup, expr.list=NULL, times=10, seconds.limit=0.01, verbos
       }
       m.call <- as.call(m.list)
       N.df <- eval(m.call, N.env)
+      if(
+        all(sapply(N.env$result.list, is.data.frame)) &&
+          all(sapply(N.env$result.list, nrow)==1)
+      ){
+        unit.df <- do.call(rbind, N.env$result.list)
+        is.more <- sapply(unit.df, is.numeric)
+        more.units <- names(unit.df)[is.more]
+      }else{
+        unit.df <- NULL
+      }
       if(result){
         N.df$result <- N.env$result.list
       }
-      N.stats <- data.table(N=N.value, expr.name=not.done.yet, N.df)
+      N.stats <- data.table(N=N.value, expr.name=not.done.yet, N.df, unit.df)
       N.stats[, `:=`(
         kilobytes=as.numeric(mem_alloc)/1024,
         memory=NULL,
@@ -162,6 +173,7 @@ atime <- function(N, setup, expr.list=NULL, times=10, seconds.limit=0.01, verbos
   }
   structure(
     list(
+      more.units=more.units,
       seconds.limit=seconds.limit,
       measurements=measurements),
     class="atime")

R/references.R

@@ -18,10 +18,13 @@ references <- function
     log10.vec <- fun(N)
     last.empirical <- empirical[which.max(N)]
     one.fun <- data.table(
-      N, empirical,
+      N,
+      empirical=as.numeric(empirical),
       reference=10^(log10.vec-max(log10.vec)+log10(last.empirical))
     )
-    above <- one.fun[lower.limit < reference]
+    ## When plotting the reference, we do not want to see anything too
+    ## far below the data (lower.limit).
+    above <- one.fun[lower.limit <= reference]
     last.two <- one.fun[(.N-1):.N]
     if(1 < nrow(above) || length(unique(one.fun$reference))==1){
       above
@@ -30,14 +33,15 @@ references <- function
       lower.emp <- last.two[, stats::approx(N, empirical, lower.N)$y]
       rbind(data.table(
         N=as.integer(lower.N), 
+
         empirical=lower.emp, 
         reference=lower.limit), 
         above)
     }
   }, by=.(fun.latex, fun.name=gsub("\\", "", fun.latex, fixed=TRUE))]
 }
 
-references_best <- function(L, unit.col.vec=NULL, more.units=NULL, fun.list=NULL){
+references_best <- function(L, unit.col.vec=NULL, more.units=L$more.units, fun.list=NULL){
   N <- expr.name <- . <- fun.name <- dist <- empirical <- reference <-
     fun.latex <- overall.rank <- NULL
   ## Above for R CMD check.

man/atime.Rd

@@ -14,14 +14,18 @@ result=FALSE, ...)}
   \item{seconds.limit}{if the median timing of any expression exceeds
     this many seconds, then no timings for larger N are computed.}
   \item{verbose}{logical, print messages after every data size?}
-  \item{result}{logical, save each result?}
+  \item{result}{logical, save each result? If \code{TRUE}, and result is
+  a data frame with one row, then the numeric column names will be
+  saved, for use as the default \code{more.units} argument to
+  \code{\link{references_best}}.}
   \item{\dots}{named expressions to time.}
 }
 \details{Each iteration involves first computing the setup expression,
   and then computing several times the \dots expressions. For
   convenience, expressions may be specified either via code (\dots) or
   data (\code{expr.list} arg).}
-\value{list of class atime with elements \code{seconds.limit} (numeric
+\value{list of class atime with elements \code{more.units} (character
+  vector of unit column names), \code{seconds.limit} (numeric
   input param), \code{measurements} (data table of results).}
 
 \author{Toby Dylan Hocking}

man/references_best.Rd

@@ -2,13 +2,20 @@
 \alias{references_best}
 \title{Best references}
 \description{Compute best asymptotic references.}
-\usage{references_best(L, unit.col.vec=NULL, more.units=NULL, fun.list=NULL)}
+\usage{
+references_best(
+  L,
+  unit.col.vec=NULL,
+  more.units=L$more.units,
+  fun.list=NULL
+)
+}
 \arguments{
   \item{L}{List output from atime.}
   \item{unit.col.vec}{Named character vector of units, default NULL
     means standard units (kilobytes and seconds).}
   \item{more.units}{Named character vector of units to add to
-    \code{unit.col.vec}, default NULL means nothing.}
+    \code{unit.col.vec}, default is to take from \code{L}.}
   \item{fun.list}{List of asymptotic complexity reference functions,
     default NULL means to use package default.}
 }

tests/testthat/test-CRAN.R

@@ -52,11 +52,12 @@ atime.list <- atime::atime(
   },
   result=TRUE,
   N=1:30)
+match_len <- function(L){
+  at <- attr(L,"match.length")
+  if(is.numeric(at))at else NA_integer_
+}
 atime.list$measurements[, `:=`(
-  length.num=sapply(result, function(L){
-    at <- attr(L,"match.length")
-    if(is.numeric(at))at else NA_real_
-  }))]
+  length.num=sapply(result, match_len))]
 test_that("more.units error if not present", {
   expect_error({
     atime::references_best(atime.list, more.units="foo")
@@ -103,6 +104,26 @@ test_that("predict gives both seconds and length", {
   expect_identical(names(unit.tab), c("length.num","seconds"))
 })
 
+test_that("automatic more.units match.len", {
+  expr.list <- atime::atime_grid(
+    list(perl=c(TRUE,FALSE)),
+    regexpr=data.table(
+      num=1,
+      int=2L,
+      match.len=match_len(regexpr(pattern, subject, perl=perl))))
+  atime.list <- atime::atime(
+    expr.list=expr.list,
+    setup={
+      subject <- paste(rep("a", N), collapse="")
+      pattern <- paste(rep(c("a?", "a"), each=N), collapse="")
+    },
+    result=TRUE,
+    N=1:30)
+  ref.list <- atime::references_best(atime.list)
+  disp.units <- sort(unique(ref.list$measurements$unit))
+  expect_identical(disp.units, c("int","kilobytes","match.len","num","seconds"))
+})
+
 test_that("result returned when some are NULL and others not", {
   atime.list <- atime::atime(
     N=10^seq(-3, 0),