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)\).

#Función
f_1a <- function(x){exp(2*x)}
x1a <- seq(0, 0.75, 0.001)
y1a <- f_1a(x1a)

#Nodos
x_1an <- c(0, 0.25, 0.5, 0.75)
y_1an <- f_1a(x_1an)

#Spline cúbico
sp_1a <- cubicspline(x_1an, y_1an, x1a)

graf_1a <- ggplot()+
  geom_line(aes(x1a, y1a), color="purple", size=1)+
  geom_point(aes(x_1an, y_1an), color="red", size=3)+
  #Este es el spline cúbico, y básciamente es la aproximación de esta función
  geom_line(aes(x1a, sp_1a), color="blue", size=1)+
  theme_bw()

ggplotly(graf_1a)

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(2, 12, 0.001)
y1b <- f_1b(x1b)

x_1bn <- c(2, 4, 6, 8, 10, 12)
y_1bn <- f_1b(x_1bn)

sp_1b <- cubicspline(x_1bn, y_1bn, x1b)

graf_1b <- ggplot()+
  geom_line(aes(x1b, y1b), color="black", size=1)+
  geom_point(aes(x_1bn, y_1bn), color="pink", size=3)+
 
  geom_line(aes(x1b, sp_1b), color="purple", size=1)+
  theme_bw()

ggplotly(graf_1b)

cubicspline(x_1bn, y_1bn, 8.4)

## [1] 17.87406

Error absoluto:

abs(f_1b(8.4)-cubicspline(x_1bn, y_1bn, 8.4))

## [1] 0.003082143

Derivada de la función f´(x)=log(x)+1, evaluada en x=8.4

df_1b <- function(x){log(x)+1}
log(8.4)+1

## [1] 3.128232

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

f_1c <- function(x){sin(exp(x)-2)}
x1c <- seq(0, 5, 0.001)
y1c <- f_1c(x1c)

x_1cn <- c(0, 1, 2, 3, 4, 5)
y_1cn <- f_1c(x_1cn)

sp_1c <- cubicspline(x_1cn, y_1cn, x1c)

graf_1c <- ggplot()+
  geom_line(aes(x1c, y1c), color="blue", size=1)+
  geom_point(aes(x_1cn, y_1cn), color="green", size=3)+
  
  geom_line(aes(x1c, sp_1c), color="red", size=1)+
  theme_bw()

ggplotly(graf_1c)

Valor de la función en x=0.9, f(0.9)=0.4435924

cubicspline(x_1cn, y_1cn, 0.9)

## [1] 0.656121

Error absoluto:

abs(f_1c(0.9)-cubicspline(x_1cn, y_1cn, 0.9))

## [1] 0.2125286

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_1d <- function(x){x*cos(x)-2*x^2+3*x-1}
x1d <- seq(0, 2, 0.001)
y1d <- f_1d(x1d)

x_1dn <- c(0, 0.5, 1, 1.5, 2)
y_1dn <- f_1d(x_1dn)

sp_1d <- cubicspline(x_1dn, y_1dn, x1d)

graf_1d <- ggplot()+
  geom_line(aes(x1d, y1d), color="pink", size=1)+
  geom_point(aes(x_1dn, y_1dn), color="blue", size=3)+
  
  geom_line(aes(x1d, sp_1d), color="red", size=1)+
  theme_bw()

ggplotly(graf_1d)

Valor de la función en x=0.25, f(0.25)=−0.1327719

cubicspline(x_1dn, y_1dn, 0.25)

## [1] -0.1773416

Error absoluto:

abs(f_1d(0.25)-cubicspline(x_1dn, y_1dn, 0.25))

## [1] 0.04456967

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_1e <- function(x){x*cos(x)-3*x}
x1e <- seq(0, 0.4, 0.001)
y1e <- f_1e(x1e)

x_1en <- c(0, 0.1, 0.2, 0.3, 0.4)
y_1en <- f_1e(x_1en)

sp_1e <- cubicspline(x_1en, y_1en, x1e)

graf_1e <- ggplot()+
  geom_line(aes(x1e, y1e), color="grey", size=1)+
  geom_point(aes(x_1en, y_1en), color="purple", size=3)+
  
  geom_line(aes(x1e, sp_1e), color="yellow", size=1)+
  theme_bw()

ggplotly(graf_1e)

Valor de la función en x=0.18, f(0.18)=−0.3629081

cubicspline(x_1en, y_1en, 0.18)

## [1] -0.362941

Error absoluto:

abs(f_1e(0.18)-cubicspline(x_1en, y_1en, 0.18))

## [1] 3.28817e-05

Ejercicio 2

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

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

x_1bn <- c(2, 4, 6, 8, 10, 12)
y_1bn <- f_1b(x_1bn)

