3

假设我想编写一个可以像普通 lm 类型函数一样使用的函数：y~x...

此外，我希望该函数返回输入变量的完整 model.matrix，这些变量可能具有平滑项作为解释变量，即输入向量的列首先由 B 样条函数评估，然后返回。

所以我的小功能是这样的：

model <- function(formula, data=list()){
mf <- model.frame(formula=formula, data=data)
return(mf)
}

该调用应该能够评估smth。喜欢

model(y~x1+spline(x2,5,1), data=dat)

spline(x2,5,1)的平滑影响在哪里x2。我的样条函数定义如下：

spline <- function(var,n,d){ 
    name <- deparse(substitute(var))
    Basis <- data.table(i=1:(n+d))
    Basis <- Basis[,B(i,d,var,knots(n,d,min(var),max(var))), by="i"]
    Basis[,numbers:=rep(1:length(var))]
    Basis <- as.data.table(dcast(Basis, numbers ~ i, value.var="V1"))
    Basis[,numbers:=NULL]
    setnames(Basis,names(Basis),paste0(name,".",1:(n+d)))
return(Basis)
}

B <- function(i,d,t,knots){
a <- (t - knots[i]) / ( knots[i+d] - knots[i] )
a <- ifelse(is.nan(a),0,a)
a <- ifelse(is.infinite(a),0,a)
b <- (knots[i+d+1] - t) / ( knots[i+d+1] - knots[i+1] )
b <- ifelse(is.nan(b),0,b)
b <- ifelse(is.infinite(b),0,b)
if(d==0)
    return( ifelse(t>=knots[i] & t < knots[i+1],1,0) )
else
    return( a*B(i,d-1,t,knots)+b*B(i+1,d-1,t,knots) )
}


knots <- function(m,d,min,max){
    k <- seq(min,max,length.out=m+1)
    step <- k[2]-k[1]
    outer.l <- rev(min(k)-step*(1:d))
    outer.r <- max(k)+step*(1:d)
    return(c(outer.l,k,outer.r))
}

如果我调用该函数model，则它无法评估spline(x2,5,1)，因为 data-argument 不包含相应的列。

我看了看，gam但是这里使用了一个新功能interpret.gam来执行此操作。没有更简单的方法吗？

4

0 回答 0