2014-10-19 28 views
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?

任何帮助将不胜感激。

+1

没有仔细阅读你的函数,但似乎你的函数正在返回一个标准的'list'对象,因此没有插槽。如果'unirootTest'返回带'test'插槽的'S4'对象,则应该可以通过'adfcs2(t1f.zs,max = 1,type =“c”)$ adfcst @ test'来检索它。 – nicola 2014-10-19 16:16:40

回答

0

非常感谢Nicola。他通过他的“f(...)$ ... @ ...”解决方案解决了我的问题。

解决方案:

myfunction(........)[email protected] 

我经历了,当我们的功能有自己的插槽,我们不能直接通过f(...)@SlotOfTheRootFunction访问根功能的插槽。

我们必须用我们的一个插槽(通过$)到达根函数的插槽(通过@)。