R - графика пересечения линий

Question

Я сомневаюсь в этом, но, честно говоря, я не знаю, действительно ли решение существует в R.

У меня есть график x / y, и я хочу нарисовать две прямые линии (1) от оси x к данным и еще одну (2) от оси y к данным. Строка 1, у меня есть значение этого, будет тертилом моих данных. Вопрос в том, как найти точную точку, в которой линия пересекает заданное, и построить график, следуя оси Y?

Я уже пытался по позиции оси x использовать ту же позицию для y. Это работает даже для некоторых данных, но не для всех (так как значения не всегда совпадают).

Вот мой пример

 ob<-c(77.89824, 170.36929, 90.88129, 141.22368, 174.07871,
 106.51393, 94.32576, 85.31712, 78.95808, 222.30143, 115.25760,
 85.84704, 165.33504, 72.06912, 38.94912, 90.88129, 167.18976, 
 125.85600, 141.22367, 104.65922, 131.95009, 81.07777, 
 64.12032,130.36032, 89.29152, 65.97504, 40.27392, 64.38529, 
 113.40288)

 tm<-c(38.94912, 40.27392, 64.12032, 64.38529, 65.97504, 72.06912,
 77.89824, 78.95808, 81.07777, 85.31712, 85.84704, 89.29152, 
 90.88129, 94.32576, 104.65922, 106.51393, 113.40288, 115.25760, 
 125.85600, 130.36032, 131.95009, 141.22367, 141.22368, 165.33504, 
 167.18976, 170.36929, 174.07871)    

 bs<-c(0.96523390, 0.93066061, 0.89634466, 0.86213300, 0.82769878,
 0.79311455, 0.75831596, 0.72311471, 0.68800759, 0.65245482, 
 0.61700818, 0.58163643, 0.51021060, 0.47393336, 0.43788203, 
 0.40203755, 0.36614804, 0.33059801, 0.29408090, 0.25820874, 
 0.22265365, 0.18803136, 0.15444785, 0.11931985, 0.08411248, 
 0.05098459, 0.01957279)

 prc<-c(0.956974397, 0.914559074, 0.872836231, 0.831624652, 
 0.790544222, 0.749700646, 0.709038330, 0.668364230, 0.628275180, 
 0.588180704, 0.548730882, 0.509909531, 0.433282681, 0.395329802, 
 0.358306283, 0.322222487, 0.286868665, 0.252670119, 0.218461386, 
 0.185847964, 0.154593177, 0.125303855, 0.098121311, 0.071199383, 
 0.046104574, 0.024746731, 0.007529233) 

 plot(tm,bs,type="l",col="red")
 lines(tm,prc,col="black")

 tinf<-quantile(ob,prob=1/3)
 tsup<-quantile(ob,prob=2/3)

 idxinf<-which(tm>=(tinf-5) & tm<=(tinf+5))
 infgrafico<-mean(prc[idxinf])
 idxsup<-which(tm>=(tsup-5) & tm<=(tsup+5))
 supgrafico<-mean(prc[idxsup])

 segments(tinf,0.03, tinf,infgrafico,col='black',lty=3,lwd=1)
 segments(min(tm),infgrafico, 
 tinf,infgrafico,col='black',lty=3,lwd=1)
 text(tinf,cex=1,y=0,col="black",font=2,"T1")
 segments(tsup,0.03, tsup,supgrafico,col='black',lty=3,lwd=1)
 segments(min(tm),supgrafico, 
 tsup,supgrafico,col='black',lty=3,lwd=1)
 text(tsup,cex=1,y=0,col="black",font=2,"T2") 

Но это так, иногда значения не соответствуют и не обнаруживаются, в результате чего прямые значения не пересекаются в значении данных. И да, мне нужно что-то более автоматизированное, насколько это возможно, так как я должен сохранить эти значения в таблице и не смог бы сделать это вручную / методом проб и ошибок по одному.

Спасибо!

ИЗД. ПОСЛЕ ОДНОГО ОТВЕТА

TavoGLC или кто хочет, вы можете помочь еще раз подумать? У меня проблемы с некоторыми данными.

tm <-c (54.05184, 67.29985, 70.86991, 78.42816, 80.84780, 80.54784, 80.81280, 81.8774, 89.82144, 89.82144, 90.81314, 90.35136, 92.20607, 92.47104, 97.50528, 97.77025, 99.09504, 99.88993, 100.41985, 100.94976, 101.74465, 102.27456, 105.45408 , 105.71905, 116.05248, 118.43713, 122.94144, 125.06112, NA)

prc <-c (0.9454304, 0.9604309, 0.9604309, 0.9608306, 0.9608306, 0.9608309, 0.9608309, 0.9608309, 0.9604309, 0.9605930, , 0.4163839, 0.3624935, 0.3041409, 0.2327866, 0.1079731, NA)

tercil <-89.821

plot (tm, prc, type = "l")
abline (v = 89.821, col = "red")

Учитывая, что строка ('' abline (h = ...) '') имеет очень большой диапазон расположения, когда я делаю процедуру "MakeLineCoords", получая значения "2.627424", не соглашаясь с мои данные (макс = 1). У меня есть ряд данных tm и prc [360,181,29], этот пример выше является одной из ошибок, которые я вырезал. Но если вы хотите, я могу отправить вам полные данные испытаний.

Это приспособление, которое я сделал для работы здесь.

yTinf = array (NA, c (360,181,29))
xTinf = array (NA, c (360,181,29))
   for (i in 1: 360) {
   for (j in 1: 181)
   for (k in 1:29)
      yTinf [i, j, k] <- tercil [i, j, k]
      xTinf [i, j, k] <- MakeLineCoords (prc [i, j,], tm [i, j,], yTinf [i, j, k])
}}}

Несмотря на это, он представляет некоторые значения, превышающие 1, и некоторые экстраполированные, порядка 2000 и 3000. Что из того, что я понял, было бы связано с вышеуказанной проблемой, где xTinf содержит некоторые правильные значения.

Спасибо большое!

Answer 1

Вам просто нужно создать функцию, которая находит ближайшую точку в данных и выполняет интерполяцию из этой точки.

MakeLineCoords <- function(Xvals,Yvals,targetPoint) {
  x <- vector(mode="numeric", length=length(Yvals))
  for(k in 1:length(Xvals)){
    x[k]<-(Yvals[k]-targetPoint)^2
   }
  mL=which.min(x)
  xVal=Xvals[mL]+(targetPoint-Yvals[mL])*((Xvals[mL+1]-Xvals[mL])/(Yvals[mL+1]-Yvals[mL]))
  return(xVal)
  }

Затем вы можете определить целевое значение, которое нужно найти, и создать координаты длялинии на графике.

yTarget<-0.25
xTarget<-MakeLineCoords(tm,bs,yTarget)

plot(tm,bs,type="l",col="red")
segments(xTarget,0.0,xTarget,yTarget,col='black',lty=3,lwd=1)
segments(min(tm),yTarget,xTarget,yTarget,col='black',lty=3,lwd=1)

Используя данные вашего примера, я получаю следующее.Надеюсь, это поможет

tinf<-quantile(ob,prob=1/3)
yTarget<-tinf
xTarget<-MakeLineCoords(bs,tm,yTarget)
plot(tm,bs,type="l",col="red")
segments(yTarget,0.0,yTarget,xTarget,col='black',lty=3,lwd=1)
segments(min(tm),xTarget,yTarget,xTarget,col='black',lty=3,lwd=1)