如何在公式表达式（R）中计算函数

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

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

我的小函数如下所示：

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

其中，

样条曲线（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))
}

---

spline我没有激活“自我回答”选项，但是如果有人遇到这样的问题，这里的解决方案是：通过样条函数返回的对象不是矩阵。如果它被转换成这样，一切都会按照预期的方式工作。
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))
}