Tarea 5. Splines cúbicos.

Ejercicio 1.

En cada inciso considera la función de valores reales, usa splines cúbicos para encontrar una aproximación en el intervalo dado. Calcula el valor de la función, de la derivada y en cada caso calcula el error real.

1. \(f(x)=e^{2x}\). Puntos: \(x_0=0, x_1=0.25, x_2=0.5, x_3=0.75\). Aproximar \(f(0.43)\) y \(f'(0.43)\).

  f_1a <- function(x){exp(2*x)}
  x1a <- seq(from=0, to=0.75, by=0.01)
  y1a <- f_1a(x1a)

  x_1n <- c(0, 0.25,0.5, 0.75)
  y_1n <- f_1a(x_1n)
  
  sp_1a <- cubicspline(x_1n,y_1n,x1a)

graf_1a <- ggplot()+
  geom_line(aes(x1a,y1a), color="red", size=1.5)+
  geom_point(aes(x_1n, y_1n), color="blue", size=3)+
  geom_line(aes(x1a,sp_1a), color="green", size=1)+
  theme_bw()
  
  
ggplotly(graf_1a)

Valor de la función en \(x=0.43\), $f(0.43)=´r f_1a(0.43)

Error

abs(f_1a(0.43)-cubicspline(x_1n, y_1n, 0.43))

## [1] 0.01580817

Derivada de la funcion \(f´(x)=2 e^(2x)\), evualuada en \(x=0.43\)

der <- function(x){2*exp(2*x)}
der(0.43)

## [1] 4.726321

Aproximar la derivada

der_poly <- polyder(cubicspline(x_1n, y_1n)$coef[2, 1:4])
der_poly

## [1] 17.472473  6.332867  3.122624

polyval(der_poly, 0.43)

## [1] 9.076417

2. \(f(x)=x\, log(x)\), \(x\in [2,12]\), \(h=2\). Aproximar \(f(8.4)\) y \(f'(8.4)\).

f_1b <- function(x){x*log(x)}
x1b <-seq(from=2, to=12, by=0.001)
y1b <- f_1b(x1b)

x_1n <- c(2,4,6,8,10,12)
y_1n <- f_1b(x_1n)
sp_1b <- cubicspline(x_1n, y_1n, x1b)

graf_1b <-ggplot()+
  geom_line(aes(x1b, y1b), color="darkorchid3", size=1)+
  geom_point(aes(x_1n, y_1n), color="darkmagenta", size=2)+
  geom_line(aes(x1b, sp_1b, color="deepskyblue4"))+
  theme_bw()

ggplotly(graf_1b)

f_1b(8.4)

## [1] 17.87715

cubicspline(x_1n, y_1n, 8.4)

## [1] 17.87406

abs(f_1b(8.4)-cubicspline(x_1n, y_1n, 8.4))

## [1] 0.003082143

log(8.4)+1

## [1] 3.128232

der_poly <- polyder(cubicspline(x_1n, y_1n) $coef[4,1:4])
der_poly

## [1] -0.0017025  0.1262611  3.0711682

polyval(der_poly, 8.4)

## [1] 4.011633

3. \(f(x)=sen(e^x-2)\), \(x\in [0,5]\), \(h=1\). Aproximar \(f(0.9)\) y \(f'(0.9)\).

f <- function(x){sin(exp(x)-2)}
x <-seq(from=0, to=5, by=0.001)
y <- f(x)

x_n <- c(0,1,2,3,4,5)
y_n <- f(x_n)
sp <- cubicspline(x_n, y_n, x)

graf <-ggplot()+
  geom_line(aes(x, y), color="darkorchid3", size=1)+
  geom_point(aes(x_n, y_n), color="darkmagenta", size=2)+
  geom_line(aes(x, sp, color="deepskyblue4"))+
  theme_bw()

ggplotly(graf)

f(0.9)

## [1] 0.4435924

cubicspline(x_n, y_n, 0.9)

## [1] 0.656121

abs(f(0.9)-cubicspline(x_n, y_n, 0.9))

## [1] 0.2125286

der_poly <- polyder(cubicspline(x_n, y_n) $coef[4,1:4])
der_poly

## [1] -1.995800  1.762175  1.199554

polyval(der_poly, 0.9)

## [1] 1.168914

4. \(f(x)=x\, cos\,x-2x^2+3x-1\). \(x\in [0,2]\), \(h=0.5\). Aproximar \(f(0.25)\) y \(f'(0.25)\).

f <- function(x){x*cos(x-2*x^2+3*x-1)}
x <-seq(from=0, to=2, by=0.001)
y <- f(x)

x_n <- c(0, 0.5, 1.1, 1.5, 1.777, 2)
y_n <- f(x_n)
sp <- cubicspline(x_n, y_n, x)

graf <-ggplot()+
  geom_line(aes(x, y), color="blue", size=1)+
  geom_point(aes(x_n, y_n), color="red", size=2)+
  geom_line(aes(x, sp, color="green"))+
  theme_bw()

ggplotly(graf)

abs(f(0.25)-cubicspline(x_n, y_n, 0.25))

## [1] 0.01602936

der_poly <- polyder(cubicspline(x_n, y_n) $coef[4,1:4])
der_poly

## [1] -56.062055   3.284535   2.504308

polyval(der_poly, 0.25)

## [1] -0.1784367

5. \(f(x)=x\,cos\,x-3x\). Puntos: \(x_0=0.1, x_1=0.2, x_2=0.3, x_3=0.4\). Aproximar \(f(0.18)\) y \(f'(0.18)\).

f <- function(x){x*cos(x)-3*x}
x <-seq(from=0, to=0.5, by=0.001)
y <- f(x)

x_n <- c(0.1, 0.2, 0.3, 0.4)
y_n <- f(x_n)
sp <- cubicspline(x_n, y_n, x)

graf <-ggplot()+
  geom_line(aes(x, y), color="blue", size=1)+
  geom_point(aes(x_n, y_n), color="red", size=2)+
  geom_line(aes(x, sp, color="green"))+
  theme_bw()

ggplotly(graf)

abs(f(0.18)-cubicspline(x_n, y_n, 0.18))

## [1] 9.434063e-05

der_poly <- polyder(cubicspline(x_n, y_n) $coef[1,2:4])
der_poly

## [1] -2.024913

polyval(der_poly, 0.18)

## [1] -2.024913

Ejercicio 2

Encuentra los splines cúbicos condicionados para las funciones del ejercicio anterior.

  f_1a <- function(x){exp(2*x)}
  x1a <- seq(from=0, to=0.75, by=0.01)
  y1a <- f_1a(x1a)
  der_f <- function(x){2*exp(2*x)}

  x_1n <- c(0, 0.25,0.5, 0.75)
  y_1n <- f_1a(x_1n)
  
  sp_1a <- cubicspline(x_1n,y_1n,x1a,endp2nd = TRUE, der = c(der_f(0), der_f(0.75)))

graf_1a <- ggplot()+
  geom_line(aes(x1a,y1a), color="red", size=1.5)+
  geom_point(aes(x_1n, y_1n), color="blue", size=3)+
  geom_line(aes(x1a,sp_1a), color="green", size=1)+
  theme_bw()
  
  
ggplotly(graf_1a)

f_1b <- function(x){x*log(x)}
x1b <-seq(from=2, to=12, by=0.001)
y1b <- f_1b(x1b)
der_f <- function(x){log(x)+1}

x_1n <- c(2,4,6,8,10,12)
y_1n <- f_1b(x_1n)
sp_1b <- cubicspline(x_1n, y_1n, x1b,endp2nd = TRUE, der = c(der_f(2), der_f(12)))

graf_1b <-ggplot()+
  geom_line(aes(x1b, y1b), color="darkorchid3", size=1)+
  geom_point(aes(x_1n, y_1n), color="darkmagenta", size=2)+
  geom_line(aes(x1b, sp_1b, color="deepskyblue4"))+
  theme_bw()

ggplotly(graf_1b)

f <- function(x){sin(exp(x)-2)}
x <-seq(from=0, to=5, by=0.001)
y <- f(x)
der_f <- function(x){cos(exp(x)-2)*exp(x)}

x_n <- c(0,1,2,3,4,5)
y_n <- f(x_n)
sp <- cubicspline(x_n, y_n, x, endp2nd = TRUE, der = c(der_f(0), der_f(5)))

graf <-ggplot()+
  geom_line(aes(x, y), color="darkorchid3", size=1)+
  geom_point(aes(x_n, y_n), color="darkmagenta", size=2)+
  geom_line(aes(x, sp, color="deepskyblue4"))+
  theme_bw()

ggplotly(graf)

f <- function(x){x*cos(x-2*x^2+3*x-1)}
x <-seq(from=0, to=2, by=0.001)
y <- f(x)
der_f <- function(x){cos(-2*x^2+4*x-1)-x*sin(-2*x^2+4*x-1)*(-4*x+4)}
x_n <- c(0, 0.5, 1.1, 1.5, 1.777, 2)
y_n <- f(x_n)
sp <- cubicspline(x_n, y_n, x, endp2nd = TRUE, der = c(der_f(0), der_f(2)))

graf <-ggplot()+
  geom_line(aes(x, y), color="blue", size=1)+
  geom_point(aes(x_n, y_n), color="red", size=2)+
  geom_line(aes(x, sp, color="green"))+
  theme_bw()

ggplotly(graf)

f <- function(x){x*cos(x)-3*x}
x <-seq(from=0, to=0.5, by=0.001)
y <- f(x)
der_f <- function(x){cos(x)-x*sin(x)-3}

x_n <- c(0.1, 0.2, 0.3, 0.4)
y_n <- f(x_n)
sp <- cubicspline(x_n, y_n, x, endp2nd = TRUE, der = c(der_f(0), der_f(0.5)))

graf <-ggplot()+
  geom_line(aes(x, y), color="blue", size=1)+
  geom_point(aes(x_n, y_n), color="red", size=2)+
  geom_line(aes(x, sp, color="green"))+
  theme_bw()

ggplotly(graf)

Ejercicio 3

Se sospecha que las elevadas concentraciones de tanina en las hojas de los robles maduros inhiben el crecimiento de las larvas de la polilla invernal (Operophtera bromata L. Geometridae) que tanto dañan a los árboles en algunos años. La tabla anexa contiene el peso promedio de dos muestras de larva, tomadas en los primeros 28 días después de nacimiento. La primera muestra se crió en hojas de robles jóvenes, mientras que la segunda lo hizo en hojas maduras del mismo árbol.

1. Usa splines cúbicos para aproximar la curva del peso promedio de las muestras.

\[\begin{equation} \begin{array}{l|c|c|c|c|c|c|r} \text{Día} & 0 & 6 & 10 & 13 & 17 & 20 & 28 \\ \hline \text{Peso promedio muestra 1 (mg)} & 6.67 & 17.33 & 42.67 & 37.33 & 30.10 & 29.31 & 28.74 \\ \text{Peso promedio muestra 2 (mg)} & 6.67 & 16.11 & 18.89 & 15.00 & 10.56 & 9.44 & 8.89 \end{array} \end{equation}\]

dias <- c(0,6,10,13,17,20,28)
dias_seq <- seq(0,28,0.01)

muestra1 <- c(6.67,17.33,42.67,37.33,30.10,29.31, 28.74)
sp1 <- cubicspline(dias, muestra1, dias_seq)

muestra2 <- c(6.67,16.11,18.89,15.00,10.56,9.44,8.89)
sp2 <- cubicspline(dias, muestra2, dias_seq)

graf <- ggplot()+
  geom_line(aes(dias_seq,sp1), color="firebrick", size=1.2)+
  geom_point(aes(dias, muestra1), color="blue", size=4)+
  geom_line(aes(dias_seq,sp2), color="green", size=1.2)+
  geom_point(aes(dias, muestra2), color="blue", size=4)+
  theme_bw()
ggplotly(graf)

2. Para calcular un peso promedio máximo aproximado de cada muestra, determina el máximo del polinomio interpolante.

poly.calc(dias, muestra1)

## 6.67 - 42.64348*x + 16.14272*x^2 - 2.094639*x^3 + 0.1269024*x^4 -  
## 0.003671679*x^5 + 4.094576e-05*x^6

a <- expression(6.67 - 42.64348*x + 16.14272*x^2 - 2.094639*x^3 +  
0.1269024*x^4 - 0.003671679*x^5 + 4.094576e-05*x^6)

D(a,"x")

## 16.14272 * (2 * x) - 42.64348 - 2.094639 * (3 * x^2) + 0.1269024 * 
##     (4 * x^3) - 0.003671679 * (5 * x^4) + 4.094576e-05 * (6 * 
##     x^5)

deri_pol <- function(x){16.14272 * (2 * x) - 42.64348 - 2.094639 * (3 * x^2) + 0.1269024 * 
    (4 * x^3) - 0.003671679 * (5 * x^4) + 4.094576e-05 * (6 * 
    x^5)}

muestra_seq <- deri_pol(dias_seq)

graf <- ggplot()+
  geom_line(aes(x=dias_seq,y=muestra_seq), color="red", size=1)+
  theme_bw()
ggplotly(graf)

Ejercicio 4

Construye los splines cúbicos con \(n\) nodos, donde \(n=3,4\) para las siguientes funciones en el intervalo dado.

1. \(f(x) = e^{2x}\, cos 3x\), \([0,2]\).

f <- function(x){exp(2*x)*cos(3*x)}
x <-seq(from=0, to=2, by=0.001)
y <- f(x)

x_n <- c(0.5,1,1.5,2)
y_n <- f(x_n)
sp <- cubicspline(x_n, y_n, x)

graf <-ggplot()+
  geom_line(aes(x, y), color="blue", size=1)+
  geom_point(aes(x_n, y_n), color="red", size=2)+
  geom_line(aes(x, sp, color="green"))+
  theme_bw()

ggplotly(graf)

2. \(f(x) = sen(log\,x)\), \([1,3]\).

f <- function(x){sin(log(x))}
x <-seq(from=1, to=3, by=0.001)
y <- f(x)

x_n <- c(1,1.5,2,3)
y_n <- f(x_n)
sp <- cubicspline(x_n, y_n, x)

graf <-ggplot()+
  geom_line(aes(x, y), color="blue", size=1)+
  geom_point(aes(x_n, y_n), color="red", size=2)+
  geom_line(aes(x, sp, color="green"))+
  theme_bw()

ggplotly(graf)

3. \(f(x) = e^{x}+e^{-x}\), \([0,2]\).

f <- function(x){exp(x)+exp(-x)}
x <-seq(from=0, to=2, by=0.001)
y <- f(x)

x_n <- c(0.5,1,1.5,2)
y_n <- f(x_n)
sp <- cubicspline(x_n, y_n, x)

graf <-ggplot()+
  geom_line(aes(x, y), color="blue", size=1)+
  geom_point(aes(x_n, y_n), color="red", size=2)+
  geom_line(aes(x, sp, color="green"))+
  theme_bw()

ggplotly(graf)

4. \(f(x) = cos \,x+sen\,x\), \([0,2\pi]\).

f <- function(x){cos(x)+sin(x)}
x <-seq(from=0, to=2*pi, by=0.001)
y <- f(x)

x_n <- c(0.86,2.22,4,2*pi)
y_n <- f(x_n)
sp <- cubicspline(x_n, y_n, x)

graf <-ggplot()+
  geom_line(aes(x, y), color="blue", size=1)+
  geom_point(aes(x_n, y_n), color="red", size=2)+
  geom_line(aes(x, sp, color="green"))+
  theme_bw()

ggplotly(graf)

Ejercicio 5

Dada la partición \(x_0=0, x_1=0.5, x_2=1\), del intervalo \([0,1]\), encuentra el spline cúbico \(S\) para \(f(x)=e^{2x}\). Aproxima \(\int_0^{1} e^{2x}\,dx\) con \(\int_0^{1} S(x)\,dx\) y compara el resultado con el valor real.

f <- function(x)(exp(2*x))
x <- seq(from= 0 , to= 1, by=0.001)
y <- f(x)

x_n <- c(0,0.25,0.5,0.75,1)
y_n <- f(x_n)

sp <- cubicspline(x_n, y_n, x)

graf <- ggplot()+
  geom_line(aes(x, y), color="gold", size=1)+
  geom_point(aes(x_n, y_n), color= "green", size=2)+
  geom_line(aes(x, sp), color="firebrick", size=.5)+
  geom_area(aes(x,y), fill= "goldenrod1", alpha=0.5)+
  theme_bw()

ggplotly(graf)

La integral de la funcion

pracma::integral(f, 0, 1)

## [1] 3.194528

f <- function(x){10*x}
x <- seq(0,10, 0.01)
y <- f(x)
Ind <- c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
Pa_i <- seq(0, 10, 0.01)

muestra_01 <- c(0,1.7555, 4.809, 8.876, 13.939, 20.133, 27.621, 36.742, 48.217, 63.703, 100)
esp_1 <- cubicspline(Ind, muestra_01, Pa_i)

poli <- function(x){-0.01345675*x + 3.650994*x^2 - 3.284836*x^3 + 2.004359*x^4 - 0.7590045*x^5 + 0.182996*x^6-0.02806328*x^7+0.002647586*x^8-0.0001399609*x^9+3.171572e-06*x^10}
police <- poli(x)

graf_12 <- ggplot()+
  geom_line(aes(Pa_i, esp_1 ), color="red", size=2)+
  geom_point(aes(Ind,muestra_01), color="green", size=2)+
  geom_line(aes(x,y), color="firebrick", size=1)+
  geom_line(aes(x,police), color="pink", size=2)+
  theme_bw()

ggplotly(graf_12)

poly.calc(Ind,muestra_01)

## -0.01345675*x + 3.650994*x^2 - 3.284836*x^3 + 2.004359*x^4 - 0.7590045*x^5 +  
## 0.182996*x^6 - 0.02806328*x^7 + 0.002647586*x^8 - 0.0001399609*x^9 +  
## 3.171572e-06*x^10

f <- function(x){10*x}
x <- seq(0,10, 0.01)
y <- f(x)
Ind <- c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
Pa_i <- seq(0, 10, 0.01)

muestra_01 <- c(0,  1.3,    3.1,    5.2,    7.9,    10.8,   15, 29.3,   47.8,   70.4,   100)
esp_1 <- cubicspline(Ind, muestra_01, Pa_i)

poli <- function(x){57.45294*x-157.3059*x^2 + 176.6409*x^3-106.1994*x^4+38.18407*x^5 - 8.589284*x^6+1.217*x^7-0.1053332*x^8 +  
0.005079503*x^9-0.0001044698*x^10}
police <- poli(x)

graf_12 <- ggplot()+
  geom_line(aes(Pa_i, esp_1 ), color="red", size=2)+
  geom_point(aes(Ind,muestra_01), color="green", size=2)+
  geom_line(aes(x,y), color="firebrick", size=1)+
  geom_line(aes(x,police), color="pink", size=2)+
  theme_bw()

ggplotly(graf_12)

poly.calc(Ind,muestra_01)

## 57.45294*x - 157.3059*x^2 + 176.6409*x^3 - 106.1994*x^4 + 38.18407*x^5 -  
## 8.589284*x^6 + 1.217*x^7 - 0.1053332*x^8 + 0.005079503*x^9 - 0.0001044698*x^10

f <- function(x){10*x}
x <- seq(0,10, 0.01)
y <- f(x)
Ind <- c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
Pa_i <- seq(0, 10, 0.01)

muestra_01 <- c(0,2,5.3,9.8,15.2,21.9,29.8, 39.5,51.6,67.5,100)
esp_1 <- cubicspline(Ind, muestra_01, Pa_i)

poli <- function(x){7.402857*x - 15.43562*x^2 + 16.87632*x^3 -  
9.373174*x^4 + 3.088446*x^5 -  
0.6347159*x^6 + 0.08209077*x^7 -  
0.006482308*x^8 + 0.0002848049*x^9 -  
5.318563e-06*x^10}
police <- poli(x)

graf_12 <- ggplot()+
  geom_line(aes(Pa_i, esp_1 ), color="red", size=2)+
  geom_point(aes(Ind,muestra_01), color="green", size=2)+
  geom_line(aes(x,y), color="firebrick", size=1)+
  geom_line(aes(x,police), color="pink", size=2)+
  theme_bw()

ggplotly(graf_12)

poly.calc(Ind,muestra_01)

## 7.402857*x - 15.43562*x^2 + 16.87632*x^3 - 9.373174*x^4 + 3.088446*x^5 -  
## 0.6347159*x^6 + 0.08209077*x^7 - 0.006482308*x^8 + 0.0002848049*x^9 -  
## 5.318563e-06*x^10