tests_preview_facet.png

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: atime
 Type: Package
 Title: Asymptotic Timing
-Version: 2024.9.23
+Version: 2024.9.25
 Authors@R: c(
  person("Toby", "Hocking",
  email="[email protected]",

NEWS

@@ -1,3 +1,7 @@
+Changes in version 2024.9.25
+
+- atime_pkg creates tests_preview_facet.png if N.tests.preview (default 4, can be defined in atime/tests.R) is less than the number of test cases. It should be informative even when zoomed out, since it shows only the test cases which had smallest p-values (most significant differences between HEAD and min). Recommended for display as thumbnail/preview image with links to the larger tests_preview_all.png that includes all test results (which may not be readable/informative unless you zoom/scroll, if there are 10+ tests).
+
 Changes in version 2024.9.23
 
 - atime_pkg_test_info returns un-evaluated calls to atime_versions, to make it easier to run one test at a time.

R/test.R

@@ -22,10 +22,10 @@ atime_pkg <- function(pkg.path=".", tests.dir=NULL){
  limit.dt.list <- list()
  compare.dt.list <- list()
  test.info <- atime_pkg_test_info(pkg.path, tests.dir)
- for(test.name in names(test.info$test.list)){
- atv.call <- test.info$test.call[[test.name]]
+ for(Test in names(test.info$test.list)){
+ atv.call <- test.info$test.call[[Test]]
  atime.list <- eval(atv.call, test.info)
- pkg.results[[test.name]] <- atime.list
+ pkg.results[[Test]] <- atime.list
  best.list <- atime::references_best(atime.list)
  ref.dt <- best.list$ref[each.sign.rank==1]
  sec.dt <- best.list$meas[unit=="seconds"]
@@ -42,8 +42,8 @@ atime_pkg <- function(pkg.path=".", tests.dir=NULL){
  expr.name %in% HEAD.compare, .(
  seconds=as.numeric(time[[1]])
  ), by=.(N, unit, expr.name)][, log10.seconds := log10(seconds)][]
- compare.dt.list[[test.name]] <- data.table(
- test.name, largest.common.timings)
+ compare.dt.list[[Test]] <- data.table(
+ Test, largest.common.timings)
  test.args <- list()
  for(commit.i in seq_along(HEAD.compare)){
  commit.name <- HEAD.compare[[commit.i]]
@@ -53,17 +53,17 @@ atime_pkg <- function(pkg.path=".", tests.dir=NULL){
  test.args$alternative <- "greater"
  p.value <- do.call(stats::t.test, test.args)$p.value
  hline.df <- with(atime.list, data.frame(seconds.limit, unit="seconds"))
- limit.dt.list[[test.name]] <- data.table(test.name, hline.df)
- bench.dt.list[[test.name]] <- data.table(
- test.name, p.value, best.list$meas)
+ limit.dt.list[[Test]] <- data.table(Test, hline.df)
+ bench.dt.list[[Test]] <- data.table(
+ Test, p.value, best.list$meas)
  log10.range <- range(log10(atime.list$meas$N))
  expand <- diff(log10.range)*test.info$expand.prop
  xmax <- 10^(log10.range[2]+expand)
- one.blank <- data.table(test.name, best.list$meas[1])
+ one.blank <- data.table(Test, best.list$meas[1])
  one.blank[, N := xmax]
- blank.dt.list[[test.name]] <- one.blank
+ blank.dt.list[[Test]] <- one.blank
  gg <- ggplot2::ggplot()+
- ggplot2::ggtitle(test.name)+
+ ggplot2::ggtitle(Test)+
  ggplot2::theme_bw()+
  ggplot2::facet_grid(unit ~ expr.name, scales="free")+
  ggplot2::geom_hline(ggplot2::aes(
@@ -98,72 +98,87 @@ atime_pkg <- function(pkg.path=".", tests.dir=NULL){
  ggplot2::coord_cartesian(xlim=c(NA,xmax))
  out.png <- file.path(
  dirname(test.info$tests.R), 
- paste0(gsub("[: /]", "_", test.name), ".png"))
+ paste0(gsub("[: /]", "_", Test), ".png"))
  grDevices::png(out.png, width=test.info$width.in*nrow(max.dt), height=test.info$height.in, units="in", res=100)
  print(gg)
  grDevices::dev.off()
  }
- bench.dt <- rbindlist(bench.dt.list)[, Test := test.name]
+ bench.dt <- rbindlist(bench.dt.list)
  setkey(bench.dt, p.value)
  bench.dt[, p.str := sprintf("%.2e", p.value)]
  bench.dt[, P.value := factor(p.str, unique(p.str))]
- meta.dt <- unique(bench.dt[, .(Test, test.name, P.value)])
- limit.dt <- rbindlist(limit.dt.list)[meta.dt, on="test.name"]
- blank.dt <- rbindlist(blank.dt.list)[meta.dt, on="test.name"]
- compare.dt <- rbindlist(compare.dt.list)[meta.dt, on="test.name"]
+ meta.dt <- unique(bench.dt[, .(Test, P.value)])
  tests.RData <- sub("R$", "RData", test.info$tests.R)
  install.seconds <- sapply(pkg.results, "[[", "install.seconds")
  cat(
  sum(install.seconds),
  file=file.path(dirname(tests.RData), "install_seconds.txt"))
- save(
- pkg.results, bench.dt, limit.dt, test.info, blank.dt, 
- file=tests.RData)
+ ## create all and preview facet PNGs.
  N.tests <- length(test.info$test.list)
- gg <- ggplot2::ggplot()+
- ggplot2::ggtitle(paste(
- N.tests,
- "test cases, ordered by p-value (T-test, HEAD>min, dots show data tested)"))+
- ggplot2::theme_bw()+
- ggplot2::geom_hline(ggplot2::aes(
- yintercept=seconds.limit),
- color="grey",
- data=limit.dt)+
- ggplot2::scale_color_manual(values=test.info$version.colors)+
- ggplot2::scale_fill_manual(values=test.info$version.colors)+
- ggplot2::facet_grid(
- unit ~ P.value + Test, scales="free", labeller="label_both")+
- ggplot2::geom_line(ggplot2::aes(
- N, empirical, color=expr.name),
- data=bench.dt)+
- ggplot2::geom_blank(ggplot2::aes(
- N, empirical),
- data=blank.dt)+
- ggplot2::geom_ribbon(ggplot2::aes(
- N, ymin=q25, ymax=q75, fill=expr.name),
- data=bench.dt[unit=="seconds"],
- alpha=0.5)+
- ggplot2::geom_point(ggplot2::aes(
- N, seconds, color=expr.name),
- shape=1,
- data=compare.dt)+
- ggplot2::scale_x_log10()+
- ggplot2::scale_y_log10("median line, quartiles band")+
- directlabels::geom_dl(ggplot2::aes(
- N, empirical, color=expr.name, label=expr.name),
- method="right.polygons",
- data=bench.dt)+
- ggplot2::theme(legend.position="none")
- out.png <- file.path(
- dirname(test.info$tests.R), "tests_all_facet.png")
- grDevices::png(
- out.png,
- width=test.info$width.in*N.tests,
- height=test.info$height.in,
- units="in",
- res=100)
- print(gg)
- grDevices::dev.off()
+ out_N_list <- list(all=N.tests)
+ if(test.info$N.tests.preview < N.tests){
+ out_N_list$preview <- test.info$N.tests.preview
+ }
+ for(N_name in names(out_N_list)){
+ N_int <- out_N_list[[N_name]]
+ N_meta <- meta.dt[1:N_int]
+ limit.dt <- rbindlist(limit.dt.list)[N_meta, on="Test"]
+ blank.dt <- rbindlist(blank.dt.list)[N_meta, on="Test"]
+ compare.dt <- rbindlist(compare.dt.list)[N_meta, on="Test"]
+ N_bench <- bench.dt[N_meta, on="Test"]
+ ## Plot only compare.dt
+ ##ggplot()+geom_point(aes(seconds, expr.name), shape=1, data=compare.dt)+facet_grid(. ~ P.value + Test, labeller=label_both, scales="free")+scale_x_log10()
+ gg <- ggplot2::ggplot()+
+ ggplot2::ggtitle(sprintf(
+ "%d test cases (%s), ordered by p-value (T-test, HEAD>min, dots show data tested)",
+ N_int, N_name))+
+ ggplot2::theme_bw()+
+ ggplot2::geom_hline(ggplot2::aes(
+ yintercept=seconds.limit),
+ color="grey",
+ data=limit.dt)+
+ ggplot2::scale_color_manual(values=test.info$version.colors)+
+ ggplot2::scale_fill_manual(values=test.info$version.colors)+
+ ggplot2::facet_grid(
+ unit ~ P.value + Test, scales="free", labeller="label_both")+
+ ggplot2::geom_line(ggplot2::aes(
+ N, empirical, color=expr.name),
+ data=N_bench)+
+ ggplot2::geom_blank(ggplot2::aes(
+ N, empirical),
+ data=blank.dt)+
+ ggplot2::geom_ribbon(ggplot2::aes(
+ N, ymin=q25, ymax=q75, fill=expr.name),
+ data=N_bench[unit=="seconds"],
+ alpha=0.5)+
+ ggplot2::geom_point(ggplot2::aes(
+ N, seconds, color=expr.name),
+ shape=1,
+ data=compare.dt)+
+ ggplot2::scale_x_log10()+
+ ggplot2::scale_y_log10("median line, quartiles band")+
+ directlabels::geom_dl(ggplot2::aes(
+ N, empirical, color=expr.name, label=expr.name),
+ method="right.polygons",
+ data=N_bench)+
+ ggplot2::theme(legend.position="none")
+ out.png <- file.path(
+ dirname(test.info$tests.R),
+ sprintf("tests_%s_facet.png", N_name))
+ grDevices::png(
+ out.png,
+ width=test.info$width.in*N.tests,
+ height=test.info$height.in,
+ units="in",
+ res=100)
+ print(gg)
+ grDevices::dev.off()
+ if(N_name=="all"){
+ save(
+ pkg.results, bench.dt, limit.dt, test.info, blank.dt, 
+ file=tests.RData)
+ }
+ }
  pkg.results
 }
 
@@ -186,6 +201,7 @@ atime_pkg_test_info <- function(pkg.path=".", tests.dir=NULL){
  tests.parsed <- parse(test.env$tests.R)
  eval(tests.parsed, test.env)
  default.list <- list(
+ N.tests.preview=4,
  width.in=4,
  height.in=8,
  expand.prop=0.5,
@@ -242,10 +258,10 @@ atime_pkg_test_info <- function(pkg.path=".", tests.dir=NULL){
  sha.vec=sha.vec)
  test.env$test.list <- inherit_args(test.env$test.list, pkg.sha.args)
  test.env$test.call <- list()
- for(test.name in names(test.env$test.list)){
- test.env$test.call[[test.name]] <- as.call(c(
+ for(Test in names(test.env$test.list)){
+ test.env$test.call[[Test]] <- as.call(c(
  quote(atime::atime_versions),
- test.env$test.list[[test.name]]))
+ test.env$test.list[[Test]]))
  }
  test.env
 }
@@ -271,11 +287,11 @@ inherit_args <- function(L, common.args){
  out <- list()
  for(L.i in seq_along(L)){
  test.args <- L[[L.i]]
- test.name <- names(L)[[L.i]]
+ Test <- names(L)[[L.i]]
  if(!is.null(test.args)){
  out.args <- common.args
  out.args[names(test.args)] <- test.args
- out[[test.name]] <- out.args
+ out[[Test]] <- out.args
  }
  }
  out

man/atime_pkg.Rd

@@ -55,8 +55,10 @@ atime_pkg_test_info(pkg.path=".", tests.dir=NULL)
  come from results of \code{atime_versions}. Side effect is that
  data/plot files are saved in \code{atime} directory, including
  tests.RData (test results which can be read into R if you want to make
- your own alternative plots/analyses), and tests_all_facet.png (plot
- summarizing all test results).
+ your own alternative plots/analyses), tests_all_facet.png (plot
+ summarizing all test results), tests_preview_facet.png (plot
+ summarizing only most significant results), and install_seconds.txt
+ (total number of seconds used to install different package versions).
  }
 
 \author{Toby Dylan Hocking}

tests/testthat/test-versions.R

@@ -29,21 +29,7 @@ test_that("atime_versions_exprs error when expr does not contain pkg:", {
  }, "expr should contain at least one instance of binsegRcpp:: to replace with binsegRcpp.be2f72e6f5c90622fe72e1c315ca05769a9dc854:", fixed=TRUE)
 })
 
-test_that("atime_pkg produces tests_all_facet.png", {
- repo <- git2r::repository(tdir)
- ## https://github.com/tdhock/binsegRcpp/tree/another-branch
- git2r::checkout(repo, branch="another-branch")
- inst.atime <- file.path(tdir, "inst", "atime")
- options(repos="http://cloud.r-project.org")#required to check CRAN version.
- result.list <- atime::atime_pkg(tdir)
- tests_all_facet.png <- file.path(inst.atime, "tests_all_facet.png")
- expect_true(file.exists(tests_all_facet.png))
- install_seconds.txt <- file.path(inst.atime, "install_seconds.txt")
- install.seconds <- scan(install_seconds.txt, n=1, quiet=TRUE)
- expect_is(install.seconds, "numeric")
-})
-
-test_that("atime_pkg produces RData with expected names", {
+test_that("atime_pkg produces tests_all_facet.png not tests_preview_facet.png", {
  repo <- git2r::repository(tdir)
  ## https://github.com/tdhock/binsegRcpp/tree/atime-test-funs
  git2r::checkout(repo, branch="atime-test-funs")
@@ -66,6 +52,29 @@ test_that("atime_pkg produces RData with expected names", {
  bench.seconds <- sapply(result.list, "[[", "bench.seconds")
  expect_is(bench.seconds, "numeric")
  expect_identical(names(bench.seconds), expected.names)
+ ## also test global PNG.
+ tests_all_facet.png <- file.path(atime.dir, "tests_all_facet.png")
+ expect_true(file.exists(tests_all_facet.png))
+ ##N.tests.preview undefined, default 4 == N.tests=4 so should not make PNG.
+ tests_preview_facet.png <- file.path(atime.dir, "tests_preview_facet.png")
+ expect_false(file.exists(tests_preview_facet.png))
+})
+
+test_that("atime_pkg produces tests_all_facet.png and tests_preview_facet.png", {
+ repo <- git2r::repository(tdir)
+ ## https://github.com/tdhock/binsegRcpp/tree/another-branch
+ git2r::checkout(repo, branch="another-branch")
+ inst.atime <- file.path(tdir, "inst", "atime")
+ options(repos="http://cloud.r-project.org")#required to check CRAN version.
+ result.list <- atime::atime_pkg(tdir)
+ tests_all_facet.png <- file.path(inst.atime, "tests_all_facet.png")
+ expect_true(file.exists(tests_all_facet.png))
+ ##N.tests.preview=2 < N.tests=4 so should make one more PNG with those two.
+ tests_preview_facet.png <- file.path(inst.atime, "tests_preview_facet.png")
+ expect_true(file.exists(tests_preview_facet.png))
+ install_seconds.txt <- file.path(inst.atime, "install_seconds.txt")
+ install.seconds <- scan(install_seconds.txt, n=1, quiet=TRUE)
+ expect_is(install.seconds, "numeric")
 })
 
 test_that("pkg.edit.fun is a function", {