如何计算R中四个点的斜率？

Question

在这组数据中，第一行代表x值。每个随后的行代表一个对应的y值。我想计算每行的斜率（4个点）。

有什么可能的方法来计算斜率，以便在原始数据帧的每一行的末尾都返回一个斜率值。

data <- structure(list(month = c("/", "1", "1", "1", "1", "1", "1", "1", 
"1", "1", "1", "1", "1", "1", "1", "1", "1", "1", "1", "1", "1", 
"1", "1", "1", "1", "1", "1", "1", "1", "1", "1", "2", "2", "2", 
"2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", 
"2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", 
"2", "3", "3", "3", "3", "3", "3", "3", "3", "3", "3", "3", "3", 
"3", "3", "3", "3", "3", "3", "3", "3", "3", "3", "3", "3", "3", 
"3", "3", "3", "3", "3"), site = c("/", "Port", "Port", "Port", 
"Port", "Port", "Port", "Port", "Port", "Port", "Port", "Bluff", 
"Bluff", "Bluff", "Bluff", "Bluff", "Bluff", "Bluff", "Bluff", 
"Bluff", "Bluff", "Palm", "Palm", "Palm", "Palm", "Palm", "Palm", 
"Palm", "Palm", "Palm", "Palm", "Port", "Port", "Port", "Port", 
"Port", "Port", "Port", "Port", "Port", "Port", "Bluff", "Bluff", 
"Bluff", "Bluff", "Bluff", "Bluff", "Bluff", "Bluff", "Bluff", 
"Bluff", "Palm", "Palm", "Palm", "Palm", "Palm", "Palm", "Palm", 
"Palm", "Palm", "Palm", "Port", "Port", "Port", "Port", "Port", 
"Port", "Port", "Port", "Port", "Port", "Bluff", "Bluff", "Bluff", 
"Bluff", "Bluff", "Bluff", "Bluff", "Bluff", "Bluff", "Bluff", 
"Palm", "Palm", "Palm", "Palm", "Palm", "Palm", "Palm", "Palm", 
"Palm", "Palm"), s1 = c(0.1, 0.029442, 0.025032, 0.023814, 0.023226, 
0.029778, 0.02541, 0.027006, 0.021252, 0.026502, 0.029358, 0.026964, 
0.022008, 0.028056, 0.02856, 0.030618, 0.02457, 0.02646, 0.02877, 
0.028266, 0.02793, 0.03087, 0.031416, 0.030912, 0.029526, 0.031038, 
0.03108, 0.030114, 0.031668, 0.029988, 0.02856, 0.029736, 0.030492, 
0.031248, 0.029568, 0.030324, 0.02982, 0.030324, 0.03003, 0.02877, 
0.02919, 0.030744, 0.03129, 0.02814, 0.028686, 0.028644, 0.02856, 
0.027342, 0.03129, 0.030492, 0.026292, 0.027552, 0.02625, 0.028476, 
0.023982, 0.024192, 0.015918, 0.030114, 0.028728, 0.029358, 0.030786, 
0.029064, 0.031206, 0.031542, 0.03129, 0.030324, 0.029442, 0.029358, 
0.024444, 0.03045, 0.032172, 0.028728, 0.029652, 0.031626, 0.031962, 
0.032088, 0.030324, 0.03087, 0.031248, 0.031626, 0.030996, 0.029316, 
0.02268, 0.028392, 0.023394, 0.02982, 0.021714, 0.02898, 0.031038, 
0.029148, 0.028224), s2 = c(5.22907407407407, 0.981706366666667, 
0.806009477777778, 0.742319355555556, 0.856522333333333, 1.15520704444444, 
0.964136677777778, 0.939978355555556, 0.814794322222222, 0.953155622222222, 
1.15301083333333, 1.02123816666667, 0.799420844444445, 1.15081462222222, 
1.13983356666667, 1.2452517, 0.983902577777778, 1.07175102222222, 
1.17497294444444, 1.17497294444444, 1.08932071111111, 1.24085927777778, 
1.35286604444444, 1.33310014444444, 1.19254263333333, 1.40996753333333, 
1.32211908888889, 1.31553045555556, 1.41655616666667, 1.20791611111111, 
1.13983356666667, 1.16399188888889, 1.30674561111111, 1.36823952222222, 
1.26721381111111, 1.29356834444444, 1.21230853333333, 1.28039107777778, 
1.30674561111111, 1.17936536666667, 1.19913126666667, 1.2254858, 
1.37482815555556, 1.01245332222222, 1.0278268, 1.06296617777778, 
1.08932071111111, 1.07614344444444, 1.3440812, 1.21450474444444, 
1.0475927, 1.1464222, 1.07394723333333, 1.11128282222222, 1.1068904, 
1.09810555555556, 0.744515566666667, 1.09151692222222, 1.33968877777778, 
1.09810555555556, 1.23207443333333, 1.21450474444444, 1.42753722222222, 
1.40996753333333, 1.44071448888889, 1.39239784444444, 1.39459405555556, 
1.35506225555556, 1.17058052222222, 1.4033789, 1.45389175555556, 
0.8104019, 1.51977808888889, 1.47365765555556, 1.44510691111111, 
1.53734777777778, 1.46926523333333, 1.47146144444444, 1.48463871111111, 
1.50660082222222, 1.48683492222222, 1.28917592222222, 1.11787145555556, 
1.26941002222222, 1.08492828888889, 1.42973343333333, 1.06296617777778, 
1.28258728888889, 1.3638471, 1.31113803333333, 1.25184033333333
), s3 = c(16.6712037037037, 3.01081938888889, 2.32463264444444, 
2.27561930555556, 2.56969933888889, 3.57797373888889, 2.96180605, 
2.93379842777778, 2.2686174, 2.95480414444444, 3.56396992777778, 
3.12985178333333, 2.50668218888889, 3.5289604, 3.26988989444444, 
3.62698707777778, 2.80076222222222, 3.26288798888889, 3.45894134444444, 
3.48694896666667, 3.24888417777778, 3.66199660555556, 4.39719668888889, 
4.20114333333333, 3.781029, 4.22214905, 4.27816429444444, 4.22214905, 
4.5372348, 3.52195849444444, 3.64099088888889, 3.71801185, 4.06110522222222, 
4.34818335, 3.81603852777778, 4.10311665555555, 3.76002328333333, 
4.01909378888889, 4.05410331666667, 3.64799279444444, 3.73901756666667, 
3.88605758333333, 4.34818335, 3.10184416111111, 3.23488036666667, 
3.36091466666667, 3.47294515555556, 3.2768918, 4.13812618333333, 
3.74601947222222, 3.26988989444444, 3.50095277777778, 3.19987083888889, 
3.36791657222222, 3.24888417777778, 3.19987083888889, 1.77848401111111, 
3.32590513888889, 3.97708235555555, 3.38892228888889, 3.6549947, 
3.77402709444444, 4.38319287777778, 4.34118144444444, 4.42520431111111, 
4.31317382222222, 4.31317382222222, 4.1591319, 3.57097183333333, 
4.34118144444444, 4.50222527222222, 1.64544780555556, 4.06810712777778, 
4.74029006111111, 4.69127672222222, 4.15212999444444, 4.41820240555556, 
4.2851662, 4.69827862777778, 4.69127672222222, 4.43920812222222, 
3.95607663888889, 3.45894134444444, 3.84404615, 3.29789751666667, 
4.42520431111111, 3.26288798888889, 3.90006139444444, 4.11712046666667, 
3.97708235555555, 3.80903662222222), s4 = c(33.8268981481481, 
6.43590564166667, 4.87310294722222, 4.61737159722222, 5.19987078333333, 
7.57248941944444, 6.03810131944444, 5.99547942777778, 4.57474970555556, 
6.16596699444444, 7.11785590833333, 6.40749104722222, 5.04359051388889, 
7.17468509722222, 6.62060050555556, 7.58669671666667, 5.66871159166667, 
6.56377131666667, 7.23151428611111, 7.30255077222222, 6.70584428888889, 
7.84242806666667, 8.60962211666667, 8.92218265555556, 7.99870833611111, 
6.10913780555555, 9.23474319444444, 9.078462925, 8.80852427777778, 
7.85663536388889, 7.6719405, 7.544074825, 8.311268875, 8.822731575, 
7.74297698611111, 8.567000225, 7.82822076944445, 8.41071995555555, 
8.52437833333333, 7.51566023055555, 7.64352590555556, 8.12657401111111, 
7.95608644444444, 6.57797861388889, 6.73425888333333, 7.04681942222222, 
7.21730698888889, 6.79108807222222, 8.32547617222222, 7.77139158055556, 
6.81950266666667, 7.00419753055556, 6.6490151, 7.06102671944444, 
6.91895374722222, 6.59218591111111, 3.31030025277778, 7.032612125, 
8.02712293055555, 7.01840482777778, 7.70035509444444, 7.6719405, 
8.90797535833333, 8.822731575, 8.97901184444444, 8.6948659, 8.76590238611111, 
8.39651265833333, 7.14627050277778, 8.79431698055556, 8.83693887222222, 
2.35841133888889, 6.6490151, 8.76590238611111, 8.39651265833333, 
6.16596699444444, 6.96157563888889, 6.86212455833333, 8.45334184722222, 
7.85663536388889, 7.544074825, 8.06974482222222, 6.90474645, 
7.82822076944445, 6.67742969444444, 8.1834032, 6.59218591111111, 
7.89925725555555, 8.28285428055555, 8.08395211944444, 7.71456239166667
)), row.names = c(NA, -91L), class = c("tbl_df", "tbl", "data.frame"
))

