创建一个函数以通过 R 中的方程循环列答案

【问题标题】：Creating a function to loop columns through an equation in R创建一个函数以通过 R 中的方程循环列
【发布时间】：2021-07-11 20:40:47
【问题描述】：

解决方案（感谢@Peter_Evan！）以防遇到此问题的任何人遇到类似问题

（原问题如下）

## get all slopes (lm coefficients) first

# list of subfields of interest to loop through
sf <- c("left_presubiculum", "right_presubiculum", 
        "left_subiculum", "right_subiculum", "left_CA1", "right_CA1",
        "left_CA3", "right_CA3", "left_CA4", "right_CA4", "left_GC-ML-DG",
        "right_GC-ML-DG")

# dependent variables are sf, independent variable common to all models in the inner lm() call is ICV
# applies the lm(subfield ~ ICV, dataset = DF) to all subfields of interest (sf) specified previously
lm.results <- lapply(sf, function(dv) {
  temp.lm <- lm(get(dv) ~ ICV, data = DF)
  coef(temp.lm)
})

# returns a list, where each element is a vector of coefficients
# do.call(rbind, ) will paste them together
lm.coef <- data.frame(sf = sf,
                      do.call(rbind, lm.results))

# tidy up name of intercept variable
names(lm.coef)[2] <- "intercept"
lm.coef

## set up all components for the equation

# matrix to store output
out <- matrix(ncol = length(sf), nrow = NROW(DF))

# name the rows after each subject
row.names(out) <- DF$Subject

# name the columns after each subfield
colnames(out) <- sf

# nested for loop that goes by subject (j) and subfield (i)
for(j in DF$Subject){
  
  for (i in sf) {
    
    slope <- lm.coef[lm.coef$sf == i, "ICV"]

    out[j,i] <-  as.numeric( DF[DF$Subject == j, i] - (slope * (DF[DF$Subject == j, "ICV"] - mean(DF$ICV))) )

  }

}

# check output
out

================

原问题：

我有一个数据框 (DF)，它有 13 列（12 个不同的大脑子域，一列包含总颅内容量 (ICV)）和 50 行（每个不同的参与者）。我正在尝试自动为每个参与者在每一列上循环一个方程。

数据：

