Find the minimum of function \[\begin{aligned} f=\lambda^5-5\lambda^3-20\lambda+5 \end{aligned}\] by the following method : Fibonacci search in the interval (0, 5)
## Fungsi Fibonacci
fibonacci <- function(n) {
fn <- c(1,1)
for (i in 2:n+1)
{
fn <- c(fn, (fn[i-1]+fn[i-2]))
}
return(fn)
}
fib_search <- function(f, xl, xr, n){
F = fibonacci(n) # Call the fibonnaci number function
L0 = xr - xl # Initial interval of uncertainty
R1 = L0 # Initial Reduction Ratio
Li = (F[n-2]/F[n])*L0
R = Li/L0
for (i in 2:n)
{
if (Li > L0/2) {
x1 = xr - Li #titik selang awal
x2 = xl + Li #titik selang akhir
} else {
x1 = xl + Li
x2 = xr - Li
}
f1 = f(x1)
f2 = f(x2)
if (f1 < f2) {
xr = x2
Li = (F[n - i]/F[n - (i - 2)])*L0 # New interval of uncertainty
} else if (f1 > f2) {
xl = x1
Li = (F[n - i]/F[n - (i - 2)])*L0 # New interval of uncertainty
} else {
xl = x1
xr = x2
Li = (F[n - i]/F[n - (i - 2)])*(xr - xl) # New interval of uncertainty
}
L0 = xr - xl
R = c(R, Li/R1)
}
list1 <- list(x1, f(x1), R) # Membuat sebagai list sehingga bisa dipanggil keluar dengan fungsi return.
names(list1) <- c("x", "f(x)", "R") # Memberi nama pada elemen suatu list.
list2 <- list(x2, f(x2), R)
names(list2) <- c("x", "f(x)", "R")
if (f1 <= f2) {
return(list1) # Final result
} else {
return(list2) # Final result
}
}
f <- function(x) {
x^5-5*x^3-20*x+5
}
Fib = fib_search(f, 0, 5, 50) #note: ketiga parameter ini harus diketahui
Fib
## $x
## [1] 2
##
## $`f(x)`
## [1] -43
##
## $R
## [1] 3.819660e-01 3.819660e-01 2.360680e-01 1.458980e-01 9.016994e-02
## [6] 5.572809e-02 3.444185e-02 2.128624e-02 1.315562e-02 8.130619e-03
## [11] 5.024999e-03 3.105620e-03 1.919379e-03 1.186241e-03 7.331374e-04
## [16] 4.531039e-04 2.800336e-04 1.730703e-04 1.069633e-04 6.610696e-05
## [21] 4.085635e-05 2.525061e-05 1.560574e-05 9.644876e-06 5.960861e-06
## [26] 3.684015e-06 2.276846e-06 1.407168e-06 8.696779e-07 5.374905e-07
## [31] 3.321874e-07 2.053031e-07 1.268843e-07 7.841879e-08 4.846551e-08
## [36] 2.995328e-08 1.851224e-08 1.144104e-08 1.669167e-09 3.939786e-10
## [41] 9.304174e-11 2.194191e-11 5.193534e-12 1.217532e-12 2.926889e-13
## [46] 6.588063e-14 1.755041e-14 2.901383e-15 1.421085e-15
kurva_1 = curve(f,xlim=c(-5,5), col='steelblue',lwd=2)
kurva_1
## $x
## [1] -5.0 -4.9 -4.8 -4.7 -4.6 -4.5 -4.4 -4.3 -4.2 -4.1 -4.0 -3.9 -3.8 -3.7 -3.6
## [16] -3.5 -3.4 -3.3 -3.2 -3.1 -3.0 -2.9 -2.8 -2.7 -2.6 -2.5 -2.4 -2.3 -2.2 -2.1
## [31] -2.0 -1.9 -1.8 -1.7 -1.6 -1.5 -1.4 -1.3 -1.2 -1.1 -1.0 -0.9 -0.8 -0.7 -0.6
## [46] -0.5 -0.4 -0.3 -0.2 -0.1 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9
## [61] 1.0 1.1 1.2 1.3 1.4 1.5 1.6 1.7 1.8 1.9 2.0 2.1 2.2 2.3 2.4
## [76] 2.5 2.6 2.7 2.8 2.9 3.0 3.1 3.2 3.3 3.4 3.5 3.6 3.7 3.8 3.9
## [91] 4.0 4.1 4.2 4.3 4.4 4.5 4.6 4.7 4.8 4.9 5.0
##
## $y
## [1] -2395.00000 -2133.50749 -1894.07968 -1675.33507 -1475.94976 -1294.65625
## [7] -1130.24224 -981.54943 -847.47232 -726.95701 -619.00000 -522.64699
## [13] -436.99168 -361.17457 -294.38176 -235.84375 -184.83424 -140.66893
## [19] -102.70432 -70.33651 -43.00000 -20.16649 -1.34368 13.92593
## [25] 26.06624 35.46875 42.49376 47.47157 50.70368 52.46399
## [31] 53.00000 52.53401 51.26432 49.36643 46.99424 44.28125
## [37] 41.34176 38.27207 35.15168 32.04449 29.00000 26.05451
## [43] 23.23232 20.54693 18.00224 15.59375 13.30976 11.13257
## [49] 9.03968 7.00499 5.00000 2.99501 0.96032 -1.13257
## [55] -3.30976 -5.59375 -8.00224 -10.54693 -13.23232 -16.05451
## [61] -19.00000 -22.04449 -25.15168 -28.27207 -31.34176 -34.28125
## [67] -36.99424 -39.36643 -41.26432 -42.53401 -43.00000 -42.46399
## [73] -40.70368 -37.47157 -32.49376 -25.46875 -16.06624 -3.92593
## [79] 11.34368 30.16649 53.00000 80.33651 112.70432 150.66893
## [85] 194.83424 245.84375 304.38176 371.17457 446.99168 532.64699
## [91] 629.00000 736.95701 857.47232 991.54943 1140.24224 1304.65625
## [97] 1485.94976 1685.33507 1904.07968 2143.50749 2405.00000
f_2 <- function(lambda) lambda^5 - 5*lambda^3 - 20*lambda + 5
package=optimize(f_2, 0.5, lower = min(0), upper = max(5),
maximum = FALSE,
tol = .Machine$double.eps^0.5)
kurva_2= curve(f_2,xlim=c(-5,5), col='steelblue',lwd=2)
kurva_2
## $x
## [1] -5.0 -4.9 -4.8 -4.7 -4.6 -4.5 -4.4 -4.3 -4.2 -4.1 -4.0 -3.9 -3.8 -3.7 -3.6
## [16] -3.5 -3.4 -3.3 -3.2 -3.1 -3.0 -2.9 -2.8 -2.7 -2.6 -2.5 -2.4 -2.3 -2.2 -2.1
## [31] -2.0 -1.9 -1.8 -1.7 -1.6 -1.5 -1.4 -1.3 -1.2 -1.1 -1.0 -0.9 -0.8 -0.7 -0.6
## [46] -0.5 -0.4 -0.3 -0.2 -0.1 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9
## [61] 1.0 1.1 1.2 1.3 1.4 1.5 1.6 1.7 1.8 1.9 2.0 2.1 2.2 2.3 2.4
## [76] 2.5 2.6 2.7 2.8 2.9 3.0 3.1 3.2 3.3 3.4 3.5 3.6 3.7 3.8 3.9
## [91] 4.0 4.1 4.2 4.3 4.4 4.5 4.6 4.7 4.8 4.9 5.0
##
## $y
## [1] -2395.00000 -2133.50749 -1894.07968 -1675.33507 -1475.94976 -1294.65625
## [7] -1130.24224 -981.54943 -847.47232 -726.95701 -619.00000 -522.64699
## [13] -436.99168 -361.17457 -294.38176 -235.84375 -184.83424 -140.66893
## [19] -102.70432 -70.33651 -43.00000 -20.16649 -1.34368 13.92593
## [25] 26.06624 35.46875 42.49376 47.47157 50.70368 52.46399
## [31] 53.00000 52.53401 51.26432 49.36643 46.99424 44.28125
## [37] 41.34176 38.27207 35.15168 32.04449 29.00000 26.05451
## [43] 23.23232 20.54693 18.00224 15.59375 13.30976 11.13257
## [49] 9.03968 7.00499 5.00000 2.99501 0.96032 -1.13257
## [55] -3.30976 -5.59375 -8.00224 -10.54693 -13.23232 -16.05451
## [61] -19.00000 -22.04449 -25.15168 -28.27207 -31.34176 -34.28125
## [67] -36.99424 -39.36643 -41.26432 -42.53401 -43.00000 -42.46399
## [73] -40.70368 -37.47157 -32.49376 -25.46875 -16.06624 -3.92593
## [79] 11.34368 30.16649 53.00000 80.33651 112.70432 150.66893
## [85] 194.83424 245.84375 304.38176 371.17457 446.99168 532.64699
## [91] 629.00000 736.95701 857.47232 991.54943 1140.24224 1304.65625
## [97] 1485.94976 1685.33507 1904.07968 2143.50749 2405.00000
library(kableExtra)
xmin_manual <- Fib$x
xmin_package <- package$minimum
Perbandingan <- data.frame("x_min manual"=c(Fib$x),
"x_min package"=c(package$minimum),check.names = FALSE)
kable(Perbandingan,align = "c")
| x_min manual | x_min package |
|---|---|
| 2 | 2 |
par(mfrow= c(1,2))
plot(f,xlim=c(-5,5), col='steelblue',lwd=2) #manual
plot(f_2,xlim=c(-5,5), col='steelblue',lwd=2) #package
Diperoleh kesimpulan bahwa kedua fungsi yang digunakan (baik manual, maupun menggunakan package optimum), keduanya bernilai sama, yakni pada x=2 (note: nilai keduanya akan mengikuti besar angka toleransi yang diinginkan)