将系数名称转换为R中的公式

时间:2010-11-25 21:37:01

标签: r formula sparse-matrix

当使用具有因子的公式时,拟合模型将系数命名为XY,其中X是因子的名称,Y是其特定级别。我希望能够从这些系数的名称创建一个公式。

原因:如果我将套索装入稀疏设计矩阵(如下所示),我想创建一个新的公式对象,其中只包含非零系数的项。

require("MatrixModels")
require("glmnet")
set.seed(1)
n <- 200
Z <- data.frame(letter=factor(sample(letters,n,replace=T),letters),
                x=sample(1:20,200,replace=T))
f <- ~ letter + x:letter + I(x>5):letter
X <- sparse.model.matrix(f, Z)
beta <- matrix(rnorm(dim(X)[2],0,5),dim(X)[2],1)
y <- X %*% beta + rnorm(n)

myfit <- glmnet(X,as.vector(y),lambda=.05)
fnew <- rownames(myfit$beta)[which(myfit$beta != 0)]
 [1] "letterb"              "letterc"              "lettere"             
 [4] "letterf"              "letterg"              "letterh"             
 [7] "letterj"              "letterm"              "lettern"             
[10] "lettero"              "letterp"              "letterr"             
[13] "letters"              "lettert"              "letteru"             
[16] "letterw"              "lettery"              "letterz"             
[19] "lettera:x"            "letterb:x"            "letterc:x"           
[22] "letterd:x"            "lettere:x"            "letterf:x"           
[25] "letterg:x"            "letterh:x"            "letteri:x"           
[28] "letterj:x"            "letterk:x"            "letterl:x"           
[31] "letterm:x"            "lettern:x"            "lettero:x"           
[34] "letterp:x"            "letterq:x"            "letterr:x"           
[37] "letters:x"            "lettert:x"            "letteru:x"           
[40] "letterv:x"            "letterw:x"            "letterx:x"           
[43] "lettery:x"            "letterz:x"            "letterb:I(x > 5)TRUE"
[46] "letterc:I(x > 5)TRUE" "letterd:I(x > 5)TRUE" "lettere:I(x > 5)TRUE"
[49] "letteri:I(x > 5)TRUE" "letterj:I(x > 5)TRUE" "letterl:I(x > 5)TRUE"
[52] "letterm:I(x > 5)TRUE" "letterp:I(x > 5)TRUE" "letterq:I(x > 5)TRUE"
[55] "letterr:I(x > 5)TRUE" "letteru:I(x > 5)TRUE" "letterv:I(x > 5)TRUE"
[58] "letterx:I(x > 5)TRUE" "lettery:I(x > 5)TRUE" "letterz:I(x > 5)TRUE"

从此我想有一个公式

~ I(letter=="d") + I(letter=="e") + ...(etc)

我检查了公式()和all.vars()无济于事。此外,编写一个函数来解析这个问题有点痛苦,因为可能出现的术语类型不同。例如,对于x:字母,当x是数值而字母是因子,或I(x> 5):字母作为另一个烦人的情况。

所以我不知道在公式及其字符表示之间进行转换的某些函数又回来了吗?

2 个答案:

答案 0 :(得分:3)

当我运行代码时,我得到了一些不同的东西,因为没有指定set.seed()。我没有使用变量名称“letter”,而是使用“letter_”作为方便的分割标记:

> fnew <- rownames(myfit$beta)[which(myfit$beta != 0)]

> fnew
 [1] "letter_c" "letter_d" "letter_e" "letter_f" "letter_h" "letter_k" "letter_l"
 [8] "letter_o" "letter_q" "letter_r" "letter_s" "letter_t" "letter_u" "letter_v"
[15] "letter_w"

然后进行拆分并打包成字符矩阵:

> fnewmtx <- cbind( lapply(sapply(fnew, strsplit, split="_"), "[[", 2),
+ lapply(sapply(fnew, strsplit, split="_"), "[[", 1))
  

fnewmtx            [,1] [,2]
  letter_c“c”“letter”   letter_d“d”“letter”   letter_e“e”“letter”   letter_f“f”“letter”剪掉其余的

并在as.formula()中包装了paste函数输出,这是如何“在公式及其字符表示之间进行转换并返回”的答案的一半。另一半是as.character()

form <- as.formula( paste("~", 
             paste( 
               paste(" I(", fnewmtx[,2], "_ ==", "'",fnewmtx[,1],"') ", sep="") , 
             sep="", collapse="+")
                 ) 
           )  # edit: needed to add back the underscore

输出现在是一个合适的类对象:

> class(form)
[1] "formula"
> form
~I(letter_ == "c") + I(letter_ == "d") + I(letter_ == "e") + 
    I(letter_ == "f") + I(letter_ == "h") + I(letter_ == "k") + 
    I(letter_ == "l") + I(letter_ == "o") + I(letter_ == "q") + 
    I(letter_ == "r") + I(letter_ == "s") + I(letter_ == "t") + 
    I(letter_ == "u") + I(letter_ == "v") + I(letter_ == "w")

我觉得有趣的是,as.formula转换使字母周围的单引号成为双引号。

编辑:既然问题有一两个额外的维度,我的建议就是跳过公式的重新创建。请注意,myfit $ beta的rownames与X的列名完全相同,因此请使用非零的rownames作为索引来选择X矩阵中的列:

> str(X[ , which( colnames(X) %in% rownames(myfit$beta)[which(myfit$beta != 0)] )] )
Formal class 'dgCMatrix' [package "Matrix"] with 6 slots
  ..@ i       : int [1:429] 9 54 91 157 166 37 55 68 117 131 ...
  ..@ p       : int [1:61] 0 5 13 20 28 36 42 50 60 68 ...
  ..@ Dim     : int [1:2] 200 60
  ..@ Dimnames:List of 2
  .. ..$ : chr [1:200] "1" "2" "3" "4" ...
  .. ..$ : chr [1:60] "letter_b" "letter_c" "letter_e" "letter_f" ...
  ..@ x       : num [1:429] 1 1 1 1 1 1 1 1 1 1 ...
  ..@ factors : list()

> myfit2 <- glmnet(X[ , which( colnames(X) %in% rownames(myfit$beta)[which(myfit$beta != 0)] )] ,as.vector(y),lambda=.05)
> myfit2

Call:  glmnet(x = X[, which(colnames(X) %in% rownames(myfit$beta)[
                                           which(myfit$beta != 0)])], 
              y = as.vector(y), lambda = 0.05) 

     Df   %Dev Lambda
[1,] 60 0.9996   0.05

答案 1 :(得分:2)

克里斯托弗,在对sparse.model.matrix等进行一些考虑和考察之后,你所要求的内容似乎有些参与其中。你没有解释为什么你不想为X_test形成完整的稀疏模型矩阵,所以除了以下两个选项之外,很难建议前进的方法。

如果X_test中有大量观察结果,因此出于计算原因不希望生成用于predict()的完整稀疏矩阵,则分割{{1}可能更为便利两个或多个样本块,依次形成每个样本的稀疏模型矩阵,在使用后丢弃它。

如果不这样做,您将需要详细研究Matrix包中的代码。从X_test开始,请注意它然后调用sparse.model.matrix并在该函数中找到Matrix:::model.spmatrix的调用。您可能需要从这些函数中选择代码,但使用修改后的Matrix:::fac2Sparse来实现您想要实现的目标。

很抱歉,我无法提供现成的脚本来执行此操作,但这是一项重要的编码任务。如果沿着那条路走下去,请查看Matrix包中的稀疏模型矩阵插图并获取包源(来自CRAN),看看我提到的函数是否更好地记录在源代码中(那里例如,fac2Sparse没有Rd文件。您也可以向Matrix的作者(Martin Maechler和Doug Bates)寻求建议,但请注意,这两个章节在这个学期都有特别沉重的教学负担。

祝你好运!