Bagian 9 Optimasi Secara Numerik
Optimasi merupakan suatu proses untuk mecari kondisi yang optimum, dalam arti paling maksimal, atau paling minimal. Optimasi dapat dilakukan dengan meminimumkan atau memaksimumkan suatu fungsi
9.1 Fungsi Kalkulus
9.1.1 Integral
Fungsi integral yang dapat digunakan pada R adalah integrate(fungsi, lower, upper)
. Selain itu, terdapat fungsi yac_str()
pada package Ryacas
untuk mencari integral tak tentu.
Contoh menggunakan fungsi integrate
:
\[ \int x^2 dx \]
<- function (x)x^2
fs integrate(fs,0,1)
## 0.3333333 with absolute error < 0.0000000000000037
\[ \int x^2 +4x dx \]
<- function(x) x^2 + 4*x
f1 integrate(f1, lower=-10, upper=10)
## 666.6667 with absolute error < 0.0000000000076
\[ \int t^4 e^{-t} dt \]
<- function(t)t^4 * exp(-t)
f2 integrate(f2, lower=0, upper=Inf)
## 24 with absolute error < 0.000022
Contoh dengan fungsi yac_str
pada paket Ryacas
library(Ryacas)
\[ \int x^2 + 4xdx \]
yac_str("Integrate(x) x^2 + 4*x")
## [1] "x^3/3+2*x^2"
\[ \int t^4 e^{-t} dt \]
yac_str("Integrate(t) t^4 *Exp(-t)")
## [1] "4*(3*((-2)*(t+1)*Exp(-t)-t^2*Exp(-t))-t^3*Exp(-t))-t^4*Exp(-t)"
9.1.2 Diferensial
Untuk mendapatkan turunan dari suatu fungsi pada pemrograman R dapat menggunakan fungsi
D(expr, simbol)
: jika hasil turunan merupakan suatu fungsideriv(~fungsi, simbol)
: jika akan memasukkan nilai dari hasil turunan pada suatu fungsi
Contoh, akan dicari turunan dari fungsi berikut
\[ f(x) = \mathrm{exp}(x)^2 \]
<- expression(exp(x^2))
xfs D(xfs, "x")
## exp(x^2) * (2 * x)
\[ f(x) = x^2 \]
untuk nilai \(x=2\)
<- deriv(~x^2, "x")
xturunan <-2
xeval(xturunan)
## [1] 4
## attr(,"gradient")
## x
## [1,] 4
9.2 Optimasi Numerik
9.2.1 Golden Section Search
Metode golden section search digunakan untuk mencari nilai minimum suatu fungsi yang dibatasi dari dua buah nilai, yaitu sebuah selang a dan b. Algoritma untuk teknik ini adalah sebagai berikut:
- Mulai dengan selang [a,b] yang memuat minimum
- Perkecil selang \([a’, b’]\) yang memuat minimum
- Berhenti sampai \(|b’ - a’|\) lebih kecil dari nilai toleransi
Pemilihan nilai \(a'\) dan \(b'\), adalah sebagai berikut
Nilai antara [a,b] memiliki sifat golden ratio
Tentukan \(x_1\) dan \(x_2\)
\(x_1 = b-(b-a)/\mathrm{goldenratio}\)
\(x_2 = a+(b-a)/\mathrm{goldenratio}\)
Hitung \(f(x_1)\) dan \(f(x_2)\)
Jika \(f(x_1) > f(x_2)\) maka \([a’, b’] = [x_1, b]\)
Jika \(f(x_1) < f(x_2)\) maka \([a’, b’] = [a, x_2]\)
Fungsi golden section
<- function (f, a, b, tol=0.0000001){
golden <- 2 / ( sqrt (5)+1)
ratio <- b-ratio * (b-a)
x1 <- a+ratio * (b-a)
x2 <- f(x1)
f1 <- f(x2)
f2
while ( abs (b-a)>tol){
if (f2>f1){
<- x2
b <- x1
x2 <- f1
f2 <- b-ratio * (b-a)
x1
<- f(x1)} else {
f1 <- x1
a <- x2
x1 <- f2
f1 <- a+ratio * (b-a)
x2 <- f(x2)
f2
}
}return ((a+b) / 2)
}
Contoh
\[ f(x) = |x -3.5| (x-2)^2 \]
# Membuat fungsi f(x)
<- function(x) {abs(x-3.5)+(x-2)^2}
f
# Membuat plot
curve(f, 1,5)
# Menghitung nilai optimum
golden(f,1,2)
## [1] 2
golden(f,1,5)
## [1] 2.5
golden(f,3,5)
## [1] 3
\[ f(x) = 2\mathrm{sin}(x) - \frac{x^2}{10} \] Membuat fungsi \(f(x)\)
# Membuat fungsi f(x)
<- function(x) {(2 * sin(x)) - ((x^2) /10)}
f <- function(x) -1 * f(x) # fungsi dikali dengan -1 karena fungsi yang dibuat meminimumkan
fa
# Membuat plot
curve(f, 0,4)
golden(fa,0,4)
## [1] 1.427552
9.2.2 Newton Raphson
Jika suatu fungsi memiliki turunan pertama dan kedua, maka nilai minimum dapat menggunakan metode Newton Raphson. Kelebihan metode ini adalah hanya memerlukan satu nilai untuk inisial. Kelemahannya adalah kita harus yakin f(x) memiliki turunan pertama dan turunan kedua. Jika di golden section tidak perlu ada turunan pertama dan turunan kedua.
Fungsi Newton Raphson
<- function (fx , x0 =1){
newtonr <- deriv (fx ,"x") # turunan pertama
fx1 <- deriv (D(fx ,"x"),"x") # turunan kedua
fx2 <- 1000
er while(er > 1e-6){
<- x0
x <- attr ( eval (fx1),"gradient")[1]
f1 <- attr ( eval (fx2),"gradient")[1]
f2 <- abs(f1) # bisa juga e <- abs (x1 -x0)
er <- x0 - f1/f2
x1 <- x1
x0
}return (x1)
}
Hitung nilai minimum untuk fungsi- fungsi berikut.
\[ f(x) = 4x^2 - 3x - 7 \]
<- expression(4*x^2-3*x-7)
fx newtonr(fx,3)
## [1] 0.375
\[ f(x) = e^{-x}+x^4 \]
<- expression(exp(-x)+x^4)
fx newtonr(fx)
## [1] 0.5282519
\[ f(x) = x^2 - x \]
<- expression(x^2-x)
fx newtonr(fx)
## [1] 0.5
9.2.3 Fungsi Optimasi Build-in
Algoritma Nelder Mead adalah salah satu metode optimasi untuk fungsi yang memiliki lebih dari satu variabel. Di dalam R, fungsi optimasi dengan salah satu algoritma tersebut adalah
optimize
atauoptimise
untuk menduga parameter/ mencari nilai minimum dari satu peubahoptim
untuk lebih dari satu peubah
9.2.3.1 Fungsi optimize/optimise
\[ f(x) = \left( x - \frac{1}{3} \right)^2 \]
<- function(x) ((x-(1/3))^2) # membuat fungsi tujuan
f curve(f)
<- optimize(f, c(0,1), tol=0.0001) # tolerance optional
xmin xmin
## $minimum
## [1] 0.3333333
##
## $objective
## [1] 0
Carilah titik maksimum dan minimum dari fungsi berikut:
\[ f(x) = \mathrm{sin}(x) + \mathrm{sin}(2x) + \mathrm{cos}(3x) \]
<- function(x) sin(x) + sin (2*x) + cos(3*x)
f3 curve(f3, from =0, to = 2* pi)
optimize(f3, interval = c(0, 2*pi)) #minimum lokal
## $minimum
## [1] 3.033129
##
## $objective
## [1] -1.054505
optimize(f3, interval = c(4, 2*pi)) #minimum global
## $minimum
## [1] 5.273383
##
## $objective
## [1] -2.741405
optimize(f3, interval = c(0, 2*pi), maximum = T) #maksimum lokal
## $maximum
## [1] 4.0598
##
## $objective
## [1] 1.096473
optimize(f3, interval = c(0, 1.5), maximum = T) #maksimum global
## $maximum
## [1] 0.3323289
##
## $objective
## [1] 1.485871
9.2.3.2 Fungsi optim
Digunakan untuk mencari nilai minimum dari fungsi yang lebih dari satu peubah. Contoh mencari nilai \(x_1\) dan \(x_2\), yang mebuat \(f(x_1,x_2) = 100(x_2 - x_1^2)^2 + (1-x_1)^2\)
<- function (x){ # tetap dituliskan dalam sebuah vektor, akan diduga x
fr <- x[1]
x1<- x[2]
x2 100 * (x2-x1^2)^2 + (1-x1)^2} # ini adalah nilai fungsi objetivenya
optim (c(-1.2,1),fr) # argumen pertama adalah nilai inisial, karena menduga x vektor berukuran 2 maka dimasukkan nilai inisialnya
## $par
## [1] 1.000260 1.000506
##
## $value
## [1] 0.00000008825241
##
## $counts
## function gradient
## 195 NA
##
## $convergence
## [1] 0
##
## $message
## NULL
optim(par=2, fn=f3)
## $par
## [1] 3.033154
##
## $value
## [1] -1.054505
##
## $counts
## function gradient
## 32 NA
##
## $convergence
## [1] 0
##
## $message
## NULL
optim(par=4, fn=f3)
## $par
## [1] 5.273389
##
## $value
## [1] -2.741405
##
## $counts
## function gradient
## 32 NA
##
## $convergence
## [1] 0
##
## $message
## NULL
Jika akan mencari nilai maksimum, maka function dikali -1.
<- function(x) -1 * f3(x)
f3a optim(par=4, fn=f3a)
## $par
## [1] 4.059814
##
## $value
## [1] -1.096473
##
## $counts
## function gradient
## 28 NA
##
## $convergence
## [1] 0
##
## $message
## NULL
optim(par=5.5, fn=f3a)
## $par
## [1] 6.615576
##
## $value
## [1] -1.485871
##
## $counts
## function gradient
## 28 NA
##
## $convergence
## [1] 0
##
## $message
## NULL
optim(par=1, fn=f3a)
## $par
## [1] 0.3323242
##
## $value
## [1] -1.485871
##
## $counts
## function gradient
## 32 NA
##
## $convergence
## [1] 0
##
## $message
## NULL
Fungsi polinomial
\[ f(x) = 4x^4 - 2x^3 - 3x \]
<- function(x) 4*x^4-2*x^3-3*x
f4 curve(f4, from = -1, to = 1.5)
optim(par = c(-0.5), fn = f4)
## $par
## [1] 0.728418
##
## $value
## [1] -1.832126
##
## $counts
## function gradient
## 36 NA
##
## $convergence
## [1] 0
##
## $message
## NULL
9.2.4 Metode Kuadrat Terkecil dengan Optim
Metode kuadrat terkecil pada regresi adalah mencari parameter \(\beta\) sehingga jumlah kuadrat sisaan adalah minimum. Jadi meminimumkan dari fungsi kuadrat sisaan. Sehingga objective function-nya adalah kuadrat sisaan.
<- function (para,y,x){
f <- cbind (1,x)
X <- X %*% as.matrix(para)
yhat <- sum((y-yhat)^2) # kuadrat sisaan
sisa2 return(sisa2) }
# simulasi
<- runif (10,1,10)
x1 <- runif (10,1,10)
x2 <- rnorm (10,0,0.5)
galat <- 1+2*x1+3*x2+galat # untuk menduga nilai beta y
<- optim (c(1,1,1),f,y=y,x= cbind (x1,x2))
hasil $par hasil
## [1] 1.622219 1.925578 2.984449
lm(y~x1+x2)
##
## Call:
## lm(formula = y ~ x1 + x2)
##
## Coefficients:
## (Intercept) x1 x2
## 1.622 1.926 2.984
Contoh:
Lakukan pendugaan paramater regresi dengan meminimumkan jumlah kuadrat galat (residual sum of square) dari data berikut! Kemudian bandingkan hasilnya dnegan output fungsi lm
!
x | y |
---|---|
1 | 1 |
2 | 3 |
3 | 5 |
4 | 6 |
5 | 8 |
6 | 12 |
=data.frame(x=c(1,2,3,4,5,6),
data5y=c(1,3,5,6,8,12))
<- function(data, b) {
JKG with(data, sum((b[1]+b[2]*x-y)^2))}
<- optim(par = c(1,1), fn = JKG, data = data5)
hasil1 <- lm(y~x, data = data5)
hasil2
plot(data5)
abline(hasil1$par,col=4)
$par hasil1
## [1] -1.266302 2.028449
$coefficients hasil2
## (Intercept) x
## -1.266667 2.028571
$value hasil1
## [1] 2.819048
sum(hasil2$residuals^2)
## [1] 2.819048
# Menggunakan fungsi LM
<- lm(y~x, data=data5)
model1 summary(model1)
##
## Call:
## lm(formula = y ~ x, data = data5)
##
## Residuals:
## 1 2 3 4 5 6
## 0.2381 0.2095 0.1810 -0.8476 -0.8762 1.0952
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.2667 0.7815 -1.621 0.180388
## x 2.0286 0.2007 10.109 0.000539 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8395 on 4 degrees of freedom
## Multiple R-squared: 0.9623, Adjusted R-squared: 0.9529
## F-statistic: 102.2 on 1 and 4 DF, p-value: 0.000539
9.2.5 MLE (Maximum Likelihood Estimator)
Metode ini adalah metode yang paling sering digunakan untuk menduga parameter sebaran. Mencari nilai maksimum dari suatu fungsi tujuan yang berupa fungsi likelihood-nya. Untuk mendapatkan likelihood merupakan perkalian dari fungsi sebaran, lebih mudah menduga teta dengan mentransformasi fungsi likelihood menjadi negatif log likelihood
Sebagai contoh, jika \(x_1, x_2, ..., x_n\) berasal dari peubah acak \(X \sim N(\mu, \sigma)\), tentukan penduga \(\mu\) dan \(\sigma\) menggunakan MLE. Jika log likehood saja meminimumkan, maka menjadi negatif log likelihood suapaya dimaksimumkan.
<- function (para,xd){
negloglik <- -1* sum (dnorm (xd, mean =para[1], sd=para[2], log= TRUE)) # penjumlahan fungsi likelihood distribusi normal
nilai return (nilai)
}
<- rnorm (10,2,5)
x
<- optim (c(1,1),negloglik,xd=x)
hasil cat ("Hasil MLE:", hasil $par)
## Hasil MLE: 0.1836094 4.720975
c(mean(x), sd(x)) # pembanding
## [1] 0.1854109 4.9775375
Pendugaan untuk regresi linear dengan menggunakan metode kemungkinan maksimum.
Sebagai contoh, akan diduga parameter dari regresi linear sederhana dengan menggunakan MLE. Contoh soal sebelumnya akan digunakan kembali.
<- matrix(c(1,2,3,4,5,6))
x <- matrix(c(1,3,5,6,8,12))
y
<- cbind(1,x) # membuat maxtrix [1 x1] X
Fungsi log likelihood dari Regresi Linear Sederhana adalah sebagai berikut:
\[ \mathrm{log}L(\beta_0, \beta_1, \sigma^2) = -\frac{n}{2}\mathrm{log}(2\pi) - \frac{n}{2}\mathrm{log}(\sigma^2) - \frac{1}{2\sigma^2}\sum_{i=1}^n (y_i - \beta_0 - \beta_1x_i)^2 \]
Cara pertama:
<- function (beta, y, X) {
regloglik <- nrow(X) # jumlah baris pada matrix x
n <- ncol(X) # jumlah kolom pada matrix x
k <- beta[1]
beta0 <- beta[2]
beta1 <- beta[3]
var.lin <- y - X %*% beta[1:2] # menghitung sisaan
e <- -0.5*n*log(2*pi) - 0.5*n*log(var.lin) - ((t(e)%*%e)/(2*var.lin))
logl return(-logl)
}
<- optim(c(1,1,1), regloglik, y=y, X=X)
par.reg $par par.reg
## [1] -1.2669724 2.0286218 0.4698408
Cara kedua:
<- function (para,y, x){
regloglik # fungsi terdiri dari 3 parameter dalam argumen para
# beta0 = para [1]
# beta1 = para [2]
# sigma = para [3]
# nilai tengah dari regresi linear adalah beta0 + b1x1
# standar deviasi adalah sigma
<- -1* sum (dnorm (y, mean =para[1]+ x*para[2], sd=para[3], log= TRUE))
nilai return (nilai)
}
=c(1,2,3,4,5,6)
x=c(1,3,5,6,8,12)
y
<- optim (c(1,1,1),regloglik,y =y, x=x)
hasil cat ("Hasil MLE:", hasil $par)
## Hasil MLE: -1.266469 2.028513 0.6853899
Ref (Raharjo 2021a) (Soleh 2021a) (Rahmi 2021a)