structure(list(Subject = c("sub01", "sub02", "sub03", "sub04", 
"sub05", "sub06", "sub07", "sub08", "sub09", "sub10", "sub11", 
"sub12", "sub13", "sub14", "sub15", "sub16", "sub17", "sub18", 
"sub19", "sub20"), ICV = c(1.50813, 1.3964237, 1.6703585, 1.4641886, 
1.6351018, 1.5524641, 1.4445532, 1.6384505, 1.6152434, 1.5278011, 
1.4788126, 1.4373356, 1.4109637, 1.3634952, 1.3853583, 1.4855268, 
1.6082085, 1.5644998, 1.5617522, 1.4304141), left_subiculum = c(411.225013, 
456.168033, 492.968477, 466.030173, 533.95505, 476.465524, 448.278213, 
476.45566, 422.617374, 498.995121, 450.773906, 461.989663, 549.805272, 
452.619547, 457.545623, 451.988333, 475.885847, 490.127968, 470.686415, 
494.06548), left_CA1 = c(666.893596, 700.982955, 646.21927, 580.864234, 
721.170599, 737.413139, 737.683665, 597.392434, 594.343911, 712.781376, 
733.157168, 699.820162, 701.640861, 690.942843, 606.259484, 731.198846, 
567.70879, 648.887718, 726.219904, 712.367433), left_presubiculum = c(325.779458, 
391.252815, 352.765098, 342.67797, 390.885737, 312.857458, 326.916867, 
350.657957, 325.152464, 320.718835, 273.406949, 305.623938, 371.079722, 
315.058313, 311.376271, 319.56678, 348.343569, 349.102678, 322.39908, 
306.966008), `left_GC-ML-DG` = c(327.037756, 305.63224, 328.945065, 
238.920358, 319.494513, 305.153183, 311.347404, 259.259723, 295.369164, 
312.022281, 324.200989, 314.636501, 306.550385, 311.399107, 295.108592, 
356.197094, 251.098248, 294.76349, 317.308576, 301.800253), left_CA3 = c(275.17038, 
220.862237, 232.542718, 170.088695, 234.707172, 210.803287, 246.861975, 
171.90896, 220.83478, 236.600832, 246.842024, 239.677362, 186.599097, 
224.362411, 229.9142, 293.684776, 172.179779, 202.18936, 232.5666, 
221.896625), left_CA4 = c(277.614028, 264.575987, 286.605092, 
206.378619, 281.781858, 258.517989, 269.354864, 226.269982, 256.384436, 
271.393257, 277.928824, 265.051581, 262.307377, 266.924683, 263.038686, 
306.133918, 226.364556, 262.42823, 264.862956, 255.673948), right_subiculum = c(468.762375, 
445.35738, 446.536018, 456.73484, 521.041823, 482.768261, 487.2911, 
456.39996, 445.392976, 476.146498, 451.775611, 432.740085, 518.170065, 
487.642399, 405.564237, 487.188989, 467.854363, 479.268714, 473.212833, 
472.325916), right_CA1 = c(712.973011, 717.815214, 663.637105, 
649.614586, 711.844375, 779.212704, 862.784416, 648.925038, 648.180611, 
760.761704, 805.943016, 717.486756, 801.853608, 722.213109, 621.676321, 
791.672796, 605.35667, 637.981476, 719.805053, 722.348921), right_presubiculum = c(327.285242, 
364.937865, 288.322641, 348.30058, 341.309111, 279.429847, 333.096795, 
342.184296, 364.245998, 350.707173, 280.389853, 276.423658, 339.439377, 
321.534798, 302.164685, 328.365751, 341.660085, 305.366589, 320.04127, 
303.83284), `right_GC-ML-DG` = c(362.391907, 316.853532, 342.93274, 
282.550769, 339.792696, 357.867386, 342.512721, 277.797528, 309.585721, 
343.770416, 333.524912, 302.505077, 309.063135, 291.29361, 302.510461, 
378.682679, 255.061044, 302.545288, 313.93902, 297.167161), right_CA3 = c(307.007404, 
243.839349, 269.063801, 211.336979, 249.283479, 276.092623, 268.183349, 
202.947849, 214.642782, 247.844657, 291.206598, 235.864996, 222.285729, 
201.427853, 237.654913, 321.338801, 199.035108, 243.204203, 236.305659, 
213.386702), right_CA4 = c(312.164065, 272.905586, 297.99392, 
240.765062, 289.98697, 306.459566, 284.533068, 245.965817, 264.750571, 
296.149675, 290.66935, 264.821461, 264.920869, 246.267976, 266.07378, 
314.205819, 229.738951, 274.152503, 256.414608, 249.162404)), row.names = c(NA, 
-20L), class = c("tbl_df", "tbl", "data.frame"))

等式：

adjustedBrain(participant1) = rawBrain(participant1) - 斜率*[ICV(participant1) - （斜率计算中包含的所有 ICV 测量值的平均值）]

代码（它不起作用，我希望得到一些指示）：

adjusted_Brain <- function(DF, subject) {
  subfields <- colnames(select(DF, "left_presubiculum", "right_presubiculum", 
                             "left_subiculum", "right_subiculum", "left_CA1", "right_CA1",
                             "left_CA3", "right_CA3", "left_CA4", "right_CA4", "left_GC-ML-DG",
                             "right_GC-ML-DG"))
  out <- matrix(ncol = length(subfields), nrow = NROW(DF))
  for (i in seq_along(subfields)) {
    DF[i] = DF[DF$Subject == "subject", "i"] - 
      slope * (DF[DF$Subject == "subject", "ICV"] -
                     mean(DF$ICV))
  }

}