sp_2b <- cubicspline(x_1bn, y_1bn, x1b, endp2nd = TRUE, der=c(df_1b(2), df_1b(12)))

graf_2b <- ggplot()+
  geom_line(aes(x1b, y1b), color="blue", size=1)+
  geom_point(aes(x_1bn, y_1bn), color="black", size=3)+
 
  geom_line(aes(x1b, sp_2b), color="purple", size=1)+
  theme_bw()

ggplotly(graf_2b)

2.b

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

x_1bn <- c(2, 4, 6, 8, 10, 12)
y_1bn <- f_1b(x_1bn)

sp_2b <- cubicspline(x_1bn, y_1bn, x1b, endp2nd = TRUE, der=c(df_1b(2), df_1b(12)))

graf_2b <- ggplot()+
  geom_line(aes(x1b, y1b), color="pink", size=1)+
  geom_point(aes(x_1bn, y_1bn), color="brown", size=3)+
 
  geom_line(aes(x1b, sp_2b), color="red", size=1)+
  theme_bw()

ggplotly(graf_2b)

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.

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

muestra1 <- c(6.67, 17.33, 42.67, 37.33, 30.10, 29.31, 28.74)
pol_muestra1 <- as.function(poly.calc(dias, muestra1))
muestra_seq <- pol_muestra1(dias_seq)

muestra2 <- c(6.67, 16.11, 18.89, 15.00, 10.56, 9.44, 8.89)
pol_muestra2 <- as.function(poly.calc(dias, muestra2))
muestra_seq2 <- pol_muestra2(dias_seq)

graf_2 <- ggplot()+
  geom_vline(xintercept = 0, linetype="dashed")+
  geom_hline(yintercept = 0, linetype="dashed")+
  #Muestra 1
  geom_line(aes(x=dias_seq, y=muestra_seq), color="pink", size=1)+
  geom_point(aes(x=dias, y=muestra1), color="yellow", size=3)+
  #Muestra 2
  geom_line(aes(x=dias_seq, y=muestra_seq2), color="blue", size=1)+
  geom_point(aes(x=dias, y=muestra2), color="purple", size=3)+
  
  labs(x="dias", y="Peso Muestra", title="Grafica 3a)")+
  theme_bw()

ggplotly(graf_2)

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

La muestra 1 se representa con linea rosa y la muestra 2 de color azul.

1. Para calcular el peso maximo de la primer muestra necesitamos derivar el polinomio interpolante para obtenersu pendiente.

#Solicitamos a R que nos muestre el polinomio que describe el comportamiento de la muestra 1
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

## 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

deri_pol1 <- function(x){-42.64348+2*16.14272*x-3*2.094639*x^2+4*0.1269024*x^3-5*0.003671679*x^4+6*4.094576e-05*x^5}
x1 <- seq(0,28,0.01)
y1 <- deri_pol1(dias_seq)

graf_muestra_1 <- ggplot()+
  #Ejes
  geom_vline(xintercept = 0, linetype="dashed")+
  geom_hline(yintercept = 0, linetype="dashed")+
  
    #Pendiente
    geom_line(aes(x1, y1), color="black", size=1)+
  
  labs(x="dias", y="Peso Muestra", title="Pendiente de la muestra 1")+
  theme_bw()
ggplotly(graf_muestra_1)

2. Calcular el punto maximo usando el metodo de la secante para encontrar la raiz de la derivada.

secant(deri_pol1, 9, 11)

## $root
## [1] 10.18858
## 
## $f.root
## [1] 2.345633e-09
## 
## $iter
## [1] 5
## 
## $estim.prec
## [1] 1.180142e-05

3. Encontrar la imagen del valor en la funcion que describe el peso de la muestra 1 para obtener el peso maximo.

pol_muestra1(10.18858)

## [1] 42.70842

El peso maximo de la muestra 1 ocurre en el dia 10.18858 y en el que la muestra alcanza un peso maximo de 42.70842

4. Peso maximo de muestra 2

#Solicitamos a R que nos muestre el polinomio que describe el comportamiento de la muestra 2
poly.calc(dias, muestra2)

## 6.67 - 5.678207*x + 2.912809*x^2 - 0.4137987*x^3 + 0.02584128*x^4 -  
## 0.0007525462*x^5 + 8.361598e-06*x^6

deri_pol2 <- function(x){-5.678207 + 2*2.912809*x - 3*0.4137987*x^2 + 4*0.02584128*x^3 - 5*0.0007525462*x^4 +6*8.361598e-06*x^5}
x2 <- seq(0,28,0.01)
y2 <- deri_pol2(dias_seq)

graf_muestra_2 <- ggplot()+
  #Ejes
  geom_vline(xintercept = 0, linetype="dashed")+
  geom_hline(yintercept = 0, linetype="dashed")+
  
    #Pendiente
    geom_line(aes(x2, y2), color="pink", size=1)+
  
  labs(x="dias", y="Peso Muestra", title="Pendiente de la muestra 2")+
  theme_bw()
