tests/test-influence_of_iknots.R

In dewittpe/cpr: Control Polygon Reduction

library(cpr)
set.seed(42)

################################################################################
e <- new.env()
with(e, {
  x <- runif(n = 100, 0, 6)#seq(0 + 1/5000, 6 - 1/5000, length.out = 100)
  bmat <- bsplines(x, iknots = c(1, 1.5, 2.3, 4, 4.5), bknots = c(0, 6))
  theta <- matrix(c(1, 0, 3.5, 4.2, 3.7, -0.5, -0.7, 2, 1.5), ncol = 1)
  DF <- data.frame(x = x, truth = as.numeric(bmat %*% theta))
  DF$y <- as.numeric(bmat %*% theta + rnorm(nrow(bmat), sd = 0.3))

  initial_cp <-
    cp(y ~ bsplines(x, iknots = c(1, 1.5, 2.3, 3.0, 4, 4.5), bknots = c(0, 6)), data = DF)

  iok <- influence_of_iknots(initial_cp)

  stopifnot(inherits(iok, "cpr_influence_of_iknots"))

  # if the following test for the names of the object changes make sure to
  # update the @return section of the source file.
  stopifnot(identical(names(iok), c("original_cp", "coarsened_cps", "restored_cps", "d", "influence", "chisq")))

  s <- summary(iok)

  stopifnot(identical(dim(s), c(6L, 8L)))
  stopifnot(identical(names(s), c("j", "iknot", "influence", "influence_rank", "chisq", "chisq_rank", "p_value", "os_p_value")))
})

################################################################################
# verbose vs non-versbose
e <- new.env()
with(e, {
  x <- runif(n = 100, 0, 6)
  bmat <- bsplines(x, iknots = c(1, 1.5, 2.3, 4, 4.5), bknots = c(0, 6))
  theta <- matrix(c(1, 0, 3.5, 4.2, 3.7, -0.5, -0.7, 2, 1.5), ncol = 1)
  DF <- data.frame(x = x, truth = as.numeric(bmat %*% theta))
  DF$y <- as.numeric(bmat %*% theta + rnorm(nrow(bmat), sd = 0.3))

  initial_cp <-
    cp(y ~ bsplines(x, iknots = c(1, 1.5, 2.3, 3.0, 4, 4.5), bknots = c(0, 6)), data = DF)

  iok0 <- influence_of_iknots(initial_cp, verbose = FALSE, cl = 0)
  iok1 <- influence_of_iknots(initial_cp, verbose = FALSE, cl = 1)
  iok2 <- influence_of_iknots(initial_cp, verbose = FALSE, cl = 2)
  iok0v <- influence_of_iknots(initial_cp, verbose = TRUE, cl = 0)
  iok1v <- influence_of_iknots(initial_cp, verbose = TRUE, cl = 1)
  iok2v <- influence_of_iknots(initial_cp, verbose = TRUE, cl = 2)

  stopifnot(isTRUE(all.equal(iok0, iok1)))
  stopifnot(isTRUE(all.equal(iok0, iok2)))
  stopifnot(isTRUE(all.equal(iok0, iok0v)))
  stopifnot(isTRUE(all.equal(iok0, iok1v)))
  stopifnot(isTRUE(all.equal(iok0, iok2v)))

})

################################################################################
# CPR
# verbose vs non-versbose
e <- new.env()
with(e, {
  x <- runif(n = 100, 0, 6)
  bmat <- bsplines(x, iknots = c(1, 1.5, 2.3, 4, 4.5), bknots = c(0, 6))
  theta <- matrix(c(1, 0, 3.5, 4.2, 3.7, -0.5, -0.7, 2, 1.5), ncol = 1)
  DF <- data.frame(x = x, truth = as.numeric(bmat %*% theta))
  DF$y <- as.numeric(bmat %*% theta + rnorm(nrow(bmat), sd = 0.3))

  initial_cp <-
    cp(y ~ bsplines(x, iknots = c(1, 1.5, 2.3, 3.0, 4, 4.5), bknots = c(0, 6)), data = DF)
  cpr_run <- cpr(initial_cp)

  ioik_cpr <- influence_of_iknots(cpr_run)

  ioik_list <- lapply(cpr_run, influence_of_iknots)

  stopifnot(identical(ioik_cpr, ioik_cpr))

  stopifnot(
    identical(
      attr(cpr_run, "ioik")
      ,
      lapply(ioik_list, summary)
    )
  )

  stopifnot(
    all.equal(
      do.call(rbind, attr(cpr_run, "ioik"))
      ,
      summary(ioik_cpr)[, 1:8]
      ,
      check.attributes = FALSE
    )
  )

  stopifnot(
    identical(
      summary(ioik_cpr)[, "index"]
      ,
      c(1, 2, 3, 3, 4, 4, 4, 5, 5, 5, 5, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7)
    )
  )

})

################################################################################
e <- new.env()
with(e, {

#  acn <- cn(pdg ~ btensor(list(day, age)
#                          , df = list(10, 8)
#                          , bknots = list(c(-1, 1), c(44, 53))
#                          ) + ttm
#            , data = spdg)
#
#  str(acn, max.level = 1)
#
#  influence_of_iknots(acn)
#
#  acnr <- cnr(acn)
#  stop("TEST NEEDS TO BE WRITTEN")



})


################################################################################
#                                 End of File                                  #
################################################################################