绘制一个切线，并使用R找到X截取 [英] Drawing a Tangent to the Plot and Finding the X-Intercept using R

问题描述

对于2列可以使用 plot（data $ x，data $ y）绘制绘图的数据框，如下所示，我们如何在任意点说 x = 25 ，然后找到x截取轴的切线 y = 0 ？

data：

  df<  -  structure（list（x = c（40,39.8， 39.5999999999999，39.3999999999999，
 39.1999999999998，39，38.8，38.5999999999999，38.3999999999999，
 38.1999999999998，38，37.8，37.5999999999999，37.3999999999999，
 37.1999999999998，37，36.8，36.5999999999999，36.3999999999999，
 36.1999999999998，36，35.8，35.5999999999999，35.3999999999999，
 35.1999999999998，35％，34.8，34.5999999999999，34.3999999999999，
 34.1999999999998，34，33.8，33.5999999999999，33.3999999999999，
 33.1999999999998，33，32.8，32.5999999999999， 32.3999999999999，
 32.1999999999998，32 ，31.8，31.5999999999999，31.3999999999999，
 31.1999999999998，31，30.8，30.5999999999999，30.3999999999999，
 30.1999999999998，30％，29.8，29.5999999999999，29.3999999999999，
 29.1999999999998，29，28.8，28.5999999999999，28.3999999999999，
 28.1999999999998,28,27.8,27.5999999999999,27.3999999999999，
 27.1999999999998,27,26.8,26.5999999999999,26.3999999999999，
 26.1999999999998,26,25.8,25.5999999999999,25.3999999999999，
 25.1999999999998,25,24.8 ，24.5999999999999，24.3999999999999，
 24.1999999999998，24，23.8，23.5999999999999，23.3999999999999，
 23.1999999999998，23，22.8，22.5999999999999，22.3999999999999，
 22.1999999999998，22，21.8，21.5999999999999，21.3999999999999，
 21.1999999999998,21,20.8,20.5999999999999,20.3999999999999，
 20.1999999999998,20,199,19.5999999999999,19.3999999999999，
 19.1999999999998,19,18.8,18.5999999999999,18.3999999999999 
 18.1999999999998,18,178,17.599999999 9999，17.3999999999999，
 17.1999999999998,17,16.8,16.5999999999999,16.3999999999999，
 16.1999999999998,16,15.8,15.5999999999999,15.3999999999999，
 15.1999999999998,15,15.8,14.5999999999999,14.3999999999999 
 14.1999999999998,14,13.8,13.5999999999999,13.3999999999999，
 13.1999999999998,13,128,12.5999999999999,12.3999999999999，
 12.1999999999998,12,13.8,11.5999999999999,11.3999999999999，
 11.1999999999998,11,10.8,10.5999999999999， 10.3999999999999，
 10.1999999999998，10，9.79999999999995，9.59999999999991，9.39999999999986，
 9.19999999999982，9，8.79999999999995，8.59999999999991，8.39999999999986，
 8.19999999999982，8，7.79999999999995，7.59999999999991，7.39999999999986，
 7.19999999999982， 7，6.79999999999995,6.59999999999991,6.39999999999986，
 6.19999999999982,6,7.99999999999995,5.59999999999991,5.39999999999986，
 5.19999999999982,5,7.79999999999995,4.59999999999991,4.39999999999986， 
 4.19999999999982，4，3.79999999999995，3.59999999999991，3.39999999999986，
 3.19999999999982，3，2.79999999999995，2.59999999999991，2.39999999999986，
 2.19999999999982，2，1.79999999999995，1.59999999999991，1.39999999999986，
 1.19999999999982，1， 0.799999999999955,0.599999999999909,0.399999999999864，
 0.199999999999818,0,0.200000000000045,0.400000000000091 
 -0.600000000000136 -0.800000000000182,1 -1.20000000000005,0 
 -1.40000000000009,1.60000000000014,1.80000000000018， - 2，
 -2.20000000000005，-2.40000000000009，-2.60000000000014，-2.80000000000018，
 -3，-3.20000000000005，-3.40000000000009，-3.60000000000014，
 -3.80000000000018，-4，-4.20000000000005，-4.40000000000009， 
 -4.60000000000014，-4.80000000000018，-5），y = c（35785,34955.9，
 34448,33632.6,32905.1,31976.5,31332.4,30851.3,29547.2，
 29092,28786.6,28053.9， 27609.1,27117.9,26628.8,26236.2，
 25997.6,25248.5,24876.7,24697.4,24745 .8，24403.1，23935.2，
 23994.9,23489,23596,23630.8,23537,23489.3,23336.4,23515.6，
 23373.7,23191.3,23455.6,23510.1,23653.3,23574.3,23504.9，
 23239.2 ，22993.1,23246.4,23057.4,22718.7,22532.4,22656.7，
 22362.9,22184,21929.7,21511.1,21579.2,21692.3,21839.3，
 21906.5,22342,22830.3,23506.3,24714.6,26358.3,28813.4，
 32087.4,37048.2,43395.1,52583.3,63510.6,74687.6,87307，
 98589.2,109683,123260,143686,173741,206937,225777,213844，
 188426,179882,195311,213540,1993136 ，153434,102167,65320.5，
 43524.6,31564.6,24683.9,20481.1,15033.8,15430.9,13942.4，
 12742.8,11795.2,11032.4,10758.8,9999.94,9620.13,9242.19，
 8769.68,8336.05 ，7848.7,7439.94,7236.61,6840.17,6474.1，
 6314.83,6119.46,5984.71,5838.92,5482.56,5592.16,5479.21，
 5473.05,5263.42,5131.52,5160.8,5037.07,5111.43,4925.95，
 5044.38,5073.06,5163.09,5395.14,5685.84,5781.48,5927.53，
 5991.07， 5918.79,6208.65,6355.15,6336.74,6866.93,6765.42，
 7010.48,6975.84,7173.03,7208.73,7167.87,7150.69,7066.63，
 6850.88,6615.22,6514.08,6244.01,6000.48,5574.86,5179.76，
 5093.81，4797.62，4561.38，4378.95，4480.99，4454.68，4528.07，
 4697.9,4895.49,5122.23,5522.48,5618.13,5909.07,6144.77，
 6444.93,6347.01,6890.34,7092.59,7323.97,7125.42， 6986.75，
 6699.94,6488.58,6757.7,6080.23,5982.45,5692.35,52929.27，
 5843.41,6057.06,6181.98,6516.04,65997.08,6776.47,6912.55，
 7053.48,7008.47,7194.52,7362.31， 7320.14,7362.08,748.24.24 
 7096.13,6704.73,6217.18,5835.08,5424.88,5640.08,5687.38，
 5571.61,5044.32,4456.51,3369.23,2196.51,1276.21,756.717，
 484.31,315.931， 265.893,190.014,161.302,145.354,126.608，
 90.857,101.612,76.3276,84.7987,83.5705,77.3315,53.2172 
 52.2799,39.4456,53.3765,30.8025,48.2821,39.0606,22.8557，
 34.3351,25.2945,25.4592,21.7338））.Names = c（x，y），class =data.frame，row.names = c（NA，
 -226L））
  

