入手方法。 dplyr :: doの中で正しく解釈される式で？

Question

Iは、次のデータフレームを有する：

input.df <- dplyr::data_frame(x = rnorm(4), 
           y = rnorm(4), 
           `z 1` = rnorm(4)) 

Iが他の列と、各列の複数の回帰を行うと、各モデルのR二乗を抽出したいです。これは、次のコードを実行できることを意味します。

summary(lm(x ~ ., data = input.df)) 
summary(lm(y ~ ., data = input.df)) 
summary(lm(`z 1` ~ ., data = input.df)) 

そして、R-squaredをメモしてください。

私はこの作業を自動化し、最初の列が従属変数で、2番目の列がR-二乗である2つの列データフレームを作成します。

n <- ncol(input.df) 

replicate(n, input.df, simplify = F) %>% 
    dplyr::bind_rows() %>% 
    dplyr::mutate(group = rep(names(.), each = nrow(.)/n)) %>% 
    dplyr::group_by(group) %>% 
    dplyr::do({ 
    tgt.var <- .$group[1] 

    # How do I get the formula to interpret . as all variables? 
    lm(get(tgt.var) ~ ., data = .) %>% 
     broom::glance() %>% 
     dplyr::select(r.squared) 

    }) 

私は立ち往生午前の部分にコメントを入れている：

これは私が試したものです。次のエラーが表示されます。

Error in `contrasts<-`(`*tmp*`, value = contr.funs[1 + isOF[nn]]) : contrasts can be applied only to factors with 2 or more levels 

Answer 1

あなたはデータフレームの構築を少し複雑に思っています。同じデータセットですべての回帰を実行しているので、replicateの必要はありません。あなただけのアイデアは、これはエラーなしで実行しますが、望ましい結果が得られない

library(purrr) 
names(input.df) %>% 
    map(~ lm(get(.) ~ ., data = input.df)) 

のようなものを試してみることです、 purrrから mapを使用することができます。その理由は、 get(.)がデータセットの新しい変数として追加されるため、たとえば最初の回帰は x ~ x + y + `z 1`です。これは私たちが望むものではありません。これは、簡単に

names(input.df) %>% 
    map(~ lm(formula(paste0('`', ., '` ~ .')), data = input.df)) 

は（それ以外の場合は必要なかったであろう、なぜならあなたの第三変数の名前のエスケープバッククォートを含める必要性を注意してください）、次のようにlmに式を変更しているが、固定することができます。これで、望ましい結果が得られます。すべてを保持したくない場合には、r2を抽出したいだけです。

names(input.df) %>% 
    map(~ lm(formula(paste0('`', ., '` ~ .')), data = input.df)) %>% 
    map(summary) %>% 
    map_dbl('r.squared') 

Answer 2

問題を直接解決する方法がわかりません。別のモデルの場合、従属変数とr.sqを持つdata.frameを派生させる別の方法があります。

cond <- matrix(c(1,0,0,0,1,0,0,0,1), ncol=3) 
colnames(cond)<- colnames(input.df) 
cond 

    x y z 1 
[1,] 1 0 0 
[2,] 0 1 0 
[3,] 0 0 1 

xy <- lapply(1:nrow(cond), function(v) 
      list(y = colnames(cond)[which(cond[v,]==1)] %>% paste0("`", ., "`"), 
      x = colnames(cond)[which(cond[v,]==0)] %>% paste0("`", ., "`") %>% paste(., collapse="+"))) 


lm.form <- lapply(1:length(xy), function(v) paste(xy[[v]]$y, xy[[v]]$x, sep="~") %>% as.formula) 

lm.mod <- lapply(lm.form, function(v)lm(v, data=input.df)) 

data.frame(pred = lapply(xy, function(v) v["x"]) %>% unlist, 
      r.sq = lapply(lm.mod, function(v) summary(v)$r.sq)%>% unlist) 

     pred  r.sq 
1 `y`+`z 1` 0.5806704 
2 `x`+`z 1` 0.8500431 
3 `x`+`y` 0.8335421