[R-pkg-devel] Errors in R package - Updated
Duncan Murdoch
murdoch@dunc@n @ending from gm@il@com
Sat May 26 02:31:22 CEST 2018
On 25/05/2018 3:25 PM, Steven Spiriti wrote:
> To Whom It May Concern:
>
> I have created a package called "freeknotsplines" in R, and I need to
> make a few updates to it. I resubmitted the package, and received the
> following error message:
The problem is that you are mixing up S3 and S4 stuff. You have an S4
class "freekt", but you are defining functions like coef.freekt and
expecting them to act as methods for that class. That's not how to
define methods in S4. You use the methods::setMethod() function to do
that. Using the naming convention generic.class() is the way to do it
in S3.
Since your S4 class has no "coef" methods, you'll get the old S3 generic
handling your coef(xy.freekt) call, and it doesn't know what to do with
it. It will pass the object to stats:::coef.default, which tries to
extract the coefficients using object$coefficients, and that fails when
object is xy.freekt.
Duncan Murdoch
>
> checking examples ... ERROR
> Running examples in ‘freeknotsplines-Ex.R’ failed
> The error most likely occurred in:
>
>> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
>> ### Name: coef.freekt
>> ### Title: Compute Coefficients of B-Splines For Free-Knot Splines
>> ### Aliases: coef.freekt
>> ### Keywords: nonparametric regression smooth
>>
>> ### ** Examples
>>
>> x <- 0:30/30
>> truey <- x*sin(10*x)
>> set.seed(10556)
>> y <- truey + rnorm(31, 0, 0.2)
>> xy.freekt <- freelsgen(x, y, degree = 2, numknot = 2, 555)
>> coef(xy.freekt)
> Error: $ operator not defined for this S4 class
> Execution halted
>
> This error occurs in one of the examples in the documentation. It is
> platform dependent, and does not occur on the machine I am using to create
> the package. freekt is a new class, which is apparently an S4 class.
>
> Here is the R code for my package:
>
> #' @export coef freekt
> #' @export fitted freekt
> #' @export residuals freekt
> #' @export plot freekt
> #' @export summary freekt
> #' @export AIC freekt
> #' @export AICc freekt
> #' @export BIC freekt
> #' @export adjGCV freekt
> #' @export adjAIC freekt
>
> library(splines)
>
> setClass("freekt", slots = c(x = "numeric", y = "numeric", degree =
> "integer",
> seed = "integer", stream = "integer", lambda = "numeric",
> optknot = "numeric", tracehat = "numeric", GCV = "numeric",
> GSJS = "numeric", call = "call"))
>
> freelsgen <- function(x, y, degree, numknot, seed = 5, stream = 0)
> {
> n <- length(x)
> ord <- degree + 1
> optknot <- rep(0, times = numknot)
> tracehat <- 0
> GCV <- 0
> GSJS <- 0
> result <- .C("freelsgen", as.integer(n), as.double(x), as.double(y),
> as.integer(ord), as.integer(numknot), as.integer(seed),
> as.integer(stream), as.double(optknot),
> as.double(tracehat), as.double(GCV), as.double(GSJS))
> answer <- new("freekt", x = x, y = y, degree = as.integer(degree),
> seed = as.integer(seed), stream = as.integer(stream),
> lambda = 0, optknot = result[[8]],
> tracehat = result[[9]], GCV = result[[10]],
> GSJS = result[[11]], call = match.call())
> return(answer)
> }
>
> freelsgold <- function(x, y, degree, numknot, seed = 5, stream = 0)
> {
> n <- length(x)
> ord <- degree + 1
> optknot <- rep(0, times = numknot)
> tracehat <- 0
> GCV <- 0
> GSJS <- 0
> result <- .C("freelsgold", as.integer(n), as.double(x), as.double(y),
> as.integer(ord), as.integer(numknot), as.integer(seed),
> as.integer(stream), as.double(optknot),
> as.double(tracehat), as.double(GCV), as.double(GSJS))
> answer <- new("freekt", x = x, y = y, degree = as.integer(degree),
> seed = as.integer(seed), stream = as.integer(stream),
> lambda = 0, optknot = result[[8]],
> tracehat = result[[9]], GCV = result[[10]],
> GSJS = result[[11]], call = match.call())
> return(answer)
> }
>
> freepsgen <- function(x, y, degree, numknot, seed = 5, stream = 0)
> {
> n <- length(x)
> ord <- degree + 1
> optknot <- rep(0, times = numknot)
> lambda <- 0
> tracehat <- 0
> GCV <- 0
> GSJS <- 0
> result <- .C("freepsgen", as.integer(n), as.double(x), as.double(y),
> as.integer(ord), as.integer(numknot), as.integer(seed),
> as.integer(stream), as.double(lambda),
> as.double(optknot), as.double(tracehat),
> as.double(GCV), as.double(GSJS))
> answer <- new("freekt", x = x, y = y, degree = as.integer(degree),
> seed = as.integer(seed), stream = as.integer(stream),
> lambda = result[[8]], optknot = result[[9]],
> tracehat = result[[10]], GCV = result[[11]],
> GSJS = result[[12]], call = match.call())
> return(answer)
> }
>
> freepsgold <- function(x, y, degree, numknot, seed = 5, stream = 0)
> {
> n <- length(x)
> ord <- degree + 1
> optknot <- rep(0, times = numknot)
> lambda <- 0
> tracehat <- 0
> GCV <- 0
> GSJS <- 0
> result <- .C("freepsgold", as.integer(n), as.double(x), as.double(y),
> as.integer(ord), as.integer(numknot), as.integer(seed),
> as.integer(stream), as.double(lambda),
> as.double(optknot), as.double(tracehat),
> as.double(GCV), as.double(GSJS))
> answer <- new("freekt", x = x, y = y, degree = as.integer(degree),
> seed = as.integer(seed), stream = as.integer(stream),
> lambda = result[[8]], optknot = result[[9]],
> tracehat = result[[10]], GCV = result[[11]],
> GSJS = result[[12]], call = match.call())
> return(answer)
> }
>
> chgbasismat <- function(knot, ord)
> {
> dimmat <- length(knot) - ord
> answer <- matrix(0, nrow = dimmat, ncol = dimmat)
> for (j in 0:(ord-1))
> {
> brow <- splineDesign(knot, knot[1], ord, j)
> brow <- as.vector(brow/factorial(j))
> answer[j + 1, ] <- brow
> }
> nknot <- sort(-1*knot)
> for (j in 1:(dimmat - ord))
> {
> brow <- splineDesign(knot, knot[ord + j], ord, ord - 1)
> brow2 <- splineDesign(nknot, nknot[length(knot) - ord - (j - 1)],
> ord, ord - 1)
> brow2 <- brow2[dimmat:1]
> brow <- brow + (-1)^ord * brow2
> brow <- as.vector(brow/factorial(ord - 1))
> answer[ord + j, ] <- brow
> }
> return(answer)
> }
>
> coef.freekt <- function(object, ...)
> {
> xdat <- object using x
> ydat <- object using y
> optknot <- object using optknot
> ord <- object using degree + 1
> lambda <- object using lambda
> fulloptknot <- c(rep(min(xdat), ord), optknot, rep(max(xdat), ord)) #
> includes endpoints
> Xmat <- splineDesign(fulloptknot, xdat, ord)
> if ((lambda == 0) | (length(optknot) == 0))
> coef <- solve(t(Xmat)%*%Xmat, t(Xmat)%*%ydat)
> else
> {
> numknots <- length(optknot)
> Amat <- chgbasismat(fulloptknot, ord)
> Istar <- diag(c(rep(0, times = ord), rep(1, times = numknots)))
> coef <- solve(t(Xmat)%*%Xmat + lambda*t(Amat)%*%Istar%*%Amat,
> t(Xmat)%*%ydat)
> }
> return(coef)
> }
>
> fitted.freekt <- function(object, xfit = object using x, ...)
> {
> xdat <- object using x
> ydat <- object using y
> optknot <- object using optknot
> ord <- object using degree + 1
> fulloptknot <- c(rep(min(xdat), ord), optknot, rep(max(xdat), ord)) #
> includes endpoints
> coef <- coef.freekt(object)
> yfit <- splineDesign(fulloptknot, xfit, ord) %*%coef
> return(yfit)
> }
>
> residuals.freekt <- function(object, ...)
> {
> fit <- fitted.freekt(object)
> return(object using y - fit)
> }
>
> plot.freekt <- function(x, xfit = x using x, linecolor="blue", lwd = 1, lty = 1,
> ...)
> {
> xfit <- as.vector(xfit)
> yfit <- fitted.freekt(x, xfit)
> plot(x using x, x using y, ...)
> lines(xfit[order(xfit)], yfit[order(xfit)], col=linecolor,
> lwd = lwd, lty = lty)
> }
>
> summary.freekt <- function(object, ...)
> {
> answer <- NULL
> if (object using lambda != 0)
> {
> currline <- c(object using lambda,
> rep(NA, times = length(object using optknot)-1))
> answer <- rbind(answer, currline)
> }
> currline <- object using optknot
> answer <- rbind(answer, currline)
> currline <- c(object using GCV,
> rep(NA, times = length(object using optknot)-1))
> answer <- rbind(answer, currline)
> RSS <- sum((residuals(object))^2)
> currline <- c(RSS, rep(NA, times = length(object using optknot)-1))
> answer <- rbind(answer, currline)
> if (object using lambda != 0)
> rownames(answer) <-
> c("Optimal lambda", "Optimal knots", "GCV", "RSS")
> else
> rownames(answer) <- c("Optimal knots", "GCV", "RSS")
> colnames(answer) <- rep("", times = length(object using optknot))
> class(answer) <- "table"
> print(answer)
> }
>
> AIC.freekt <- function(object, ..., k = 2)
> {
> answer <- 0
> RSS <- sum((residuals(object))^2)
> n <- length(object using x)
> npar <- object using tracehat
> answer <- n * log(RSS/n) + k * npar
> return(answer)
> }
>
> AICc.freekt <- function(object)
> {
> answer <- 0
> RSS <- sum((residuals(object))^2)
> n <- length(object using x)
> npar <- object using tracehat
> answer <- n * log(RSS/n) + 2 * npar +
> 2 * npar * (npar + 1) /(n - npar - 1)
> return(answer)
> }
>
> BIC.freekt <- function(object, ...)
> {
> answer <- 0
> RSS <- sum((residuals(object))^2)
> n <- length(object using x)
> npar <- object using tracehat
> answer <- n * log(RSS/n) + log(n) * npar
> return(answer)
> }
>
> adjGCV.freekt <- function(object, d = 3)
> {
> RSS <- sum((residuals(object))^2)
> n <- length(object using x)
> adjtrace <- object using tracehat + d * length(object using optknot)
> answer <- (RSS/n) / (1 - adjtrace / n)^2
> return(answer)
> }
>
> adjAIC.freekt <- function(object)
> {
> answer <- 0
> RSS <- sum((residuals(object))^2)
> n <- length(object using x)
> npar <- object using tracehat
> effdim <- 2 * npar - object using degree - 1
> answer <- n * log(RSS/n) + 2 * effdim
> return(answer)
> }
>
> fit.search.numknots <- function(x, y, degree, minknot = 1, maxknot = 5,
> alg = "LS", search = "genetic",
> knotnumcrit = "adjGCV", k = 2,
> d = 3, seed = 5, stream = 0)
> {
> bestcrit <- Inf
> funcname <- ""
> answer <- NULL
> if ((alg == "LS") && (search == "genetic"))
> funcname <- "freelsgen"
> if ((alg == "LS") && (search == "golden"))
> funcname <- "freelsgold"
> if ((alg == "PS") && (search == "genetic"))
> funcname <- "freepsgen"
> if ((alg == "PS") && (search == "golden"))
> funcname <- "freepsgold"
> for (numknot in seq(from = minknot, to = maxknot))
> {
> currcall <- call(funcname, x, y, degree, numknot, seed, stream)
> currfit <- eval(currcall)
> currcrit <- switch(knotnumcrit, GCV = currfit using GCV,
> AIC = AIC(currfit, k = k), adjAIC = adjAIC.freekt(currfit),
> AICc = AICc.freekt(currfit), BIC = BIC(currfit),
> adjGCV = adjGCV.freekt(currfit, d))
> print(paste("Number of knots = ", numknot, ", ", knotnumcrit,
> " = ", currcrit, sep = ""), quote = FALSE)
> if (currcrit < bestcrit)
> {
> bestcrit <- currcrit
> answer <- currfit
> }
> }
> return(answer)
> }
>
> I am still not clear on what is causing this error.
>
> Sincerely,
>
> Steven Spiriti
>
> [[alternative HTML version deleted]]
>
> ______________________________________________
> R-package-devel using r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-package-devel
>
More information about the R-package-devel
mailing list