解决方案

这是一个使用拟合样条函数派生的选项（ smooth.spline - 您可能需要将参数 spar 调整到您的案例）：

  x < -  seq（0,40）
y<  -  dnorm（seq（0,40），mean = 25，sd = 5）
 plot（x，y）
 spl<  -  smooth.spline（y〜x）
 lines（spl，col = 2）
 
 newx<  -  20 
 pred0<  -  predict = newx，deriv = 0）
 pred1<  -  predict（spl，x = newx，deriv = 1）
 
 yint<  -  pred0 $ y  - （pred1 $ y * newx） 
 xint<  -  -yint / pred1 $ y 
 xint 
  

结果视觉上：

  plot（x，y）
 abline（h = 0，col = 8）
行（spl，col = 2）＃spline 
 points（pred0，col = 2，pch = 19）＃指向切线
 lines（x，yint + pred1 $ y * x，col = 3 ）＃正切（第一个导数。在newx中的样条曲线）
 points（xint，0，col = 3，pch = 19）＃x intercept 
  

更新

以下是使用数据集（ df ）的示例：

 ＃fit smooth spline 
 plot（y〜x，df）
 spl<  -  smooth.spline（df $ x，df $ y， spar = 0.3）
 newx<  -  seq（min（df $ x），max（df $ x），0.1）
 pred<  -  predict（spl，x = newx，deriv = 0） 
 lines（pred，col = 2）
 
