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

Question

In this set of data, the first row represents the x-values. Each sub sequent row represents a corresponding y-value. I would like to calculate the slope of each row (4 points).

What is a possible way of computing the slope so that there's a slope value returned at the end of each row of the original data frame.

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

You can use something like this

# 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

Okay, firstly, it's very inconvenient and really pointless to keep this first row in the data frame. It should be kept separately, because it gives another information than rest of the data frame.

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

(by the way, naming an object data is also unwise, because that's the name of the function in R)

Now, as any row in the data frame isn't exceptional, we can apply any function to each row. I don't know, what do you exactly mean by 'slope', but I assume you want to know slope of a linear model fitted to those points. You can do it like this:

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

As a result you get a numeric vector. If you wand to add it to the data frame, you can run

data <- cbind(data, slope = slopes)

Answer 3

The lm() function also accepts a matrix for the response in response ~ terms . Therefore, if we transpose the dataset, we can have avoid the any loops.

As other users mentioned, it's messy to include the x information in the first row. Instead, a separate variable would be preferable.

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