Question

我有data.frame

set.seed(100)
exp <- data.frame(exp = c(rep(LETTERS[1:2], each = 10)), re = c(rep(seq(1, 10, 1), 2)), age1 = seq(10, 29, 1), age2 = seq(30, 49, 1), 
                  h = c(runif(20, 10, 40)), h2 = c(40 + runif(20, 4, 9)))

我想为数据集lm中的每一行设(h and h2 ~ age1 and age2) 我是通过loop

来做的

exp$modelh <- 0

for (i in 1:length(exp$exp)){
  age = c(exp$age1[i], exp$age2[i])
  h = c(exp$h[i], exp$h2[i])
  model = lm(age ~ h)
  exp$modelh[i] = coef(model)[1] + 100 * coef(model)[2]

}

它运行良好，但需要一些非常大的文件。将不胜感激f.ex.更快的解决方案。 dplyr

Answer 1

使用dplyr，我们可以尝试使用rowwise()和do。在do内，我们连接（c）'age1'，'age2'来创建'age'，同样，我们可以创建'h'，应用lm，提取{ {1}}创建列'modelh'。

coef

给出输出

library(dplyr)
exp %>%
    rowwise() %>%
    do({
       age <- c(.$age1, .$age2)
       h <- c(.$h, .$h2)
       model <- lm(age ~ h)
       data.frame(., modelh = coef(model)[1] + 100*coef(model)[2])
    } )

我们可以# exp re age1 age2 h h2 modelh #1 A 1 10 30 19.23298 46.67906 68.85506 #2 A 2 11 31 17.73018 47.55402 66.17050 #3 A 3 12 32 26.56967 46.69174 84.98486 #4 A 4 13 33 11.69149 47.74486 61.98766 #5 A 5 14 34 24.05648 46.10051 82.90167 #6 A 6 15 35 24.51312 44.85710 89.21053 #7 A 7 16 36 34.37208 47.85151 113.37492 #8 A 8 17 37 21.10962 48.40977 74.79483 #9 A 9 18 38 26.39676 46.74548 90.34187 #10 A 10 19 39 15.10786 45.38862 75.07002 #11 B 1 20 40 28.74989 46.44153 100.54666 #12 B 2 21 41 36.46497 48.64253 125.34773 #13 B 3 22 42 18.41062 45.74346 81.70062 #14 B 4 23 43 21.95464 48.77079 81.20773 #15 B 5 24 44 32.87653 47.47637 115.95097 #16 B 6 25 45 30.07065 48.44727 101.10688 #17 B 7 26 46 16.13836 44.90204 84.31080 #18 B 8 27 47 20.72575 47.14695 87.00805 #19 B 9 28 48 20.78425 48.94782 84.25406 #20 B 10 29 49 30.70872 44.65144 128.39415版devel即data.table来执行此操作。安装devel版本的说明是here。