＃在给定的x 
中解决切线$ b newx <$ 25 
 pred0<  -  predict（spl，x = newx，deriv = 0）
 pred1<  -  predict（spl，x = newx，deriv = 1）
 yint<  -  pred0 $ y  - （pred1 $ y * newx）
 xint<  -  -yint / pred1 $ y 
 xint 
 
＃绘图结果
 plot（y〜x，df）
 abline（h = 0，col = 8）
行（spl，col = 2）＃spline 
 points（pred0，col = 2，pch = 19）＃指向切线
行（x，yint + pred1 $ y * x，col = 3）＃正切（样条的第一个导数newx）
 points（xint，0，col = 3，pch = 19）＃x intercept 
  

我是不确定您的数据有多少噪音，但是通过在 smooth.spline 中使用较小的 spar 设置，您可以增加拟合函数的细节。

For a data frame whose 2 columns can draw a plot using plot(data$x,data$y) as shown below, how can we draw a tangent at an arbitrary point say x=25, then find the x interception of the tangent with the axis y=0?

data:

df <- structure(list(x = c(40, 39.8, 39.5999999999999, 39.3999999999999, 
39.1999999999998, 39, 38.8, 38.5999999999999, 38.3999999999999, 
38.1999999999998, 38, 37.8, 37.5999999999999, 37.3999999999999, 
37.1999999999998, 37, 36.8, 36.5999999999999, 36.3999999999999, 
36.1999999999998, 36, 35.8, 35.5999999999999, 35.3999999999999, 
35.1999999999998, 35, 34.8, 34.5999999999999, 34.3999999999999, 
34.1999999999998, 34, 33.8, 33.5999999999999, 33.3999999999999, 
33.1999999999998, 33, 32.8, 32.5999999999999, 32.3999999999999, 
32.1999999999998, 32, 31.8, 31.5999999999999, 31.3999999999999, 
31.1999999999998, 31, 30.8, 30.5999999999999, 30.3999999999999, 
30.1999999999998, 30, 29.8, 29.5999999999999, 29.3999999999999, 
29.1999999999998, 29, 28.8, 28.5999999999999, 28.3999999999999, 
28.1999999999998, 28, 27.8, 27.5999999999999, 27.3999999999999, 
27.1999999999998, 27, 26.8, 26.5999999999999, 26.3999999999999, 
26.1999999999998, 26, 25.8, 25.5999999999999, 25.3999999999999, 
25.1999999999998, 25, 24.8, 24.5999999999999, 24.3999999999999, 
24.1999999999998, 24, 23.8, 23.5999999999999, 23.3999999999999, 
23.1999999999998, 23, 22.8, 22.5999999999999, 22.3999999999999, 
22.1999999999998, 22, 21.8, 21.5999999999999, 21.3999999999999, 
21.1999999999998, 21, 20.8, 20.5999999999999, 20.3999999999999, 
20.1999999999998, 20, 19.8, 19.5999999999999, 19.3999999999999, 
19.1999999999998, 19, 18.8, 18.5999999999999, 18.3999999999999, 
18.1999999999998, 18, 17.8, 17.5999999999999, 17.3999999999999, 
17.1999999999998, 17, 16.8, 16.5999999999999, 16.3999999999999, 
16.1999999999998, 16, 15.8, 15.5999999999999, 15.3999999999999, 
15.1999999999998, 15, 14.8, 14.5999999999999, 14.3999999999999, 
14.1999999999998, 14, 13.8, 13.5999999999999, 13.3999999999999, 
13.1999999999998, 13, 12.8, 12.5999999999999, 12.3999999999999, 
12.1999999999998, 12, 11.8, 11.5999999999999, 11.3999999999999, 
11.1999999999998, 11, 10.8, 10.5999999999999, 10.3999999999999, 
10.1999999999998, 10, 9.79999999999995, 9.59999999999991, 9.39999999999986, 
9.19999999999982, 9, 8.79999999999995, 8.59999999999991, 8.39999999999986, 
8.19999999999982, 8, 7.79999999999995, 7.59999999999991, 7.39999999999986, 
7.19999999999982, 7, 6.79999999999995, 6.59999999999991, 6.39999999999986, 
6.19999999999982, 6, 5.79999999999995, 5.59999999999991, 5.39999999999986, 
5.19999999999982, 5, 4.79999999999995, 4.59999999999991, 4.39999999999986, 
4.19999999999982, 4, 3.79999999999995, 3.59999999999991, 3.39999999999986, 
3.19999999999982, 3, 2.79999999999995, 2.59999999999991, 2.39999999999986, 
2.19999999999982, 2, 1.79999999999995, 1.59999999999991, 1.39999999999986, 
1.19999999999982, 1, 0.799999999999955, 0.599999999999909, 0.399999999999864, 
0.199999999999818, 0, -0.200000000000045, -0.400000000000091, 
-0.600000000000136, -0.800000000000182, -1, -1.20000000000005, 
-1.40000000000009, -1.60000000000014, -1.80000000000018, -2, 
-2.20000000000005, -2.40000000000009, -2.60000000000014, -2.80000000000018, 
-3, -3.20000000000005, -3.40000000000009, -3.60000000000014, 
-3.80000000000018, -4, -4.20000000000005, -4.40000000000009, 
-4.60000000000014, -4.80000000000018, -5), y = c(35785, 34955.9, 
34448, 33632.6, 32905.1, 31976.5, 31332.4, 30851.3, 29547.2, 
29092, 28786.6, 28053.9, 27609.1, 27117.9, 26628.8, 26236.2, 
25997.6, 25248.5, 24876.7, 24697.4, 24745.8, 24403.1, 23935.2, 
23994.9, 23489, 23596, 23630.8, 23537, 23489.3, 23336.4, 23515.6, 
23373.7, 23191.3, 23455.6, 23510.1, 23653.3, 23574.3, 23504.9, 
23239.2, 22993.1, 23246.4, 23057.4, 22718.7, 22532.4, 22656.7, 
22362.9, 22184, 21929.7, 21511.1, 21579.2, 21692.3, 21839.3, 
21906.5, 22342, 22830.3, 23506.3, 24714.6, 26358.3, 28813.4, 
32087.4, 37048.2, 43795.1, 52583.3, 63510.6, 74687.6, 87307, 
98589.2, 109683, 123260, 143686, 173741, 206937, 225777, 213844, 
188426, 179882, 195311, 213540, 199136, 153434, 102167, 65320.5, 
43524.6, 31564.6, 24683.9, 20481.1, 17533.8, 15430.9, 13942.4, 
12742.8, 11795.2, 11032.4, 10758.8, 9999.94, 9620.13, 9242.19, 
8769.68, 8336.05, 7848.7, 7439.94, 7236.61, 6840.17, 6474.1, 
6314.83, 6119.46, 5984.71, 5838.92, 5482.56, 5592.16, 5479.21, 
5473.05, 5263.42, 5131.52, 5160.8, 5037.07, 5111.43, 4925.95, 
5044.38, 5073.06, 5163.09, 5395.14, 5685.84, 5781.48, 5927.53, 
5991.07, 5918.79, 6208.65, 6355.15, 6336.74, 6866.93, 6765.42, 
7010.48, 6975.84, 7173.03, 7208.73, 7167.87, 7150.69, 7066.63, 
6850.88, 6615.22, 6514.08, 6244.01, 6000.48, 5574.86, 5179.76, 
5093.81, 4797.62, 4561.38, 4378.95, 4480.99, 4454.68, 4528.07, 
4697.9, 4895.49, 5127.23, 5522.48, 5618.13, 5909.07, 6134.77, 
6444.93, 6347.01, 6890.34, 7092.59, 7232.97, 7125.42, 6986.75, 
6699.94, 6458.58, 6257.7, 6080.23, 5982.45, 5692.35, 5829.27, 
5843.41, 6057.06, 6181.98, 6516.04, 6597.08, 6776.47, 6912.55, 
7053.48, 7008.47, 7194.52, 7362.31, 7320.14, 7362.08, 7428.24, 
7096.13, 6704.73, 6217.18, 5835.08, 5424.88, 5640.08, 5687.38, 
5571.61, 5074.32, 4456.51, 3369.23, 2196.51, 1276.21, 756.717, 
484.31, 315.931, 265.893, 190.014, 161.302, 145.354, 126.608, 
90.857, 101.612, 76.3276, 84.7987, 83.5705, 77.3315, 53.2172, 
52.2799, 39.4456, 53.3765, 30.8025, 48.2821, 39.0606, 22.8557, 
34.3351, 25.2945, 25.4592, 21.7338)), .Names = c("x", "y"), class = "data.frame", row.names = c(NA, 
-226L))

