Как я могу построить касательную линию в R?

Question

Привет, ребята!

Мне нужна помощь, чтобы создать картинку выше. У меня есть следующий код (синяя линия):

bondprc <- function(p, r, ttm, y){
  cf <- c(rep(p * r, ttm - 1), p * (1 + r))
  cf <- data.frame(cf)
  cf$t <- as.numeric(rownames(cf))
  cf$pv_factor <- 1 / (1 + y)^cf$t
  cf$pv <- cf$cf * cf$pv_factor
  sum(cf$pv)
}

prc_yld <- seq(0.02, 0.4, 0.01)

# Convert to data frame
prc_yld <- data.frame(prc_yld)

# Calculate bond price given different yields
for (i in 1:nrow(prc_yld)) {
  prc_yld$price[i] <- bondprc(100, 0.10, 20, prc_yld$prc_yld[i])  
}

# Plot P/YTM relationship
library(ggplot2)

ggplot(prc_yld, aes(x=prc_yld, y = price)) + geom_line() + labs(title ="Price/YTM Relationship",x="Yield", y= "Value")

Я пытался вычислить касательную линию вручную, но на самом деле это не работает.

## tangent 

Slope <- c(0,apply(prc_yld, 2, diff)[,2]) 
prc_yld <- cbind(prc_yld, Slope) 
prc_yld
## tangent: t(x) = m* x + n 
## Assume x = 0.1 --> y= 100, m = -9.12854
n <-  100 + 9.12854 * 0.1 
tangent <- function(x){
  -9.12854 * x +n 
}

ggplot(data.frame(x =c(0,0.4)), aes(x=x)) + stat_function(fun = tangent)

Я также не знаю, как закрасить область между кривыми. Спасибо за любую помощь!

Answer 1

Ключ здесь - сначала правильно рассчитать наклон и точку пересечения, а затем использовать geom_ribbon и geom_abline. Поэтому, если вы хотите sh вычислить наклон в 0,1, я предлагаю вам рассчитать соотношение между шагом y и шагом x в интервале x = 0,9 и x = 0,11, то есть:

xincrement <- 0.02
yincrement <- prc_yld[10, 2] - prc_yld[8, 2]
slope <- yincrement/xincrement

Тогда перехват:

intercept <- 100-slope*0.1

С этими значениями мы можем вычислить y значения касательной линии:

yvalues <- slope*prc_yld$prc_yld + intercept

Теперь, давайте объединим все вместе:

 prc_yld <- as.data.frame(cbind(prc_yld, yvalues))

Теперь сюжет:

ggplot(prc_yld, aes(x=prc_yld, y = price)) + 
    geom_ribbon(data = prc_yld, aes(x = prc_yld, ymax = price, ymin = yvalues), fill = "green") +
      geom_line(color = "red", size = 1) + 
      labs(title ="Price/YTM Relationship",x="Yield", y= "Value") + 
      geom_abline(slope = slope, intercept = intercept, color = "blue", size = 1)