3

通常の 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))
}

関数を呼び出すと、データ引数に対応する列が含まれていないため、model評価できません。spline(x2,5,1)

私は見ましgamたが、ここではこれを行うために新しい関数interpret.gamが使用されています。もっと簡単な方法はありませんか?

4

0 に答える 0