Question

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

此外我希望函数返回输入变量的完整model.matrix，它可能具有平滑的术语作为解释变量，即输入向量的列首先由B-Spline函数评估然后返回

所以我的小功能看起来像这样：

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))
}

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

我查看了gam但是这里有一个新的函数interpret.gam用于执行此操作。有没有更简单的方法？

如何评估公式表达式（R）中的函数

0 个答案: