tests/testthat/test-graph-style-controls.R

In R4VN: Health Data Analysis and Publication-Ready Reporting

testthat::test_that("graph styling controls are public and usable", {
  expect <- list(
    gbar = c("border_color","border_lwd"),
    ghist = c("border_color","normal_color","normal_lty","normal_lwd"),
    gbox = c("border_color","point_color","point_alpha","point_size","point_pch"),
    gscatter = c("fit_color","fit_lty","fit_lwd"),
    gline = c("line_width","line_type"),
    gdensity = c("line_width","line_type"),
    gpie = c("border_color","border_lwd"),
    groc = c("curve_lty","curve_lwd","diagonal_color","diagonal_lty","diagonal_lwd"),
    gsurv = c("ci_color","ci_alpha","ci_linetype","ci_line_width","censor_color","censor_pch","censor_size","median_color","median_lty","median_lwd","ref_color","ref_lty","ref_lwd"),
    marginsplot = c("line_width","line_type","point_size","point_pch","ci_color","ci_alpha","ci_lwd","ci_lty")
  )
  for (nm in names(expect)) {
    testthat::expect_true(all(expect[[nm]] %in% names(formals(get(nm, envir=asNamespace("R4VN"))))), info=nm)
  }
})

testthat::test_that("line and scatter styling can be drawn", {
  d <- data.frame(
    x = rep(1:5,2),
    y = c(1,2,2.8,4.1,5.2,1.3,1.9,3.2,3.8,4.7),
    g = rep(c("A","B"),each=5)
  )
  f <- tempfile(fileext=".png")
  testthat::expect_silent(
    gline(d,x=x,y=y,by=g,line_type=2,line_width=3,file=f,show=FALSE)
  )
  testthat::expect_true(file.exists(f)); unlink(f)

  f <- tempfile(fileext=".png")
  testthat::expect_silent(
    gscatter(d,x=x,y=y,by=g,fit="linear",fit_color="red",fit_lty=3,fit_lwd=3,file=f,show=FALSE)
  )
  testthat::expect_true(file.exists(f)); unlink(f)
})

testthat::test_that("ROC axes remain exactly within probability limits", {
  d <- data.frame(y=rep(c(0,1),each=20),p=c(seq(.05,.55,length.out=20),seq(.45,.95,length.out=20)))
  f <- tempfile(fileext=".png")
  grDevices::png(f,width=700,height=700)
  groc(d,outcome=y,pred=p,event=1,show=TRUE,curve_lty=2,curve_lwd=3)
  u <- graphics::par("usr")
  grDevices::dev.off(); unlink(f)
  testthat::expect_equal(u,c(0,1,0,1),tolerance=1e-12)
})