ggplotly(graf_muestra_2)

5. Punto maximo por el metodo de la secante

secant(deri_pol2, 7, 9)

## $root
## [1] 8.769426
## 
## $f.root
## [1] -1.309113e-10
## 
## $iter
## [1] 4
## 
## $estim.prec
## [1] 4.446447e-06

6. Imagen del valor en la funcion que describe el peso de la muestra 2 para obtener el peso maximo

pol_muestra2(8.769426)

## [1] 19.41575

El peso maximo de la muestra 2 ocurre en el dia 8.769426 en donde se alcanza un peso maximo de 19.41575

\[\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}\]

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]\).

#Función
f_4a <- function(x){exp(2*x)*cos(3*x)}
x4a <- seq(0, 2, 0.001)
y4a <- f_4a(x4a)

#Nodos
x_4an <- c(0, 1, 1.5, 2)
y_4an <- f_4a(x_4an)

#Spline cúbico
sp_4a <- cubicspline(x_4an, y_4an, x4a)

graf_4a <- ggplot()+
  geom_line(aes(x4a, y4a), color="brown", size=1)+
  geom_point(aes(x_4an, y_4an), color="green", size=3)+
  #Este es el spline cúbico, y básciamente es la aproximación de esta función
  geom_line(aes(x4a, sp_4a), color="orange", size=1)+
  theme_bw()

ggplotly(graf_4a)

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

#Función
f_4b <- function(x){sin(log(x))}
x4b <- seq(1, 3, 0.01)
y4b <- f_4b(x4b)

#Nodos
x_4bn <- c(1, 2, 3)
y_4bn <- f_4b(x_4bn)

#Spline cúbico
sp_4b <- cubicspline(x_4bn, y_4bn, x4b)

graf_4b <- ggplot()+
  geom_line(aes(x4b, y4b), color="pink", size=1)+
  geom_point(aes(x_4bn, y_4bn), color="yellow", size=3)+
  #Este es el spline cúbico, y básciamente es la aproximación de esta función
  geom_line(aes(x4b, sp_4b), color="purple", size=1)+
  theme_bw()

ggplotly(graf_4b)

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

#Función
f_4c <- function(x){exp(x)+exp(-x)}
x4c <- seq(0, 2, 0.01)
y4c <- f_4c(x4c)

#Nodos
x_4cn <- c(0, 2/3, 4/3, 2)
y_4cn <- f_4c(x_4cn)

#Spline cúbico
sp_4c <- cubicspline(x_4cn, y_4cn, x4c)

graf_4c <- ggplot()+
  geom_line(aes(x4c, y4c), color="green", size=1)+
  geom_point(aes(x_4cn, y_4cn), color="blue", size=3)+
  #Este es el spline cúbico, y básciamente es la aproximación de esta función
  geom_line(aes(x4c, sp_4c), color="red", size=1)+
  theme_bw()

ggplotly(graf_4c)

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

#Función
f_4d <- function(x){cos(x)+sin(x)}
x4d <- seq(0, 2*pi, 0.001)
y4d <- f_4d(x4d)

#Nodos
x_4dn <- c(0, (1/3)*pi, (4/3)*pi, 2*pi)
y_4dn <- f_4d(x_4dn)

#Spline cúbico
sp_4d <- cubicspline(x_4dn, y_4dn, x4d)

graf_4d <- ggplot()+
  geom_line(aes(x4d, y4d), color="pink", size=1)+
  geom_point(aes(x_4dn, y_4dn), color="purple", size=3)+
  #Este es el spline cúbico, y básciamente es la aproximación de esta función
  geom_line(aes(x4d, sp_4d), color="yellow", size=1)+
  theme_bw()

ggplotly(graf_4d)

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.

#Función
f_5 <- function(x){exp(2*x)}
x5 <- seq(0, 0.75, 0.01)
y5 <- f_5(x5)

#Nodos
x_5n <- c(0, 0.25, 0.50, 0.75)
y_5n <- f_5(x_5n)

#Spline cúbico
sp_5 <- cubicspline(x_5n, y_5n, x5)

graf_5 <- ggplot()+
  geom_line(aes(x5, y5), color="brown", size=1)+
  geom_point(aes(x_5n, y_5n), color="blue", size=3)+
  #Este es el spline cúbico, y básicamente es la aproximación de esta función
  geom_line(aes(x5, sp_5), color="purple", size=1)+
  geom_area(aes(x5, y5), fill="yellow", alpha=0.5)+
  theme_bw()

ggplotly(graf_5)

Integral

pracma::integral(f_5,0,1, )

## [1] 3.194528