Error - this S4 class is not subsettable - r

Question

I know there are several answers on this question, however I could not find any applicable to my question. Could anyone help me in regards to the error this S4 class is not subsettable at the bottom of this code. I am not sure where this error comes from. The output result should be the thresholded coefficients of DWT.
xx <- list(list(c(1,2,3,4,5,6,7,5,4,3,2,4,3,2,3,5,4,3,2,3,4,5,6,3,4,3,3),
c(0,3,1,4,1,2,7,5,4,1,3,4,9,2,7,5,1,3,2,2,1,1,1,5,1,3,1)),
list(c(0,3,1,4,1,2,7,5,4,1,3,4,9,2,2,4,7,6,4,2,1,1,1,5,1,3,1),
c(1,2,3,4,5,6,7,5,4,3,5,4,3,2,3,4,5,6,3,2,1,2,3,5,4,3,3)),
list(c(0,3,1,4,1,2,7,5,4,1,3,4,3,2,2,4,7,6,4,2,1,1,1,5,1,3,1),
c(1,2,3,4,5,6,4,3,2,3,5,4,3,2,3,4,5,6,3,2,1,2,3,5,4,3,3)))
# Select Filter.
library(wavelets)
filter <- c ("d2","d4","d6", "c6","d8","la8","la10","d12","c12","la12","la14","d14","d16","la16","d18","c18","la18")
boundary <- c("periodic","reflection")
g <- seq(1:length(xx))
fun <- function (x) seq(1: as.integer (floor (logb ((length(xx[[x]][[1]])),base=2))))
nlevel <- lapply( g,fun)
fun <- function(x) expand.grid(filter=filter,nlevel=nlevel[[x]],boundary=boundary, stringsAsFactors=FALSE)
w3<- lapply(g,fun)
z <- c(seq(1:length(w3)))
mapply3 <- function(i) {
w4 <- w3[[i]]
mapply ( function ( m,k,p,x ) modwt ( x, filter = m, n.levels = k, boundary=p) , w3[[i]]$filter, w3[[i]]$nlevel, w3[[i]]$boundary , MoreArgs = list(x = (xx[[i]][[1]])) )
}
DWT <- lapply ( z, mapply3 )
#---------------------------------------------------------------------------
vscale <- c("level")
# smooth.levels <- c(nlevel)
prior <- c("laplace")
a <- c(0.1,0.3)
bayesfac <- c("TRUE")
threshrule <- c("median","mean")
#---------------------------------------------------------------------------
X <- seq(1:length(DWT))
fun <- function (x) DWT[x]
u <- lapply(X,fun)
fun <- function (x) seq(1:length(DWT[[x]]))
U <- lapply(X,fun)
L1 <- expand.grid ( vscale = vscale, prior = prior, a = a , bayesfac = bayesfac , threshrule = threshrule , stringsAsFactors = FALSE )
# --------------------------------------------------------------------------
library ( EbayesThresh )
mapply2 <- function ( DWTi , LL ) {
mapply ( function ( c,e,f,g,h,x ) ebayesthresh.wavelet ( x, vscale = c, prior = e, a = f, bayesfac = g, threshrule = h ) , LL$vscale , LL$prior , LL$a , LL$bayesfac , LL$threshrule , MoreArgs = list ( x = DWTi ) )
}
mapply3 <- function( i, L1, DWT ) {
DWTi <- DWT [[i]][U[[i]]]
w3 <- L1
lapply( DWTi, mapply2, w3 )
}
M1 <- lapply(z, mapply3, L1, DWT)
# Error in x.dwt[[j]] : this S4 class is not subsettable

Answer 1

This might be a bug in the "wavelets" package. I looked up the source code of ebayesthresh.wavelet, copied it, and added some "print" debugging:
#------------------------------------------------------------------------
# The same as "ebayesthresh.wavelet.dwt" plus some "print" for debugging:
ebayesthresh.wvlt.dwt <-
function (x.dwt, vscale = "independent", smooth.levels = Inf,
prior = "laplace", a = 0.5, bayesfac = FALSE, threshrule = "median")
{
nlevs <- length(x.dwt) - 1
slevs <- min(nlevs, smooth.levels)
print("nlevs:")
print(nlevs)
print("slevs")
print(slevs)
if (is.character(vscale)) {
vs <- substring(vscale, 1, 1)
if (vs == "i")
vscale <- mad(x.dwt[[1]])
if (vs == "l")
vscale <- NA
}
print("1:slevs:")
print(1:slevs)
for (j in 1:slevs) {
print("j:")
print(j)
x.dwt[[j]] <- ebayesthresh(x.dwt[[j]], prior, a, bayesfac,
vscale, FALSE, threshrule)
print("OK")
}
return(x.dwt)
}
#----------------------------------------------------------------------------
# The same as "ebayesthresh.wavelet",
# but it calls "ebayesthresh.wvlt.dwt" instead of "ebayesthresh.wavelet.dwt":
ebayesthresh.wvlt <-
function (xtr, vscale = "independent", smooth.levels = Inf, prior = "laplace",
a = 0.5, bayesfac = FALSE, threshrule = "median")
{
xcl <<- class(xtr)
if (class(xcl) == "dwt " && length(xcl) > 1) {
xtr <- ebayesthresh.wavelet.splus(xtr, vscale, smooth.levels,
prior, a, bayesfac, threshrule)
return(xtr)
}
if (xcl == "wd") {
xtr <- ebayesthresh.wavelet.wd(xtr, vscale, smooth.levels,
prior, a, bayesfac, threshrule)
return(xtr)
}
if (xcl == "dwt" || xcl == "modwt") {
xtr <- ebayesthresh.wvlt.dwt(xtr, vscale, smooth.levels,
prior, a, bayesfac, threshrule)
return(xtr)
}
print("Unknown wavelet transform type; no smoothing performed")
return(xtr)
}
The function mapply2 now calls ebayesthresh.wvlt instead of ebayesthresh.wavelet:
mapply2 <- function ( DWTi , LL )
{
mapply ( function ( c,e,f,g,h,x ) ebayesthresh.wvlt ( x,
vscale = c,
prior = e,
a = f,
bayesfac = g,
threshrule = h ) ,
LL$vscale ,
LL$prior ,
LL$a ,
LL$bayesfac ,
LL$threshrule,
list(x=DWTi ) )
}
Let's see:
> M1 <- lapply(z, mapply3, L1, DWT)
[1] "nlevs:"
[1] 0
[1] "slevs"
[1] 0
[1] "1:slevs:"
[1] 1 0
[1] "j:"
[1] 1
Error in x.dwt[[j]] : this S4 class is not subsettable
>
In R the for-loop
for (j in 1:n) {...}
is not empty, if n is 0 or negative. (Another reason to avoid for-loops?) j runs from 1 to n in steps of -1. A similar bug I found here.
If we replace the for-loop in ebayesthresh.wvlt.dwt by a while-loop, the error message disappears:
j <- 1
while (j<=slevs) {
x.dwt[[j]] <- ebayesthresh(x.dwt[[j]], prior, a, bayesfac,
vscale, FALSE, threshrule)
j <- j+1
}