Answer 1

您可以使用类似的东西

# create a "slope" column
data$slope <- NA
# extract the slopes of the regressions with each row beginning from the 2nd as the y values and the first row as the x values
data[2:nrow(data), "slope"] <- apply(data[2:nrow(data), c("s1", "s2", "s3", "s4")], 1, function(row_i){
  lm(unlist(row_i) ~ unlist(data[1, c("s1", "s2", "s3", "s4")]))$coefficients[2]
})

Answer 2

好的，首先，将第一行保留在数据帧中非常不方便，而且毫无意义。它应该单独保存，因为它提供了除数据帧其余部分以外的其他信息。

xs <- as.numeric(data[1, 3:6]) #saving first row in a separate variable
data <- data[-1, ] #removing first from from the data frame

（顺便说一下，命名对象data也是不明智的，因为那是R中函数的名称）

现在，由于数据框中的任何一行都不例外，因此我们可以将任何函数应用于每一行。我不知道，“斜率”到底是什么意思，但是我想您想知道适合这些点的线性模型的斜率。您可以这样做：

slopes <- apply(data, 1, function(row) {
  lm(y ~ x, list(x = xs, y = as.numeric(row[3:6])))$coefficients['x']
})

结果是得到一个数值向量。如果您想将其添加到数据框中，则可以运行