解决方案

Here's an option using derivatives of a fitted spline function (smooth.spline - you may need to adjust the parameter spar to your case):

x <- seq(0,40)
y <- dnorm(seq(0,40), mean=25, sd=5)
plot(x, y)
spl <- smooth.spline(y ~ x)
lines(spl, col=2)

newx <- 20
pred0 <- predict(spl, x=newx, deriv=0)
pred1 <- predict(spl, x=newx, deriv=1)

yint <- pred0$y - (pred1$y*newx)
xint <- -yint/pred1$y
xint

The results visually:

plot(x, y)
abline(h=0, col=8)
lines(spl, col=2) # spline
points(pred0, col=2, pch=19) # point to predict tangent 
lines(x, yint + pred1$y*x, col=3) # tangent (1st deriv. of spline at newx)
points(xint, 0, col=3, pch=19) # x intercept

Update

Here is an example using your dataset (df):

# fit smooth spline
plot(y ~ x, df)
spl <- smooth.spline(df$x, df$y, spar=0.3)
newx <- seq(min(df$x), max(df$x), 0.1)
pred <- predict(spl, x=newx, deriv=0)
lines(pred, col=2)

# solve for tangent at a given x
newx <- 25
pred0 <- predict(spl, x=newx, deriv=0)
pred1 <- predict(spl, x=newx, deriv=1)
yint <- pred0$y - (pred1$y*newx)
xint <- -yint/pred1$y
xint

# plot results
plot(y ~ x, df)
abline(h=0, col=8)
lines(spl, col=2) # spline
points(pred0, col=2, pch=19) # point to predict tangent 
lines(x, yint + pred1$y*x, col=3) # tangent (1st deriv. of spline at newx)
points(xint, 0, col=3, pch=19) # x intercept

I'm not sure how much noise is in your data, but by using a smaller spar setting in smooth.spline, you can increase the detail of the fitted function.

这篇关于绘制一个切线，并使用R找到X截取的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！