收到此错误：

Error: Can't subset columns that don't exist.
x Column `i` doesn't exist.

几点说明：

每个子字段的每个主题的斜率将不同（并且将来自回归）-> 有没有办法在函数中指定斜率（来自适当的回归方程的系数）被调用？
我现在在输出中将我的 nrow 设置为参与者的数量，因为我想让这个在每个子字段的每个主题中运行，并吐出一个包含所有调整后脑容量的矩阵......但这似乎非常复杂，所以现在我将满足于单独运行每个参与者。

非常感谢任何帮助！

【问题讨论】：

您可以发布示例数据吗？请使用dput(df) 的输出编辑问题。或者，如果 dput(head(df, 20)) 的输出太大。
您的意思是在您的函数中使用i 而不是"i"？
@RuiBarradas 我已经编辑了帖子以包含示例数据（希望我做得正确）。
@Onyambu 我做到了，谢谢你接受这个！但是将“i”更改为 just i 并没有什么不同（仍然出现错误）。
不只是i 是你的问题，"subject" 也应该是subject。 DF[i] 也应该是 DF[, i]。最后，尽管您实际上在问题中提出了这个问题，但 slope 没有定义。我认为如果您有一个最小的工作示例 (mwe) 并可能显示您期望的输出外观以及您存储 slope 值的位置会更容易。

标签： r function for-loop

【解决方案1】：

正如其他人在 cmets 中指出的那样，有很多语法问题会阻止您的代码运行，以及一些未说明的要求。除此之外，我认为有足够的内容可以推荐一些您希望可以在此基础上进行改进的改进。以下是最重要的更改：

您可能不需要它是一个函数，而是一个嵌套的 for 循环（如果您想使用基础 R 执行此操作）。正如所写的那样，代码不够灵活，不足以提供功能。如果您打算在不同的数据集上多次应用它，那么一个函数可能是有意义的。但是，它将需要更大的重写。
假设您通过lm 拟合一个简单的回归，那么您可以通过$ 运算符和索引提取感兴趣的系数（见下文）。需要考虑如何处理循环中的不同模型。在这里，我们假设您只需要一个模型中的一个系数。
有一些语法不正确的地方，查看基本 R 中的子设置会有所帮助。其他人在 cmets 中指出其中一些是。

这是一种方法，我们通过每个特征或子字段 (i) 遍历每个主题 (j) 并将它们存储在矩阵中 (out)。这只是一种方法，几乎肯定需要在您的最后进行调整！

#NOTE: the dataset your provided is saved as x in this example.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           

#fit a linear model - here we assume there is only one coef. of interest, but you may need to alter
# depending on how the slope changes in each calculation                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          
reg <- lm(ICV ~ right_CA3, x)

# view the coeff.
reg$coefficients

# pull out the slope by getting the coeff. of interest (via index) from the reg object
slope <- reg$coefficients[[1]]

# list of features/subfeilds to loop through
sf <- c("left_presubiculum", "right_presubiculum", 
        "left_subiculum", "right_subiculum", "left_CA1", "right_CA1",
        "left_CA3", "right_CA3", "left_CA4", "right_CA4", "left_GC-ML-DG",
        "right_GC-ML-DG")

# matrix to store output
out <- matrix(ncol = length(sf), nrow = NROW(x))

#name the rows after each subject
row.names(out) <- x$Subject

#name the columns after each sub feild
colnames(out) <- sf

# nested for loop that goes by subject (j) and features/subfeilds (i)
for(j in x$Subject){

  for (i in sf) {

    out[j,i] <-  as.numeric( x[x$Subject == j, i] - (slope * (x[x$Subject == j, "ICV"] - mean(x$ICV))) )

  }

}

# check output
out

【讨论】：

这正是我所需要的，非常感谢！我已经用解决方案更新了我的问题（调整了代码以运行多个回归，并将相关斜率拉出并应用于 for 循环）。