data <- cbind(data, slope = slopes)

Answer 3

lm()函数还接受response中response ~ terms的矩阵。因此，如果转置数据集，则可以避免任何循环。

正如其他用户所提到的，在第一行中包含x信息是很麻烦的。相反，最好使用一个单独的变量。

ys <- t(DF[-1, -(1:2)])
xs <- t(DF[1, -(1:2)])
lm(ys ~ xs)[['coefficients']][2,]

#or adding it to the DF

DF%>%
  slice(-1)%>%
  mutate(Slope = lm(ys ~ xs)[['coefficients']][2,])

# A tibble: 90 x 7
   month site      s1    s2    s3    s4 Slope
   <chr> <chr>  <dbl> <dbl> <dbl> <dbl> <dbl>
 1 1     Port  0.0294 0.982  3.01  6.44 0.190
 2 1     Port  0.0250 0.806  2.32  4.87 0.143
 3 1     Port  0.0238 0.742  2.28  4.62 0.136
 4 1     Port  0.0232 0.857  2.57  5.20 0.153
 5 1     Port  0.0298 1.16   3.58  7.57 0.223
 6 1     Port  0.0254 0.964  2.96  6.04 0.178
 7 1     Port  0.0270 0.940  2.93  6.00 0.177
 8 1     Port  0.0213 0.815  2.27  4.57 0.134
 9 1     Port  0.0265 0.953  2.95  6.17 0.182
10 1     Port  0.0294 1.15   3.56  7.12 0.210
# ... with 80 more rows