Question

是否可以对数据帧中的每两列使用apply函数？如果我有数据框

dat <- data.frame(A=rnorm(100), B=rnorm(100),C=rnorm(100), D=rnorm(100))

A           B            C          D
0.1511642 -0.44930197  1.821832535  2.0145395
-1.1639599  0.42685832 -0.763015835 -0.7785278
0.8430158  0.26827386 -0.004560031  0.8823789
0.7103298  0.78512673 -0.968510541  0.5172418
0.8508458  0.05809655  0.391845531  0.7452540
0.2217195 -0.06988857  0.714890499 -1.1536502

我想要我可以使用的每一列的总和

apply(dat,2,sum)

但是如果我想在每两列上应用一个函数怎么办？例如

coefficients(lm(dat$A~dat$B))
coefficients(lm(dat$C~dat$D))

我有400列，并且不想为每对列写200次。我以为使用j和j + 1列的for循环可以工作，但是我想要A和B列，C和D列，E和F列之间的关系，依此类推。不是列A和B，然后是列B和C，然后是列C和D。是否可以通过apply（）或apply系列中的另一个函数来执行此操作？

Answer 1

创建一个分组向量g，对其进行拆分，然后在其上套用lm。

请注意，如果d = data.frame(y, x)用于响应y和预测变量x，则lm(d)是回归lm(y ~ x, d)。

n <- ncol(dat)
g <- rep(1:n, each = 2, length = n) # 1 1 2 2 
L <- lapply(split.default(dat, g), lm)

sapply(L, coef) # coefficients
sapply(L, function(x) summary(x)$r.squared) # R^2
# etc.

也可以在名称上完成

L2 <- lapply(split.default(names(dat), g), function(nms) lm(dat[nms]))
sapply(L2, coef)

或者如果您希望更好的Call：输出中的行：

reg <- function(nms, dat) do.call("lm", list(reformulate(nms[2], nms[1]), quote(dat)))
L2 <- lapply(split.default(names(dat), g), reg, dat = dat)
sapply(L2, coef)

请注意，lm公式中的变量不能以数字开头，因此如果违反此要求，则可能需要重命名列。如果使用lm（dat）形式，则不是必需条件，但如果使用公式，则是必需条件。有关示例，请参见注释。

注意

关于名称形式问题的注释，如果名称如下所示，我们可以使用以下代码替代形式g：

# modify test example
s <- c("1234.score1", "1234.score2", "5678.score1", "5678.score2")
dat2 <- setNames(dat, s)

g <- cumsum(sub(".*\\D", "", names(dat2)) == 1)  # 1 1 2 2
L <- lapply(split.default(dat2, g), lm)
sapply(L, coef)

或者我们可以使用它（但是，这将导致输出按g排序）：

# modify column names
dat3 <- dat2
names(dat3) <- paste0("x", names(dat3))

g <- sub("\\..*", "", names(dat3)) # x1234 x1234 x5678 x5678
reg <- function(nms, dat) do.call("lm", list(reformulate(nms[2], nms[1]), quote(dat)))
L2 <- lapply(split.default(names(dat3), g), reg, dat = dat3)
sapply(L2, coef)

Answer 2

您可以使用mapply / Map通过每两列设置数据帧子集来每两列重复一个函数。希望这会有所帮助！

使用lm

lm_list <- Map(function(y, x) summary(lm(y~x))$coefficients, dat[c(T,F)], dat[c(F,T)])
names(lm_list) <- paste0(names(dat[c(T,F)]), " ~ ", names(dat[c(F,T)]))
lm_list

$`A ~ B`
              Estimate Std. Error   t value  Pr(>|t|)
(Intercept) 0.03566648  0.1051079 0.3393320 0.7350857
x           0.03602569  0.1162846 0.3098062 0.7573662

$`C ~ D`
                Estimate Std. Error     t value  Pr(>|t|)
(Intercept) -0.008610382  0.1021835 -0.08426389 0.9330185
x           -0.053369101  0.1171255 -0.45565742 0.6496444

数据：

set.seed(42)
dat <- data.frame(A=rnorm(100), B=rnorm(100),C=rnorm(100), D=rnorm(100))

Answer 3

您可以利用命名约定先堆叠数据，然后对通用ID组进行操作。这可能使事情更容易进行将来的分析。

我修改了每个评论的列名。

dat <- data.frame(ID1.score1=rnorm(100), ID1.score2=rnorm(100),ID2.score1=rnorm(100), ID2.score2=rnorm(100))

library(dplyr)
library(stringr)
library(purrr)

将列名称拆分为“。”。前半部分是IDS，后半部分指定score1或score2（即X或Y）。

cols <- str_split(names(dat), "\\.", simplify = TRUE)
ids <- unique(cols[,1])
scores <- unique(cols[,2])

使用purrr，遍历ID，然后选择以ID开头的列对。在此新的data.frame中添加另一列以存储ID。然后按行堆叠所有这些。现在我们有了一个“整洁”格式的数据集。

stacked_dat <- ids %>%
  map_dfr(~ {
    select(dat, starts_with(.)) %>%
      set_names(scores) %>%
      mutate(id = .x)})

现在，只需将ID列分组，并为每个ID拟合模型即可。

fits <- stacked_dat %>%
  group_by(id) %>%
  do(model = lm(score1 ~ score2, data = .))

在列表中获得像这样的模型统计信息。包broom可以借助purrr来帮助堆叠和清理东西。

fits$model

Answer 4

这是完全不同的东西。您可以基于名称为每个配对创建公式列表。然后，只需遍历同一数据集上的每个公式即可。

dat <- data.frame(ID1.score1=rnorm(100), ID1.score2=rnorm(100),ID2.score1=rnorm(100), ID2.score2=rnorm(100))

ids <- unique(sub("\\..*", "", names(dat)))
f <- lapply(paste0(ids, ".score2 ~ ", ids, ".score1"), as.formula)

models <- lapply(f, function(f) lm(f, dat))

然后，您可以使用模型列表提取或执行所需的操作。

model_coef <- sapply(models, coef)
colnames(model_coef) <- ids

model_coef

                    ID1         ID2
(Intercept) -0.07592376 -0.02472962
ID1.score1  -0.02284805  0.09144416

将函数应用于R中的每两列

4 个答案:

注意