我们将'data.frame'转换为'data.table'（v1.9.5），使用选项setDT创建一个列'rn'。我们keep.rownames=TRUE数据集指定melt中的patterns，以便从'wide'格式转换为'long'格式。按'rn'分组，我们执行measure并获取lm。这可以在原始数据集（'exp'）中指定为新列，同时通过将{coef）分配给:=来删除不需要的'rn'列。

NULL

Answer 2

来自@akrun的好（双）回答。

当您提到“这是一个更大问题的例子”时，只是对您未来分析的建议。显然，如果你真的对按行构建模型感兴趣，那么随着你的年龄和观察结果的增加，你会创建越来越多的列。如果你得到N个观察值，你将不得不为这两个变量使用2xN列。

我建议使用长数据格式来增加行而不是列。

类似的东西：

 exp[1,]  # how your first row (model building info) looks like

#   exp re age1 age2        h       h2
# 1   A  1   10   30 19.23298 46.67906


reshape(exp[1,],                                  # how your model building info is transformed
        varying = list(c("age1","age2"),
                                 c("h","h2")), 
        v.names = c("age_value","h_value"), 
        direction = "long")

#     exp re time age_value  h_value id
# 1.1   A  1    1        10 19.23298  1
# 1.2   A  1    2        30 46.67906  1

如果“更大的问题”引用其他内容并且这个答案无关紧要，请道歉。

Answer 3

使用base R，函数sprintf可以帮助我们创建公式。 lapply执行计算。

strings <- sprintf("c(%f,%f) ~ c(%f,%f)", exp$age1, exp$age2, exp$h, exp$h2)
lst <- lapply(strings, function(x) {model <- lm(as.formula(x));coef(model)[1] + 100 * coef(model)[2]})
exp$modelh <- unlist(lst)
exp
#    exp re age1 age2        h       h2    modelh
# 1    A  1   10   30 19.23298 46.67906  68.85506
# 2    A  2   11   31 17.73018 47.55402  66.17050
# 3    A  3   12   32 26.56967 46.69174  84.98486
# 4    A  4   13   33 11.69149 47.74486  61.98766
# 5    A  5   14   34 24.05648 46.10051  82.90167
# 6    A  6   15   35 24.51312 44.85710  89.21053
# 7    A  7   16   36 34.37208 47.85151 113.37493
# 8    A  8   17   37 21.10962 48.40977  74.79483
# 9    A  9   18   38 26.39676 46.74548  90.34187
# 10   A 10   19   39 15.10786 45.38862  75.07002
# 11   B  1   20   40 28.74989 46.44153 100.54666
# 12   B  2   21   41 36.46497 48.64253 125.34773
# 13   B  3   22   42 18.41062 45.74346  81.70062
# 14   B  4   23   43 21.95464 48.77079  81.20773
# 15   B  5   24   44 32.87653 47.47637 115.95097
# 16   B  6   25   45 30.07065 48.44727 101.10688
# 17   B  7   26   46 16.13836 44.90204  84.31080
# 18   B  8   27   47 20.72575 47.14695  87.00805
# 19   B  9   28   48 20.78425 48.94782  84.25406
# 20   B 10   29   49 30.70872 44.65144 128.39416

在lapply函数中，表达式as.formula(x)将第一行中创建的公式转换为lm函数可用的格式。

<强>基准

library(dplyr)
library(microbenchmark)
set.seed(100)
big.exp <- data.frame(age1=sample(30, 1e4, T),
                      age2=sample(30:50, 1e4, T),
                      h=runif(1e4, 10, 40),
                      h2= 40 + runif(1e4,4,9))

microbenchmark(
  plafort = {strings <- sprintf("c(%f,%f) ~ c(%f,%f)", big.exp$age1, big.exp$age2, big.exp$h, big.exp$h2)
             lst <- lapply(strings, function(x) {model <- lm(as.formula(x));coef(model)[1] + 100 * coef(model)[2]})
             big.exp$modelh <- unlist(lst)},

  akdplyr = {big.exp %>%
    rowwise() %>%
    do({
       age <- c(.$age1, .$age2)
       h <- c(.$h, .$h2)
       model <- lm(age ~ h)
       data.frame(., modelh = coef(model)[1] + 100*coef(model)[2])
    } )}

,times=5)
t: seconds
    expr      min       lq     mean   median       uq      max neval cld
 plafort 13.00605 13.41113 13.92165 13.56927 14.53814 15.08366     5  a 
 akdplyr 26.95064 27.64240 29.40892 27.86258 31.02955 33.55940     5   b

（注意：我今天下载了最新的1.9.5版本的data.table，但在尝试测试时仍然收到错误。结果也略有不同（1.93 x 10 ^ -8）。舍入可能导致差异。）

all.equal(pl, ak)
[1] "Attributes: < Component “class”: Lengths (1, 3) differ (string compare on first 1) >"
[2] "Attributes: < Component “class”: 1 string mismatch >"                                
[3] "Component “modelh”: Mean relative difference: 1.933893e-08"

<强>结论

与lapply相比，dplyr方法在速度方面似乎表现良好，但它的5位数舍入可能是一个问题。可能有所改进。转换为矩阵后可能会使用apply来提高速度和效率。

按行自动回归

3 个答案: