Ejercicio 1.
En cada inciso considera la función de valores reales, usa los polinomios interpolantes de Lagrange de grado a lo más tres con los puntos dados para aproximar el valor de la función solicitado. En cada caso calcula el error real.
- \(f(x)=e^{2x}\). Puntos: \(x_0=0, x_1=0.25, x_2=0.5, x_3=0.75\). Aproximar \(f(0.43)\).
f_1a <- function(x){exp(2*x)}
x_1a <- seq(from=0, to=.75, by=0.01)
y_1a <- f_1a(x_1a)
x_va <- c(0,.25, .5, .75)
y_va <- f_1a(x_va)
x0 <- 0
x1 <- .25
x2 <- .5
x3 <- .75
L0 <- function(x){(x-x1)*(x-x2)*(x-x3)/((x0-x1)*(x0-x2)*(x0-x3))}
L1 <- function(x){(x-x0)*(x-x2)*(x-x3)/((x1-x0)*(x1-x2)*(x1-x3))}
L2 <- function(x){(x-x0)*(x-x1)*(x-x3)/((x2-x0)*(x2-x1)*(x2-x3))}
L3 <- function(x){(x-x0)*(x-x1)*(x-x2)/((x3-x0)*(x3-x1)*(x3-x2))}
pol_1a <- function(x){
f_1a(x0)*L0(x)+f_1a(x1)*L1(x)+f_1a(x2)*L2(x)+f_1a(x3)*L3(x)
}
pol_ya <- pol_1a(x_1a)
graf_1a <- ggplot()+
geom_vline(xintercept = 0, linetype="dashed")+ #eje x
geom_hline(yintercept = 0, linetype="dashed")+ #eje y
geom_line(aes(x=x_1a, y=y_1a), color="red", size=1)+
geom_line(aes(x=x_1a, y=pol_ya), color="yellow", size=.5)+
geom_point(aes(x=x_va, y=y_va), color="blue", size=4)+
#coord_fixed(ratio = 1)+ # misma escala en los ejes
labs(x="x", y="f(x)", title="Interpolación Gráfica 1a)")+
theme_test()
#plot(graf_1)
ggplotly(graf_1a)- \(f(x)=x^4-x^3+x^2-x+1\). Puntos: \(x_0=-0.5, x_1=-0.25, x_2=0.25, x_3=0.5\). Aproximar \(f(0)\).
f_1b <- function(x){x^4-x^3+x^2-x+1}
x_1b <- seq(from=-.6, to=.8, by=0.01)
y_1b <- f_1b(x_1b)
x_vb <- c(-0.5,-.25, .25, .5)
y_vb <- f_1b(x_vb)
poly.calc(x_vb, y_vb)## 0.984375 - x + 1.3125*x^2 - x^3poly_1b <-as.function(poly.calc(x_vb, y_vb))
poly_yb <-poly_1b(x_1b)
graf_1b <- ggplot()+
geom_vline(xintercept = 0, linetype="dashed")+ #eje x
geom_hline(yintercept = 0, linetype="dashed")+ #eje y
geom_line(aes(x=x_1b, y=y_1b), color="red", size=1)+
geom_line(aes(x=x_1b, y=poly_yb), color="blue", size=.5)+
geom_point(aes(x=x_vb, y=y_vb), color="yellow", size=3)+
#coord_fixed(ratio = 1)+ # misma escala en los ejes
labs(x="x", y="f(x)", title="Interpolación Gráfica 1b)")+
theme_test()
#plot(graf_1)
ggplotly(graf_1b)Es el polinomio \(0.984375 - x + 1.3125*x^2 - x^3\) de grado 3 con el cual se aproxima el polinomio de grado 4 \(f(x)=x^4-x^3+x^2-x+1\)
- \(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)\).
f_1c <- function(x){x*cos(x)-3*x}
x_1c <- seq(from=0, to=.5, by=0.01)
y_1c <- f_1c(x_1c)
x_vc <- c(.1,.2, .3, .4)
y_vc <- f_1c(x_vc)
x0 <- .1
x1 <- .2
x2 <- .3
x3 <- .4
L0 <- function(x){
((x-x1)*(x-x2)*(x-x3))/((x0-x1)*(x0-x2)*(x0-x3))
}
L1 <- function(x){
((x-x0)*(x-x2)*(x-x3))/((x1-x0)*(x1-x2)*(x1-x3))
}
L2 <- function(x){
((x-x0)*(x-x1)*(x-x3))/((x2-x0)*(x2-x1)*(x2-x3))
}
L3 <- function(x){
((x-x0)*(x-x1)*(x-x2))/((x3-x0)*(x3-x1)*(x3-x2))
}
pol_1c <- function(x){
f_1c(x0)*L0(x)+f_1c(x1)*L1(x)+f_1c(x2)*L2(x)+f_1c(x3)*L3(x)
}
pol_yc <- pol_1c(x_1c)
#poly.calc(x_vc, y_vc)
polinomio_c <- as.function(poly.calc(x_vc, y_vc))
x_nc<- seq(from=.1, to=.4, by=.001)
y_nc<- polinomio_c(x_nc)
polinomio_yc <- polinomio_c(x_1c)
graf_1c <- ggplot()+
geom_vline(xintercept = 0, linetype="dashed")+ #eje x
geom_hline(yintercept = 0, linetype="dashed")+ #eje y
geom_line(aes(x=x_1c, y=y_1c), color="red", size=3)+
geom_line(aes(x=x_1c, y=pol_yc), color="yellow", size=.5)+
geom_point(aes(x=x_vc, y=y_vc), color="blue", size=4)+
geom_point(aes(x=x_nc, y=y_nc), color="green", size=.7)+
#coord_fixed(ratio = 1)+ # misma escala en los ejes
labs(x="x", y="f(x)", title="Interpolación Gráfica 1c)")+
theme_test()
#plot(graf_1)
ggplotly(graf_1c)- \(f(x)=log(e^x+2)\). Puntos: \(x_0=-1, x_1=-0.5, x_2=0, x_3=0.5\). Aproximar \(f(0.25)\).
f_1d <- function(x){log(exp(x)+2)}
x_1d <- seq(from=-.6, to=25.1, by=0.01)
y_1d <- f_1d(x_1d)
x_vd <- c(-1,-.5, 0, .5)
y_vd <- f_1d(x_vd)
poly.calc(x_vd, y_vd)## 1.098612 + 0.3328216*x + 0.1103446*x^2 + 0.01414048*x^3poly_1d <-as.function(poly.calc(x_vd, y_vd))
poly_yd <-poly_1d(x_1d)
graf_1d <- ggplot()+
geom_vline(xintercept = 0, linetype="dashed")+ #eje x
geom_hline(yintercept = 0, linetype="dashed")+ #eje y
geom_line(aes(x=x_1d, y=y_1d), color="red", size=1)+
geom_line(aes(x=x_1d, y=poly_yd), color="blue", size=.5)+
geom_point(aes(x=x_vd, y=y_vd), color="yellow", size=3)+
#coord_fixed(ratio = 1)+ # misma escala en los ejes
labs(x="x", y="f(x)", title="Interpolación Gráfica 1d)")+
theme_test()
#plot(graf_1)
ggplotly(graf_1d)Es el polinomio $1.098612 + 0.3328216x + 0.1103446x^2 + 0.01414048*x^3 $ de grado 3 con el cual se aproxima el polinomio de grado 4 \(f(x)=log(e^x+2)\)
Ejercicio 2
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.
Usa la interpolación de Lagrange para aproximar la curva del peso promedio de las muestras.
Para calcular un peso promedio máximo aproximado de cada muestra, determina el máximo del polinomio interpolante.
\[\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)
muestra1 <- c(6.67, 17.33, 42.67, 37.33, 30.10, 29.31, 28.74)
pol_muestra1 <- as.function(poly.calc(dias, muestra1))
dias_seq <- seq(from=0, to=28, by=0.01)
muestra_seq <- pol_muestra1(dias_seq)
# x_1c <- seq(0, 0.5, by=0.01)
# y_1c <- f_1c(x_1c)
#
# x_vc <- c(0.1, 0.2, 0.3, 0.4)
# y_vc <- f_1c(x_vc)
#
# x0 <- 0.1
# x1 <- 0.2
# x2 <- 0.3
# x3 <- 0.4
#
# L0 <- function(x){
# ((x-x1)*(x-x2)*(x-x3))/((x0-x1)*(x0-x2)*(x0-x3))
# }
#
# L1 <- function(x){
# ((x-x0)*(x-x2)*(x-x3))/((x1-x0)*(x1-x2)*(x1-x3))
# }
#
# L2 <- function(x){
# ((x-x0)*(x-x1)*(x-x3))/((x2-x0)*(x2-x1)*(x2-x3))
# }
#
# L3 <- function(x){
# ((x-x0)*(x-x1)*(x-x2))/((x3-x0)*(x3-x1)*(x3-x2))
# }
#
# pol_1c <- function(x){
# f_1c(x0)*L0(x)+f_1c(x1)*L1(x)+f_1c(x2)*L2(x)+f_1c(x3)*L3(x)
# }
# pol_yc <- pol_1c(x_1c)
graf_2 <- ggplot()+
geom_vline(xintercept = 0, linetype="dashed")+ #eje x
geom_hline(yintercept = 0, linetype="dashed")+ #eje y
geom_line(aes(x=dias_seq, y=muestra_seq), color="grey", size=1)+
#geom_line(aes(x=x_1c, y=pol_yc), color="green", size=0.5)+
geom_point(aes(x=dias, y=muestra1), color="yellow", size=3)+
#coord_fixed(ratio = 1)+ # misma escala en los ejes
labs(x="dias", y="peso muestra1", title="ejercicio 2")+
theme_bw()
plot(graf_2)
ggplotly(graf_2)Ejercicio 3
Construye los polinomios interpolantes de Lagrange de grados \(n=1,2,3,4\) para las siguientes funciones en el intervalo dado.
- \(f(x) = e^{2x}\, cos 3x\), \([0,2]\).
f_3a <- function(x){exp(2*x)*cos(3*x)}
x_3a <- seq(from=-.1, to=2.1, by=0.01)
y_3a <- f_3a(x_3a)
#polinomio grado 1
X_1<- c(0,2)
Y_1<- f_3a(X_1)
poly.calc(X_1,Y_1)## 1 + 25.71176*xP_1<-as.function(poly.calc(X_1,Y_1))
pol_y1<-P_1(x_3a)
#polinomio grado 2
X_2<- c(0,1.25,2)
Y_2<- f_3a(X_2)
poly.calc(X_2,Y_2)## 1 - 66.31205*x + 46.0119*x^2P_2<-as.function(poly.calc(X_2,Y_2))
pol_y2<-P_2(x_3a)
#polinomio grado 3
X_3<- c(0,2/3, 4/3,2)
Y_3<- f_3a(X_3)
poly.calc(X_3,Y_3)## 1 + 37.52367*x - 90.17847*x^2 + 42.13626*x^3P_3<-as.function(poly.calc(X_3,Y_3))
pol_y3<-P_3(x_3a)
#polinomio grado 4
X_4<- c(0, .5, 1, 3/2, 2)
Y_4<- f_3a(X_4)
poly.calc(X_4,Y_4)## 1 + 3.759978*x - 0.860049*x^2 - 28.34805*x^3 + 17.13301*x^4P_4<-as.function(poly.calc(X_4,Y_4))
pol_y4<-P_4(x_3a)
cc3<-cubicspline(X_3, Y_3)
cc3_y<-cubicspline(X_3, Y_3, x_3a)
#x_vb <- c(-0.5,-.25, .25, .5)
# y_vb <- f_1b(x_vb)
#
# poly.calc(x_vb, y_vb)
# poly_1b <-as.function(poly.calc(x_vb, y_vb))
# poly_yb <-poly_1b(x_1b)
graf_3a <- ggplot()+
geom_vline(xintercept = 0, linetype="dashed")+ #eje x
geom_hline(yintercept = 0, linetype="dashed")+ #eje # geom_line(aes(x=x_3a, y=y_3a), color="red", size=1)+
geom_line(aes(x=x_3a, y=pol_y1), color="pink", size=2)+
geom_point(aes(x=X_1, y=Y_1), color="green", size=7)+
geom_line(aes(x=x_3a, y=pol_y2), color="orchid3", size=1)+
geom_point(aes(x=X_2, y=Y_2), color="blue", size=4)+
geom_line(aes(x=x_3a, y=pol_y3), color="springgreen", size=.7)+
geom_point(aes(x=X_3, y=Y_3), color="yellow", size=4)+
geom_line(aes(x=x_3a, y=pol_y4), color="springgreen", size=.9)+
geom_point(aes(x=X_4, y=Y_4), color="purple", size=4)+
geom_line(aes(x=x_3a, y=cc3_y), color="black", size=.9)+
# geom_line(aes(x=x_1b, y=poly_yb), color="blue", size=.5)+
# geom_point(aes(x=x_vb, y=y_vb), color="yellow", size=3)+
#coord_fixed(ratio = 1)+ # misma escala en los ejes
labs(x="x", y="f(x)", title=" Gráfica 3a)")+
theme_test()
#plot(graf_1)
ggplotly(graf_3a)- \(f(x) = sen(log\,x)\), \([1,3]\).
f_3b <- function(x){sin(log(x))}
x_3b <- seq(from=-.5, to=4, by=0.01)
y_3b <- f_3b(x_3b)## Warning in log(x): NaNs produced## Warning in sin(log(x)): NaNs produced#polinomio grado 1
X_1<- c(1,3)
Y_1<- f_3b(X_1)
poly.calc(X_1,Y_1)## -0.4452885 + 0.4452885*xP_1<-as.function(poly.calc(X_1,Y_1))
pol_y1<-P_1(x_3b)
#polinomio grado 2
X_2<- c(1,2,3)
Y_2<- f_3b(X_2)
poly.calc(X_2,Y_2)## -1.026307 + 1.21998*x - 0.1936728*x^2P_2<-as.function(poly.calc(X_2,Y_2))
pol_y2<-P_2(x_3b)
#polinomio grado 3
X_3<- c(1, 1.66, 3.33,3)
Y_3<- f_3b(X_3)
poly.calc(X_3,Y_3)## -1.335696 + 1.777553*x - 0.4902087*x^2 + 0.04835156*x^3P_3<-as.function(poly.calc(X_3,Y_3))
pol_y3<-P_3(x_3b)
#polinomio grado 4
X_4<- c(1, 1.5, 2, 2.5, 3)
Y_4<- f_3b(X_4)
poly.calc(X_4,Y_4)## -1.612081 + 2.401244*x - 0.9762455*x^2 + 0.2049735*x^3 - 0.01789074*x^4P_4<-as.function(poly.calc(X_4,Y_4))
pol_y4<-P_4(x_3b)
# cc3<-cubicspline(X_3, Y_3)
# cc3_y<-cubicspline(X_3, Y_3, x_3b)
#x_vb <- c(-0.5,-.25, .25, .5)
# y_vb <- f_1b(x_vb)
#
# poly.calc(x_vb, y_vb)
# poly_1b <-as.function(poly.calc(x_vb, y_vb))
# poly_yb <-poly_1b(x_1b)
graf_3b <- ggplot()+
geom_vline(xintercept = 0, linetype="dashed")+ #eje x
geom_hline(yintercept = 0, linetype="dashed")+ #eje # geom_line(aes(x=x_3a, y=y_3a), color="red", size=1)+
geom_line(aes(x=x_3b, y=pol_y1), color="pink", size=2)+
geom_point(aes(x=X_1, y=Y_1), color="green", size=7)+
geom_line(aes(x=x_3b, y=pol_y2), color="orchid3", size=1)+
geom_point(aes(x=X_2, y=Y_2), color="blue", size=4)+
geom_line(aes(x=x_3b, y=pol_y3), color="springgreen", size=.7)+
geom_point(aes(x=X_3, y=Y_3), color="yellow", size=4)+
geom_line(aes(x=x_3b, y=pol_y4), color="blue", size=.9)+
geom_point(aes(x=X_4, y=Y_4), color="purple", size=4)+
# geom_line(aes(x=x_3b, y=cc3_y), color="black", size=.9)+
# geom_line(aes(x=x_1b, y=poly_yb), color="blue", size=.5)+
# geom_point(aes(x=x_vb, y=y_vb), color="yellow", size=3)+
#coord_fixed(ratio = 1)+ # misma escala en los ejes
labs(x="x", y="f(x)", title=" Gráfica 3b)")+
theme_test()
#plot(graf_1)
ggplotly(graf_3b)- \(f(x) = e^{x}+e^{-x}\), \([0,2]\).
f_3c <- function(x){exp(x)+exp(-x)}
x_3c <- seq(from=-.1, to=2.1, by=0.01)
y_3c <- f_3c(x_3c)
#polinomio grado 1
X_1<- c(0,2)
Y_1<- f_3c(X_1)
poly.calc(X_1,Y_1)## 2 + 2.762196*xP_1<-as.function(poly.calc(X_1,Y_1))
pol_y1<-P_1(x_3c)
#polinomio grado 2
X_2<- c(0,1.25,2)
Y_2<- f_3c(X_2)
poly.calc(X_2,Y_2)## 2 - 0.8130509*x + 1.787623*x^2P_2<-as.function(poly.calc(X_2,Y_2))
pol_y2<-P_2(x_3c)
#polinomio grado 3
X_3<- c(0,2/3, 4/3,2)
Y_3<- f_3c(X_3)
poly.calc(X_3,Y_3)## 2 + 0.2085296*x + 0.4487771*x^2 + 0.414028*x^3P_3<-as.function(poly.calc(X_3,Y_3))
pol_y3<-P_3(x_3c)
#polinomio grado 4
X_4<- c(0, .5, 1, 3/2, 2)
Y_4<- f_3c(X_4)
poly.calc(X_4,Y_4)## 2 - 0.02429658*x + 1.095769*x^2 - 0.1193604*x^3 + 0.1340496*x^4P_4<-as.function(poly.calc(X_4,Y_4))
pol_y4<-P_4(x_3c)
cc4<-cubicspline(X_4, Y_4)
cc4_y<-cubicspline(X_4, Y_4, x_3c)
#x_vb <- c(-0.5,-.25, .25, .5)
# y_vb <- f_1b(x_vb)
#
# poly.calc(x_vb, y_vb)
# poly_1b <-as.function(poly.calc(x_vb, y_vb))
# poly_yb <-poly_1b(x_1b)
graf_3c <- ggplot()+
geom_vline(xintercept = 0, linetype="dashed")+ #eje x
geom_hline(yintercept = 0, linetype="dashed")+ #eje # geom_line(aes(x=x_3a, y=y_3a), color="red", size=1)+
geom_line(aes(x=x_3c, y=pol_y1), color="pink", size=2)+
geom_point(aes(x=X_1, y=Y_1), color="green", size=7)+
geom_line(aes(x=x_3c, y=pol_y2), color="orchid3", size=1)+
geom_point(aes(x=X_2, y=Y_2), color="blue", size=4)+
geom_line(aes(x=x_3c, y=pol_y3), color="springgreen", size=.7)+
geom_point(aes(x=X_3, y=Y_3), color="yellow", size=4)+
geom_line(aes(x=x_3c, y=pol_y4), color="springgreen", size=.9)+
geom_point(aes(x=X_4, y=Y_4), color="purple", size=4)+
geom_line(aes(x=x_3c, y=cc4_y), color="black", size=.9)+
# geom_line(aes(x=x_1b, y=poly_yb), color="blue", size=.5)+
# geom_point(aes(x=x_vb, y=y_vb), color="yellow", size=3)+
#coord_fixed(ratio = 1)+ # misma escala en los ejes
labs(x="x", y="f(x)", title=" Gráfica 3c)")+
theme_test()
#plot(graf_1)
ggplotly(graf_3c)- \(f(x) = cos \,x+sen\,x\), \([0,2\pi]\).
f_3d <- function(x){cos(x)+sin(x)}
x_3d <- seq(from=-.2, to=7, by=0.01)
y_3d <- f_3d(x_3d)
#polinomio grado 1
X_1<- c(0,6.28318)
Y_1<- f_3d(X_1)
poly.calc(X_1,Y_1)## 1 - 8.446668e-07*xP_1<-as.function(poly.calc(X_1,Y_1))
pol_y1<-P_1(x_3d)
#polinomio grado 2
X_2<- c(0,3.14159,6.28318)
Y_2<- f_3d(X_2)
poly.calc(X_2,Y_2)## 1 - 1.273238*x + 0.2026422*x^2P_2<-as.function(poly.calc(X_2,Y_2))
pol_y2<-P_2(x_3d)
#polinomio grado 3
X_3<- c(0, 2.09439, 4.18878, 6.283183)
Y_3<- f_3d(X_3)
poly.calc(X_3,Y_3)## 1 + 0.7864473*x - 0.7174606*x^2 + 0.09426647*x^3P_3<-as.function(poly.calc(X_3,Y_3))
pol_y3<-P_3(x_3d)
#polinomio grado 4
X_4<- c(0, 1.57079, 3.14158, 4.71237, 6.283183)
Y_4<- f_3d(X_4)
poly.calc(X_4,Y_4)## 1 + 2.122055*x - 1.958867*x^2 + 0.4300179*x^3 - 0.02737574*x^4P_4<-as.function(poly.calc(X_4,Y_4))
pol_y4<-P_4(x_3d)
# cc4<-cubicspline(X_4, Y_4)
# cc4_y<-cubicspline(X_4, Y_4, x_3c)
#x_vb <- c(-0.5,-.25, .25, .5)
# y_vb <- f_1b(x_vb)
#
# poly.calc(x_vb, y_vb)
# poly_1b <-as.function(poly.calc(x_vb, y_vb))
# poly_yb <-poly_1b(x_1b)
graf_3d <- ggplot()+
geom_vline(xintercept = 0, linetype="dashed")+ #eje x
geom_hline(yintercept = 0, linetype="dashed")+ #eje # geom_line(aes(x=x_3a, y=y_3a), color="red", size=1)+
geom_line(aes(x=x_3d, y=pol_y1), color="pink", size=2)+
geom_point(aes(x=X_1, y=Y_1), color="green", size=7)+
geom_line(aes(x=x_3d, y=pol_y2), color="orchid3", size=1)+
geom_point(aes(x=X_2, y=Y_2), color="blue", size=4)+
geom_line(aes(x=x_3d, y=pol_y3), color="springgreen", size=.7)+
geom_point(aes(x=X_3, y=Y_3), color="yellow", size=4)+
geom_line(aes(x=x_3d, y=pol_y4), color="blue", size=.9)+
geom_point(aes(x=X_4, y=Y_4), color="purple", size=4)+
# geom_line(aes(x=x_1b, y=poly_yb), color="blue", size=.5)+
# geom_point(aes(x=x_vb, y=y_vb), color="yellow", size=3)+
#coord_fixed(ratio = 1)+ # misma escala en los ejes
labs(x="x", y="f(x)", title=" Gráfica 3c)")+
theme_test()
#plot(graf_1)
ggplotly(graf_3d)