FACULTAD DE CIENCIAS
EXACTAS Y TECNOLÓGICAS
Apreciados estudiantes de la Facultad de Ciencias Exactas y Tecnológicas, este es un taller de programación en rstudio de métodos numéricos, aquí encontraras ejercicios resueltos y propuestos de la materia de Cálculo IV dirigido por el docente Msc. Pedro Alberto Villalba Sosa, esta página fue creada por Adrián Martínez Amarilla, estudiante - docente de práctica.
En cada línea de código puedes sustituir valores o variables de tu preferencia si deseas aproximarte a la raíz de una función, observa cada ejercicio resuelto.
Utiliza el método de la bisección para aproximar a la menor raíz positiva de la ecuación: \[x^3 - 6x +2 = 0\] con un error \(\varepsilon \leq 0,0001\)
# Función a resolver
f <- function(x) {
return(x^3 - 6*x + 2)
}
# Intervalo inicial
a <- 0
b <- 1
tolerancia <- 0.0001
k <- 0
error <- Inf # Inicializado con un valor grande para la primera iteración
# Crear una tabla vacía para almacenar los resultados
tabla_resultados <- data.frame(k = integer(0), a = numeric(0), b = numeric(0), fa = numeric(0), fb = numeric(0), error = numeric(0))
while (error > tolerancia) {
k <- k + 1
c <- (a + b) / 2
fa <- f(a)
fb <- f(b)
error <- (b - a) / 2
# Agregar resultados a la tabla
tabla_resultados <- rbind(tabla_resultados, data.frame(k, a, b, fa, fb, error))
if (fa * f(c) < 0) {
b <- c
} else {
a <- c
}
}
print(tabla_resultados)
## k a b fa fb error
## 1 1 0.0000000 1.0000000 2.0000000000 -3.0000000000 5.000000e-01
## 2 2 0.0000000 0.5000000 2.0000000000 -0.8750000000 2.500000e-01
## 3 3 0.2500000 0.5000000 0.5156250000 -0.8750000000 1.250000e-01
## 4 4 0.2500000 0.3750000 0.5156250000 -0.1972656250 6.250000e-02
## 5 5 0.3125000 0.3750000 0.1555175781 -0.1972656250 3.125000e-02
## 6 6 0.3125000 0.3437500 0.1555175781 -0.0218811035 1.562500e-02
## 7 7 0.3281250 0.3437500 0.0665779114 -0.0218811035 7.812500e-03
## 8 8 0.3359375 0.3437500 0.0222868919 -0.0218811035 3.906250e-03
## 9 9 0.3398438 0.3437500 0.0001873374 -0.0218811035 1.953125e-03
## 10 10 0.3398438 0.3417969 0.0001873374 -0.0108507946 9.765625e-04
## 11 11 0.3398438 0.3408203 0.0001873374 -0.0053327037 4.882812e-04
## 12 12 0.3398438 0.3403320 0.0001873374 -0.0025729266 2.441406e-04
## 13 13 0.3398438 0.3400879 0.0001873374 -0.0011928554 1.220703e-04
## 14 14 0.3398438 0.3399658 0.0001873374 -0.0005027742 6.103516e-05
Veamos otro ejemplo, al código anterior solo le cambiamos la función como se habia dicho anteriormente.
El enunciado del siguiente problema nos dice: Determina un cero de la función \[f(x)=-\frac{1}{10}x^2 +3\] utilizando el método de la bisección
# Función a resolver
f <- function(x) {
return(-(1/10)*x^2 +3)
}
# Intervalo inicial
a <- 1
b <- 7
tolerancia <- 0.0001
k <- 0
error <- Inf # Inicializado con un valor grande para la primera iteración
# Crear una tabla vacía para almacenar los resultados
tabla_resultados <- data.frame(k = integer(0), a = numeric(0), b = numeric(0), c = numeric(0), fa = numeric(0), fb = numeric(0), fc = numeric(0), error = numeric(0))
while (error > tolerancia) {
k <- k + 1
c <- (a + b) / 2
fa <- f(a)
fb <- f(b)
fc <- f(c)
error <- (b - a) / 2
# Agregar resultados a la tabla
tabla_resultados <- rbind(tabla_resultados, data.frame(k, a, b, c, fa, fb, fc, error))
if (fa * fc < 0) {
b <- c
} else {
a <- c
}
}
print(tabla_resultados)
## k a b c fa fb fc
## 1 1 1.000000 7.000000 4.000000 2.9000000000 -1.900000e+00 1.400000e+00
## 2 2 4.000000 7.000000 5.500000 1.4000000000 -1.900000e+00 -2.500000e-02
## 3 3 4.000000 5.500000 4.750000 1.4000000000 -2.500000e-02 7.437500e-01
## 4 4 4.750000 5.500000 5.125000 0.7437500000 -2.500000e-02 3.734375e-01
## 5 5 5.125000 5.500000 5.312500 0.3734375000 -2.500000e-02 1.777344e-01
## 6 6 5.312500 5.500000 5.406250 0.1777343750 -2.500000e-02 7.724609e-02
## 7 7 5.406250 5.500000 5.453125 0.0772460937 -2.500000e-02 2.634277e-02
## 8 8 5.453125 5.500000 5.476562 0.0263427734 -2.500000e-02 7.263184e-04
## 9 9 5.476562 5.500000 5.488281 0.0007263184 -2.500000e-02 -1.212311e-02
## 10 10 5.476562 5.488281 5.482422 0.0007263184 -1.212311e-02 -5.694962e-03
## 11 11 5.476562 5.482422 5.479492 0.0007263184 -5.694962e-03 -2.483463e-03
## 12 12 5.476562 5.479492 5.478027 0.0007263184 -2.483463e-03 -8.783579e-04
## 13 13 5.476562 5.478027 5.477295 0.0007263184 -8.783579e-04 -7.596612e-05
## 14 14 5.476562 5.477295 5.476929 0.0007263184 -7.596612e-05 3.251895e-04
## 15 15 5.476929 5.477295 5.477112 0.0003251895 -7.596612e-05 1.246151e-04
## 16 16 5.477112 5.477295 5.477203 0.0001246151 -7.596612e-05 2.432531e-05
## error
## 1 3.000000e+00
## 2 1.500000e+00
## 3 7.500000e-01
## 4 3.750000e-01
## 5 1.875000e-01
## 6 9.375000e-02
## 7 4.687500e-02
## 8 2.343750e-02
## 9 1.171875e-02
## 10 5.859375e-03
## 11 2.929688e-03
## 12 1.464844e-03
## 13 7.324219e-04
## 14 3.662109e-04
## 15 1.831055e-04
## 16 9.155273e-05
Ahora fijate que el código anterior le hicimos unos cambios para que nos imprima \(c\) y \(f(c)\)
El desplazamiento de la estructura de un puente Colgante está definido por la siguiente ecuación para una oscilación amortiguada: \[f(t) = 9 \cdot e^{-0,7t} \cdot \cos (4t)\] Mediante el método de la falsa posición, determine el tiempo que se requiere para que el desplazamiento disminuya a 3,5 con una tolerancia de \(\delta \% < 10^{-6}\)
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.3.1
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
# Definir la función f(t)
f <- function(t) {
return(9 * exp(-0.7 * t) * cos(4 * t) - 3.5)
}
# Valores iniciales
t0 <- 0
t1 <- 1
tolerance <- 1e-7
# Inicializar variables para almacenar datos
data <- data.frame(k = integer(),
intervalo_a = numeric(),
intervalo_b = numeric(),
f_a = numeric(),
f_b = numeric(),
x_k = numeric(),
f_x_k = numeric(),
error = numeric())
# Algoritmo de falsa posición
k <- 0
while (TRUE) {
f_t0 <- f(t0)
f_t1 <- f(t1)
x_k <- t1 - (f_t1 * (t1 - t0)) / (f_t1 - f_t0)
f_x_k <- f(x_k)
error <- abs(f_x_k)
data <- data %>% add_row(k = k,
intervalo_a = t0,
intervalo_b = t1,
f_a = f_t0,
f_b = f_t1,
x_k = x_k,
f_x_k = f_x_k,
error = error)
if (error < tolerance) {
break
}
if (f_x_k * f_t0 < 0) {
t1 <- x_k
} else {
t0 <- x_k
}
k <- k + 1
}
# Mostrar la tabla resumida
print(data)
## k intervalo_a intervalo_b f_a f_b x_k f_x_k
## 1 0 0.0000000 1.0000000 5.500000000 -6.42130834 0.4613588 -5.267157e+00
## 2 1 0.0000000 0.4613588 5.500000000 -5.26715651 0.2356679 9.843638e-01
## 3 2 0.2356679 0.4613588 0.984363775 -5.26715651 0.2712052 -2.321641e-02
## 4 3 0.2356679 0.2712052 0.984363775 -0.02321641 0.2703863 3.289510e-04
## 5 4 0.2703863 0.2712052 0.000328951 -0.02321641 0.2703978 8.006374e-08
## error
## 1 5.267157e+00
## 2 9.843638e-01
## 3 2.321641e-02
## 4 3.289510e-04
## 5 8.006374e-08
Usar el método de N-R para aproximar la raíz de: \[e^{-x} - ln(x) = 0\] comenzando con \(x_{0}\) y hasta que las aproximaciones tengan error relativo menor al \(1 \%\)
# Cargar el paquete numDeriv
library(numDeriv)
# Definir la función original
f <- function(x) {
return(exp(-x) - log(x))
}
# Condiciones iniciales
x0 <- 1 # Elige un valor inicial
# Tolerancia para el error relativo
tolerancia <- 0.01 # 1% de error relativo
# Crear una tabla vacía para almacenar los resultados
tabla_resultados <- data.frame(k = integer(0), xk = numeric(0), error_relativo = numeric(0))
# Inicializar variables
k <- 0
xk <- x0
error_relativo <- Inf # Inicializado con un valor grande para la primera iteración
while (error_relativo > tolerancia) {
k <- k + 1
xk_anterior <- xk
f_prime <- grad(f, xk) # Calcular la derivada numérica en xk
xk <- xk - f(xk) / f_prime
error_relativo <- abs((xk - xk_anterior) / xk_anterior) * 100
# Redondear el error relativo a tres decimales
error_relativo <- round(error_relativo, 3)
# Agregar resultados a la tabla
tabla_resultados <- rbind(tabla_resultados, data.frame(k, xk, paste0(error_relativo, "%")))
}
# Imprimir la tabla de resultados
print(tabla_resultados)
## k xk paste0.error_relativo......
## 1 1 1.268941 26.894%
## 2 2 1.309108 3.165%
## 3 3 1.309799 0.053%
## 4 4 1.309800 0%
Determine una solución de la ecuación \[e^{-x}- sen (x)=0\] con una precisión de \(\varepsilon = 10^{-3}\) usando el método de Newton Raphson.
Bien como podrás observas podemos copiar la línea de códigos y reemplazar solamente la función y nuestro punto de partida de la siguiente manera:
# Cargar el paquete numDeriv
library(numDeriv)
# Definir la función original
f <- function(x) {
return(exp(-x)-sin(x))
}
# Condiciones iniciales
x0 <- 0.2 # Elige un valor inicial
# Tolerancia para el error relativo
tolerancia <- 0.0001 # 1% de error relativo
# Crear una tabla vacía para almacenar los resultados
tabla_resultados <- data.frame(k = integer(0), xk = numeric(0), error_relativo = numeric(0))
# Inicializar variables
k <- 0
xk <- x0
error_relativo <- Inf # Inicializado con un valor grande para la primera iteración
while (error_relativo > tolerancia) {
k <- k + 1
xk_anterior <- xk
f_prime <- grad(f, xk) # Calcular la derivada numérica en xk
xk <- xk - f(xk) / f_prime
error_relativo <- abs((xk - xk_anterior) / xk_anterior) * 100
# Redondear el error relativo a tres decimales
error_relativo <- round(error_relativo, 3)
# Agregar resultados a la tabla
tabla_resultados <- rbind(tabla_resultados, data.frame(k, xk, paste0(error_relativo, "%")))
}
# Imprimir la tabla de resultados
print(tabla_resultados)
## k xk paste0.error_relativo......
## 1 1 0.5447089 172.354%
## 2 2 0.5877953 7.91%
## 3 3 0.5885325 0.125%
## 4 4 0.5885327 0%
Mediante el método de la secante obtenga una solución de la ecuación \[x-0,5 \tan(x) = 0\] con una precisión de \(\varepsilon = 10^{-8}\)
secante <- function(f, p0, p1, epsilon, max_iter = 1000) {
for (i in 1:max_iter) {
p2 <- p1 - f(p1) * (p1 - p0) / (f(p1) - f(p0))
cat("Iteración", i, ": x =", sprintf("%.10f", p2), "\n")
if (abs(p2 - p1) < epsilon) {
cat("La solución aproximada es x =", sprintf("%.10f", p2), "con una precisión de", epsilon, "\n")
return(p2)
}
p0 <- p1
p1 <- p2
}
stop("El método de la secante no convergió en el número máximo de iteraciones.")
}
p0 <- 1.2
p1 <- 1
epsilon <- 1e-8
solucion <- secante(f, p0, p1, epsilon)
## Iteración 1 : x = 0.3976705709
## Iteración 2 : x = 0.6237708441
## Iteración 3 : x = 0.5910369488
## Iteración 4 : x = 0.5884967665
## Iteración 5 : x = 0.5885327801
## Iteración 6 : x = 0.5885327440
## Iteración 7 : x = 0.5885327440
## La solución aproximada es x = 0.5885327440 con una precisión de 1e-08