0

正規表現を使用する前に、これに対する非常に長い解決策を考え出しましたが、よりネイティブな方法で解決できることを願っています。

モデルを考えると、おそらく次のようになります

data(tips, package="reshape2")
mod <- lm(tip ~ total_bill*sex + sex*day, tips)
mod$coefficients

どの係数が式のどの変数に対応するかを特定したいと考えています。このような：

|    Coefficient     |    Variable    |
|:-------------------|:---------------|
| total_bill         | total_bill     |
| sexMale            | sex            |
| daySat             | day            |
| daySun             | day            |
| dayThur            | day            |
| total_bill:sexMale | total_bill,sex |
| sexMale:daySat     | sex,day        |
| sexMale:daySun     | sex,day        |
| sexMale:dayThur    | sex,day        |

私は調べmodel.matrixましmodel.formulaたが、それらは私をこのコード行に導きました

.Internal(model.matrix(t, data))

私は C コードに飛び込みましたが、もっと簡単な方法が必要だと考えました。ある？

DWin の素敵な答えに応えて、正規表現が失敗する可能性のある複雑な例を作成しました。これは、正規表現が私を怖がらせるエッジケースの 1 つです。

はdata.frame、頻繁に発生する混乱しやすい変数名と値で構築されています。

baseball <- data.frame(Bat=sample(1:100, 20, replace=T), Batter=sample(c("David", "Batley", "Bob", "Ace"), 20, replace=T), Hits=sample(1:20, 20, replace=T))
baseball
bMod <- lm(Hits ~ Bat*Batter, baseball)
bMod$coefficients

col.matx <- sapply(colnames(model.matrix(bMod)), function(cols) sapply(labels(bMod), function(trm) grep(patt=trm, x=cols, value=TRUE)))

これは、連続変数Batを のすべての係数に一致させfactor Batterます。

はい、これはばかげた例ですが、簡単に発生する可能性があります。

4

2 に答える 2

0

これは正確な答えではありませんが、目的に合わせて再配置する方法を確認できるはずです。labels最初のステップでは、各model.matrix列名に含まれているものを識別します。

col.matx <- sapply(colnames(model.matrix(mod)), function(cols) 
         sapply(labels(mod), function(trm) grep(patt=trm, x=cols, value=TRUE)))
#---------------------------------------
               (Intercept) total_bill   sexMale     daySat      daySun      dayThur    
total_bill     Character,0 "total_bill" Character,0 Character,0 Character,0 Character,0
sex            Character,0 Character,0  "sexMale"   Character,0 Character,0 Character,0
day            Character,0 Character,0  Character,0 "daySat"    "daySun"    "dayThur"  
total_bill:sex Character,0 Character,0  Character,0 Character,0 Character,0 Character,0
sex:day        Character,0 Character,0  Character,0 Character,0 Character,0 Character,0
               total_bill:sexMale   sexMale:daySat   sexMale:daySun   sexMale:dayThur  
total_bill     "total_bill:sexMale" Character,0      Character,0      Character,0      
sex            "total_bill:sexMale" "sexMale:daySat" "sexMale:daySun" "sexMale:dayThur"
day            Character,0          "sexMale:daySat" "sexMale:daySun" "sexMale:dayThur"
total_bill:sex "total_bill:sexMale" Character,0      Character,0      Character,0      
sex:day        Character,0          Character,0      Character,0      Character,0

結果の行名は、値が長さゼロの項目でない場合、マトリックス値に関連付けて折りたたむ必要があります。

> which(sapply(col.matx, length) != 0 , arr.ind=TRUE)
 [1]  6 12 18 23 28 31 32 34 37 38 42 43 47 48

したがって、これは上記のマトリックスから項目名を選択し、モジュロ演算を使用してそれらを term.labels に関連付けます。 

data.frame(coef =  unlist(col.matx[
                      which(sapply(col.matx, length) != 0 , arr.ind=TRUE)] ), 
           term.label =rownames(col.matx)[
                       which(sapply(col.matx, length) != 0 , arr.ind=TRUE) %% 5 ])
                 coef     term.label
1          total_bill     total_bill
2             sexMale            sex
3              daySat            day
4              daySun            day
5             dayThur            day
6  total_bill:sexMale     total_bill
7  total_bill:sexMale            sex
8  total_bill:sexMale total_bill:sex
9      sexMale:daySat            sex
10     sexMale:daySat            day
11     sexMale:daySun            sex
12     sexMale:daySun            day
13    sexMale:dayThur            sex
14    sexMale:dayThur            day

値を折りたたむメソッドは、SO で頻繁に要求されます。過去 24 時間以内に回答されたものがあります。

于 2013-03-06T23:23:11.797 に答える
0

わかりました、モデルに完全に含まれている情報を使用して、lm モデルの解決策を見つけました。

require(plyr)       # for join function
require(reshape2)   # for melt function

matchCoefs <- function(model)
{
    # get the terms
    theTerms <- model$terms
    # get the assignment position
    thePos <- model$assign
    # get intercept indicator
    inter <- attr(theTerms, "intercept")
    # get coef names
    coefNames <- names(coef(model))
    # get pred names
    predNames <- attr(theTerms, "term.labels")
    # expand out pred names to match coefficient names
    predNames <- predNames[thePos]
    # if there's an intercept term add it to the pred names
    if(inter == 1)
    {
        predNames <- c("(Intercept)", predNames)
    }

    # build data.frame linking term to coefficient name
    matching <- data.frame(Term=predNames, Coefficient=coefNames)

    ## now match individual predictor to term
    # get matrix as data.frame
    factorMat <- as.data.frame(attr(theTerms, "factor"))
    # add column from rownames as identifier
    factorMat$.Pred <- rownames(factorMat)
    # melt it down for comparison
    factorMelt <- melt(factorMat, id.vars=".Pred", variable.name="Term", )
    # only keep rows where there's a match
    factorMelt <- factorMelt[factorMelt$value == 1, ]
    # again, bring in coefficient if needed
    if(inter == 1)
    {
        factorMelt <- rbind(data.frame(.Pred="(Intercept)", Term="(Intercept)", value=1), factorMelt)
    }
    # join into the matching data.frame
    matching <- join(matching, factorMelt, by="Term")

    return(matching)
}

# fit some models with different terms
mod1 <- lm(tip ~ total_bill * sex + day, tips)
mod2 <- lm(tip ~ total_bill * sex + day - 1, tips)
mod3 <- lm(tip ~ (total_bill + sex + day)^3, tips)
mod4 <- lm(tip ~ total_bill * sex + day + I(total_bill^2), tips)

matchCoefs(mod1)
matchCoefs(mod2)
matchCoefs(mod3)
matchCoefs(mod4)

# now with the convoluted baseball example
baseball <- data.frame(Bat=sample(1:100, 20, replace=T), Batter=sample(c("David", "Batley", "Bob", "Ace"), 20, replace=T), Hits=sample(1:20, 20, replace=T))
bMod <- lm(Hits ~ Bat*Batter, baseball)
matchCoefs(bMod)

ループなし、すべての組み込み関数、正規表現なし。これをもう少しテストして、データ型情報を投入する必要がありますが、それは比較的簡単なはずです。

于 2013-03-11T05:00:19.697 に答える