0
我写这取决于fUnitroots的unitrootTest功能:在R中定义一个新函数时如何保护根函数的插槽(除了我们的写入插槽)?
我想除了一个来自unitrootTest添加和使用新的插槽:
library(fUnitRoots)
adfcs1 <- function(t, max = floor(12*(length(t)/100)^(1/4)), type = c("c")) {
x <- ts(t)
x1d <- diff(x, differences=1)
x1l <- lag(x, -1)
x_names <- c("x1d", "x1l", sapply(1:max, function(i) paste("x1d", i, "l", sep="")))
for (i in as.integer(1:max)) { assign(x_names[i+2], lag(x1d, -i)) }
DLDlag <- do.call(ts.intersect, sapply(x_names, as.symbol))
DLDlag.df <- data.frame(DLDlag, obspts = c(time(DLDlag)))
DifferenceLags <- as.vector(names(DLDlag.df), mode="any")[3: (length(DLDlag.df)-1)]
lmresults <- array(list())
SBCvalues <- array(list())
AICvalues <- array(list())
for (i in as.integer(0:max)) {
if (type==c("nc")) {
if (i == 0) { lmresults[[max+1]] <- lm(as.formula(paste("x1d ~x1l")),data=DLDlag.df)
SBCvalues[[max+1]] <- BIC(lmresults[[max+1]])
AICvalues[[max+1]] <- AIC(lmresults[[max+1]]) }
if (i > 0) { lmresults[[i]] <- lm(as.formula(paste("x1d ~ x1l+", paste(DifferenceLags[1:i], collapse="+"))),data=DLDlag.df)
SBCvalues[[i]] <- BIC(lmresults[[i]])
AICvalues[[i]] <- AIC(lmresults[[i]]) }
}
if (type==c("c")) {
if (i == 0) { lmresults[[max+1]] <- lm(as.formula(paste("x1d ~1+x1l")),data=DLDlag.df)
SBCvalues[[max+1]] <- BIC(lmresults[[max+1]])
AICvalues[[max+1]] <- AIC(lmresults[[max+1]]) }
if (i > 0) { lmresults[[i]] <- lm(as.formula(paste("x1d ~ 1+x1l+", paste(DifferenceLags[1:i], collapse="+"))),data=DLDlag.df)
SBCvalues[[i]] <- BIC(lmresults[[i]])
AICvalues[[i]] <- AIC(lmresults[[i]]) }
}
if (type==c("ct")) {
if (i == 0) { lmresults[[max+1]] <- lm(as.formula(paste("x1d ~ 1+x1l+seq_along(x1d)",collapse="")),data=DLDlag.df)
SBCvalues[[max+1]] <- BIC(lmresults[[max+1]])
AICvalues[[max+1]] <- AIC(lmresults[[max+1]]) }
if (i > 0) { lmresults[[i]] <- lm(as.formula(paste("x1d ~ 1+x1l+seq_along(x1d)+",paste(DifferenceLags[1:i], collapse="+"))),data=DLDlag.df)
SBCvalues[[i]] <- BIC(lmresults[[i]])
AICvalues[[i]] <- AIC(lmresults[[i]]) }
}
}
list(which.min(SBCvalues), which.min(AICvalues))
as.data.frame(cbind(SBCvalues, AICvalues))
typespecified <- type
if (which.min(SBCvalues)==max+1) {
scs <- (max+2)-(0+1)
adfcs1 <- unitrootTest(x[scs:length(x)], lags = 0, type = typespecified)
} else {
scs <- (max+2)-(which.min(SBCvalues)+1)
adfcs1 <- unitrootTest(x[scs:length(x)], lags =which.min(SBCvalues), type = typespecified)
}
adfcs1
}
当我加入@test插槽,即使我没有adfcs1定义它,它会自动检索unitrootTest详细的“系数”的结果(因为我想):
> adfcs1(f1f.zs,max=1,type="c")@test
$data.name
[1] "x[scs:length(x)]"
$regression
Call:
lm(formula = y.diff ~ y.lag.1 + 1)
Residuals:
Min 1Q Median 3Q Max
-2.49700 -0.12039 0.06813 0.26813 0.77105
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -0.05766 0.04631 -1.245 0.216
y.lag.1 -0.47631 0.08387 -5.679 1.36e-07 ***
.....
$statistic
DF
-5.679303
$p.value
t n
4.216696e-06 3.641807e-01
$parameter
Lag Order
0
当我想用我的定义插槽(optmins,SBCAIC等),除了一个来自unitrootTest,当我添加@test插槽时,它会给出错误!
adfcs2 <- function(t, max = floor(12*(length(t)/100)^(1/4)), type = c("c")) {
x <- ts(t)
x1d <- diff(x, differences=1)
x1l <- lag(x, -1)
x_names <- c("x1d", "x1l", sapply(1:max, function(i) paste("x1d", i, "l", sep="")))
for (i in as.integer(1:max)) { assign(x_names[i+2], lag(x1d, -i)) }
DLDlag <- do.call(ts.intersect, sapply(x_names, as.symbol))
DLDlag.df <- data.frame(DLDlag, obspts = c(time(DLDlag)))
DifferenceLags <- as.vector(names(DLDlag.df), mode="any")[3: (length(DLDlag.df)-1)]
lmresults <- array(list())
SBCvalues <- array(list())
AICvalues <- array(list())
for (i in as.integer(0:max)) {
if (type==c("nc")) {
if (i == 0) { lmresults[[max+1]] <- lm(as.formula(paste("x1d ~x1l")),data=DLDlag.df)
SBCvalues[[max+1]] <- BIC(lmresults[[max+1]])
AICvalues[[max+1]] <- AIC(lmresults[[max+1]]) }
if (i > 0) { lmresults[[i]] <- lm(as.formula(paste("x1d ~ x1l+", paste(DifferenceLags[1:i], collapse="+"))),data=DLDlag.df)
SBCvalues[[i]] <- BIC(lmresults[[i]])
AICvalues[[i]] <- AIC(lmresults[[i]]) }
}
if (type==c("c")) {
if (i == 0) { lmresults[[max+1]] <- lm(as.formula(paste("x1d ~1+x1l")),data=DLDlag.df)
SBCvalues[[max+1]] <- BIC(lmresults[[max+1]])
AICvalues[[max+1]] <- AIC(lmresults[[max+1]]) }
if (i > 0) { lmresults[[i]] <- lm(as.formula(paste("x1d ~ 1+x1l+", paste(DifferenceLags[1:i], collapse="+"))),data=DLDlag.df)
SBCvalues[[i]] <- BIC(lmresults[[i]])
AICvalues[[i]] <- AIC(lmresults[[i]]) }
}
if (type==c("ct")) {
if (i == 0) { lmresults[[max+1]] <- lm(as.formula(paste("x1d ~ 1+x1l+seq_along(x1d)",collapse="")),data=DLDlag.df)
SBCvalues[[max+1]] <- BIC(lmresults[[max+1]])
AICvalues[[max+1]] <- AIC(lmresults[[max+1]]) }
if (i > 0) { lmresults[[i]] <- lm(as.formula(paste("x1d ~ 1+x1l+seq_along(x1d)+",paste(DifferenceLags[1:i], collapse="+"))),data=DLDlag.df)
SBCvalues[[i]] <- BIC(lmresults[[i]])
AICvalues[[i]] <- AIC(lmresults[[i]]) }
}
}
out <- list()
out$optmins <- list(which.min(SBCvalues), which.min(AICvalues))
out$SBCAIC <- as.data.frame(cbind(SBCvalues, AICvalues))
typespecified <- type
if (which.min(SBCvalues)==max+1) {
scs <- (max+2)-(0+1)
out$adfcst <- unitrootTest(x[scs:length(x)], lags = 0, type = typespecified)
} else {
scs <- (max+2)-(which.min(SBCvalues)+1)
out$adfcst <- unitrootTest(x[scs:length(x)], lags =which.min(SBCvalues), type = typespecified)
}
out
}
> adfcs2(t1f.zs,max=1,type="c")$optmins # My defined slot works
[[1]]
[1] 2
[[2]]
[1] 2
> adfcs2(t1f.zs,max=1,type="c")@test
# Whereas this time original slot that (I guess) came from unitrootTest doesn't work anymore!
Error: trying to get slot "test" from an object of a basic class ("list") with no slots
如何保留除根据我们新功能定义的插槽以外的插槽? 我错过了正确使用$和@的内容吗? $是什么?什么是@ for?
任何帮助将不胜感激。
没有仔细阅读你的函数,但似乎你的函数正在返回一个标准的'list'对象,因此没有插槽。如果'unirootTest'返回带'test'插槽的'S4'对象,则应该可以通过'adfcs2(t1f.zs,max = 1,type =“c”)$ adfcst @ test'来检索它。 – nicola 2014-10-19 16:16:40