Functions on R

Pemrograman Fungsi di R

Membuat Fungsi

Fungsi yang tidak ada dalam R karena berkembangnya statistika dapat diciptakan sendiri dengan struktur syntax berikut: namafungsi <- function (argumen) isifungsi isifungsi merupakan satu objek data. Jika membutuhkan beberapa baris dapat dikelompokan dengan {} dan diakhiri dengan satu objek data. Misal akan dibuat fungsi yang dapat mengeluarkan hasil kuadrat

kuadrat <- function(x) {x^2}
kuadrat(10)

## [1] 100

Pada output diatas merupakan hasil kuadrat dari bilangan input yaitu kudarat dari 10 adalah 100. isi fungsi merupakan x^2 dan argumen yang digunakan adalah x sedangkan nama fungsinya adalah kuadrat

Penanganan Kesalahan

Menangani kesalahan dalam fungsi disediakan fungsi-fungsi seperti warning, stop, try dan tryCatch. Misal akan dibuat fungsi pemain sepak bola dengan fungsi penanganan kesalahan stop. Jika terdapat kesalahan kriteria tidak terpenuhi maka fungsi stop akan menghentikan eksekusi dan muncul pesan kesalahan

football.player<-function(Nama,Atc,Def,Spd,Str,Stm) #Membuat fungsi yang diberi nama football.player yang berisi Nama, Atc, Def, Spd, Str, Stm
{ 
  if((Atc*Def*Spd*Str*Stm)<0) #Membuat fungsi bersyarat atau conditional function (if) dimana (Atc*Def*Spd*Str*Stm) kurang dari 0
  stop("Kriteria tidak terpenuhi karena ada skor yang negatif...") #Jika kriteria terpenuhi, maka akan distop dengan pesan "Kriteria tidak terpenuhi karena ada skor yang negatif..."
  player=list(Atc=Atc,Def=Def,Spd=Spd,Str=Str,Stm=Stm) #Jika memenuhi kriteria maka akan dibuat list dengan nama player yang berisi Nama, Atc, Def, Spd, Str, Stm
  class(player)="football.player" #Menamai kelas player menjadi football.player
  player #Menampilkan player
}

p2<-football.player(Nama="Dayat",Atc=10,Def=89,Spd=40,Str=88,Stm=90) #Mennjalankan fungsi football.player dengan argumen (Nama="Dayat",Atc=-10,Def=89,Spd=40,Str=88,Stm=90)

Pada output diatas akan muncul pesan “Kriteria tidak terpenuhi karena ada skor yang negatif…” jika ada input yang tidak sesuai yaitu skor bernilai negatif sehingga fungsi stop nantinya akan menghentikan eksekusi

Pemrograman Berorientasi Objek

Misal akan dibuat vektor A dengan angka 1 sampai 10, lalu akan mencari tahu tipe data vektor A. Dan dicek apakah A adalah vektor dan apakah A adalah objek. Selain itu, akan dibuat array dengan nama arai dan dicek kelas dari arai dan tipe arai, apakah matriks, objek, atau array.

A<-c(1:10)   #dibuat vektor bernama A angka 1 sampai 10
typeof(A)    #Mencari tahu tipe data vektor A

## [1] "integer"

is.vector(A) #dicek apakah A adalah vektor, karna A adalah vektor maka output TRUE

## [1] TRUE

is.object(A) #dicek apakah A adalah object, A bukan objek sehingga output FALSE

## [1] FALSE

arai<-array(c(1:10),c(2,5)) #Membuat array bernama arai  berukuran 2x5 angka 1 sampai 10
typeof(arai) #Mencari tau tipe array arai

## [1] "integer"

class(arai)  #Mencari tau kelas dari array arai

## [1] "matrix" "array"

is.matrix(arai) #dicek apakah matriks arai adalah matriks, karna arrai adalah matriks array maka output TRUE

## [1] TRUE

is.array(arai)  #dicek apakah matriks arai adalah array, karna arrai adalah matriks array maka output TRUE

## [1] TRUE

is.object(arai) #dicek apakah matriks arai adalah object, arrai bukan objek sehingga output FALSE

## [1] FALSE

Output diatas menunjukkan bahwa A merupakan tipe data integer, dan merupakan vektor dan bukan suatu objek. Sementara itu, tipe dari arai adalah suatu matrix dan array, namun arai juga bukan suatu objek

Contoh lain, untuk vektor a berisi angka 1:12 dan vektor b berisi huruf kecil a (huruf pertama) sampai l (huruf ke dua belas), lalu kedua vektor tersebut digabung menjadi dataframe, dan akan dilihat tipe dan kelas dari dataframe tsb, dan apakah dataframe tsb merupakan suatu objek. Selain itu, dibuat suatu linear model dari peubah respon y dan vektor a, lalu dilihat ipe dan kelas dari linear model tsb, dan apakah linear model tsb merupakan suatu objek.

a<-1:12          #Membuat vektor a berisi angka 1 sampai 12
b<-letters[1:12] #Membuat vektor b berisi huruf kecil a (huruf pertama) sampai l (huruf ke dua belas)
data1<-data.frame(a,b) #Menggabungkan vektor a dan vektor b menjadi data frame bernama data1
typeof(data1) #Mencari tahu tipe data1

## [1] "list"

class(data1)  #Mencari tahu kelas data1

## [1] "data.frame"

is.object(data1) #dicek apakah data1 adalah object, data1 adalah objek sehingga output TRUE

## [1] TRUE

#NOTE : Agar dianggap sbg. object oleh R, tipe (typeof) data setidaknya berbentuk list.
#Tingkatan tipe data dalam R (rendah ke tinggi): vector < matriX < array < list < data frame

set.seed(54)  #ditetapkan set.seed 54 dimana set.seed digunakan untuk membangkitkan bilangan acak yang jika di run berkali-kali hasilnya tetap sama 
y<-10+a+rnorm(12) #Membuat vektor y yang merupakan jumlah dari 10 ditambah vektor a ditambah bilangan acak berdistribusi normal sebanyak 12
f.y<-lm(y~a) #Membuat linear modeling dengan nama f.y dimana y sebagai peubah respon dan a sebagai peubah penjelas
typeof(f.y)  #Mencari tau tipe f.y

## [1] "list"

class(f.y)   #Mencari tau kelas f.y

## [1] "lm"

is.object(f.y) #dicek apakah f.y adalah object, f.y adalah objek sehingga output TRUE

## [1] TRUE

ls(f.y)      #Mengeluarkan nama-nama object di dalam f.y

##  [1] "assign"        "call"          "coefficients"  "df.residual"  
##  [5] "effects"       "fitted.values" "model"         "qr"           
##  [9] "rank"          "residuals"     "terms"         "xlevels"

Output diatas menunjukan bahwa tipe data1 merupakan list dan kelas nya adalah dataframe, data1 meerupakan suatu objek. Karena agar dianggap sbg. object oleh R, tipe (typeof) data setidaknya berbentuk list. Tingkatan tipe data dalam R (rendah ke tinggi): vector < matriX < array < list < data frame. Sementara itu, untuk linear model f.y merupakan tipe list dan kelas lm dan juga merupakan suatu objek. Nama-nama objek dalam linear model f.y tersebut ada sebanyak 12 dari assign hingga xlevels.

Pemrograman Berorientasi Objek S3

Misal akan dibuat kelas coordinates dan football.player sebagai berikut. Fungsi class digunakan untuk menjadikan sebuah objek menjadi class yang diinginkan

pts<-list(x=round(rnorm(5),2), #Membuat list dari gabungan 2 vektor X dan Y bernama pts dimana keduanya bilangan acak 
        y=round(rnorm(5),2))     #yang menyebar normal dengan pembulatan 2 angka di belakang koma
class(pts)<-"coordinates"      #Menamai kelas pts menjadi coordinates
pts  #Memanggil pts

## $x
## [1] -0.22  0.48 -2.23 -1.30  0.29
## 
## $y
## [1] -0.32 -0.81  1.12 -1.82  0.40
## 
## attr(,"class")
## [1] "coordinates"

p1<-list(Nama="Gio",Atc=0,Def=50,Spd=45,Str=100,Stm=99) #Membuat list p1 yang berisi Nama, Atc, Def, Spd, Str, Stm
class(p1)<-"football.player"  #Menamai kelas p1 menjadi football.player
p1 #Memanggil p1

## $Nama
## [1] "Gio"
## 
## $Atc
## [1] 0
## 
## $Def
## [1] 50
## 
## $Spd
## [1] 45
## 
## $Str
## [1] 100
## 
## $Stm
## [1] 99
## 
## attr(,"class")
## [1] "football.player"

p2<-list(Nama="Dayat",Atc=10,Def=89,Spd=86,Str=98,Stm=90) #Membuat list p2 yang berisi Nama, Atc, Def, Spd, Str, Stm
class(p2)<-"football.player"  #Menamai kelas p2 menjadi football.player
p2 #Memanggil p2

## $Nama
## [1] "Dayat"
## 
## $Atc
## [1] 10
## 
## $Def
## [1] 89
## 
## $Spd
## [1] 86
## 
## $Str
## [1] 98
## 
## $Stm
## [1] 90
## 
## attr(,"class")
## [1] "football.player"

Akan tetapi membuat kelas dengan cara seperti diatas tidak dianjutkan. Lebih baik dengan fungsi konstruktor sebagai berikut

#Fungsi Konstruktor
football.player<-function(Nama,Atc,Def,Spd,Str,Stm) #Membuat fungsi yang diberi nama football.player yang berisi Nama, Atc, Def, Spd, Str, Stm
{ 
  if((Atc*Def*Spd*Str*Stm)<0) #Membuat fungsi bersyarat atau conditional function (if) dimana (Atc*Def*Spd*Str*Stm) kurang dari 0
  stop("Kriteria tidak terpenuhi karena ada skor yang negatif...") #Jika kriteria terpenuhi, maka akan distop dengan pesan ""Punteun slur ngga bisa, ada skor negatif tuh...""
  player=list(Atc=Atc,Def=Def,Spd=Spd,Str=Str,Stm=Stm) #Jika tidak terpenuhi kriteria akan dibuat list dengan nama player yang berisi Nama, Atc, Def, Spd, Str, Stm
  class(player)="football.player" #Menamai kelas player menjadi football.player
  player #Menampilkan player
}

p2<-football.player(Nama="Dayat",Atc=10,Def=89,Spd=40,Str=88,Stm=90) #Mennjalankan fungsi football.player dengan argumen (Nama="Dayat",Atc=-10,Def=89,Spd=40,Str=88,Stm=90)
# yang di assign ke  p2 namun terdapat eror karena ada skor negatif

coordinates<-function(x,y) #Membuat fungsi bernama coordinates yang berisi argumen berupa x dan y
{
  if( !is.numeric(x) || !is.numeric(y) || !all(is.finite(x)) || !all(is.finite(y)) ) #Membuat sebuah kriteria dimana x bukan numerik atau y bukan numerik atau x memiliki nilai tak terhingga atau y memiliki nilai tak terhingga
    stop("Invalid coordinates") #Stop jika memenuhi kriteria dan diberi pesan "Invalid coordinates"
  if(length(x) != length(y)) #Membuat kriteria jika panjang x tidak sama dengan panjang y
    stop("Kriteria tidak terpenuhi karena panjang x tidak sama dengan panjang y...") #Jika kriteria terpenuhi, makan akan distop dan muncul pesan "Kriteria tidak terpenuhi karena panjang x tidak sama dengan panjang y..."
  pts=list(x=x,y=y) #Membuat list terdiri dari x dan y yang di assign ke pts
  class(pts)="coordinates" #Menamai kelas pts dengan nama coordinates
  pts #Menampilkan pts
}

Pada output diatas, jika ada input nilai tidak sesuai dengan kriteria maka nantinya akan mengeluarkan pesan dan akan menghentikan ekseskusi.

Selanjutnya, jika ingin dibuat fungsi aksesor untuk kelas coordinates digunakan sintaks berikut

set.seed(54) #Melakukan set.seed 54
pts<-coordinates(x=round(rnorm(5)), y=round(rnorm(5)))            
pts$x #Memanggil x dari pts

## [1] 2 0 0 2 1

pts$y #Memanggil y dari pts

## [1] -1  0 -1  2  1

#Fungsi aksesor untuk coordinates
coordinates.x<-function(apa) apa$x #Membuat fungsi dengan nama coordinates.x dan dengan hasil akan menampilkan x
coordinates.y<-function(apa) apa$y #Membuat fungsi dengan nama coordniates.y dan dengan hasil akan menampilkan y

coordinates.x(pts) #Memanggil pts$x dengan fungsi coordinates.x

## [1] 2 0 0 2 1

coordinates.y(pts) #Memanggil pts$y dengan fungsi coordinates.y

## [1] -1  0 -1  2  1

fungsi aksesor diperlukan untuk mengakses data pada class coordinates

Selanjutnya, dibuat fungsi generik yang merupakan suatu method dari suatu class objek dalam R sebagai berikut

print.coordinates<-function(obj) #Membuat fungsi dengan print.coordinates dengan sebuah input yaitu obj
{
  print(paste0("(",format(coordinates.x(obj)), #Membuat perintah print dengan hasil berupa pasangan koodinat (x,y)
             ",",
             format(coordinates.y(obj)),
             ")"),quote=F)
}

print(pts) #Melakukan fungsi print pada pts

## [1] (2,-1) (0, 0) (0,-1) (2, 2) (1, 1)

typeof(print) #Mencari tau tipe dari print

## [1] "closure"

bbox<-function(obj){ #Membuat fungsi dengan nama bbox dengan input obj
    UseMethod("bbox")} #Menentukan metode bbox yang akan digunakan
is.function(bbox) #Mengecek apakah bbox sebuah fungsi

## [1] TRUE

typeof(bbox) #Mencari tahu tipe dari bbox

## [1] "closure"

bbox.coordinates<-function(obj){      #Membuat fungsi dengan nama bbox.coordinates dengan input obj
  matrix(c(range(coordinates.x(obj)), #Membuat matriks yang berisi range x dan range y (berarti menampilkan nilai max min pts dari x dan y)
         range(coordinates.y(obj))),
       nc=2,                            #Matriks berukuran kolom 2
       dimnames=list(                   #Memberi nama baris dan kolom pada matriks
        c("min","max"),                   #Memberi nama baris min max
        c("x:","y:")))                    #memberi nama kolom x y
}

bbox.coordinates(pts)                 #Menjalankan fungsi bbox.coordinates dengan input pts

##     x: y:
## min  0 -1
## max  2  2

Method print merupakan cara untuk menampilkan data pada suatu objek Class System S3 dan method bbox merupakan boundary box.

Diinginkan sebuah objek yang berisi lokasi (coordinates) dan terdapat nilai pada lokasi tersebut Diperlukan menciptakan class baru vcoords sebagai turunan dari coordinates. Fungsi konstruktor dari class vcoords:

vcoords <- function(x, y, v) {
  if (!is.numeric(x) || !is.numeric(y)
      || !is.numeric(v) || !all(is.finite(x)) || !all(is.finite(y)))
    stop("Titik koordinat tidak tepat!")
  if (length(x) != length(y) ||
                                             length(x) != length(v) )
      stop("Panjang koordinat berbeda")
pts <- list(x=x, y=y, v=v) 
class(pts) = c("vcoords", "coordinates") 
pts
}
nilai <- function(apa) apa$v

Method print juga masih diwariskan dari class coordinates tetapi perlu didefinisi ulang

vpts=vcoords(x = round(rnorm(5)), y = round(rnorm(5)),
                v = round(rnorm(5)))
coordinates.x(vpts)

## [1]  2  0  0  0 -2

coordinates.y(vpts)

## [1] -1  0  0 -1  1

print.vcoords <- function(apa) {
  print(paste("(",
              format(coordinates.x(apa)),
              ", ", 
              format(coordinates.y(apa)),
              "; ", 
              format(nilai(apa)), ")", sep=""),
                                          quote=FALSE)
}
vpts

## [1] ( 2, -1; -2) ( 0,  0;  0) ( 0,  0;  0) ( 0, -1;  1) (-2,  1;  1)

Pemrograman Berorientasi Objek S4

Class System S4: Mengatasi masalah dalam Class System S3 dengan sistem objek lebih formal. Misal akan dibuat kelas TransportasiUmum

setClass("TransportasiUmum", representation(Nama="character",
                               Panjang="numeric", Lebar="numeric", Kecepatan="numeric"))
TransportasiUmum1 <- new("TransportasiUmum", Nama="Bis", Panjang=6.5, Lebar=2.5,
            Kecepatan=180)

TransportasiUmum <- function(Nama,Panjang,Lebar,Kecepatan){ if(Panjang<6 || Lebar<2 || Kecepatan<80)
  stop("atribut tidak sesuai") 
  new("TransportasiUmum", Nama=Nama, Panjang=Panjang,
                                   Lebar=Lebar, Kecepatan=Kecepatan)
}
TransportasiUmum2 <- TransportasiUmum("Kereta", 11.4, 4.8, 150) 
class(TransportasiUmum2)

## [1] "TransportasiUmum"
## attr(,"package")
## [1] ".GlobalEnv"

nama1 <- function(objek) objek@Nama 
kecepatan1 <- function(objek) objek@Kecepatan
nama1(TransportasiUmum1)

## [1] "Bis"

kecepatan1(TransportasiUmum2)

## [1] 150

Sintaks diatas adalah fungsi konstruktor dan aksesor. Akan tetapi tidak disarankan menggunakan fungsi aksesor seperti diatas. Sebaiknya seperti berikut

Nama <- function(obj) obj@Nama
Lebar <- function(obj) obj@Lebar
Panjang <- function(obj) obj@Panjang
Kecepatan <- function(obj) obj@Kecepatan
Nama(TransportasiUmum1)

## [1] "Bis"

Selanjutnya untuk fungsi generik show pada S4 setara dengan fungsi generik print pada class System S3. Penciptaan fungsi generik menggunakan fungsi setMethod sebagai berikut

setMethod(show, "car", function(object) { 
  print(cat("Nama : ", nama1(object), "\n","Kecepatan : ", kecepatan1(object), sep="")
)} )

## in method for 'show' with signature '"car"': no definition for class "car"

  TransportasiUmum2

## An object of class "TransportasiUmum"
## Slot "Nama":
## [1] "Kereta"
## 
## Slot "Panjang":
## [1] 11.4
## 
## Slot "Lebar":
## [1] 4.8
## 
## Slot "Kecepatan":
## [1] 150

Optimasi Secara Numerik

Fungsi Kalkulus

R memiliki fungsi-fungsi untuk mendapatkan turunan dari suatu fungsi Fungsi yang digunakan merupakan fungsi dengan satu peubah

xfs <- expression(1/2*x^2+3*x)
D(xfs ,"x")

## 1/2 * (2 * x) + 3

xturunan <- deriv(~1/2*x^2+3*x,"x") 
x <- 2
eval(xturunan)

## [1] 8
## attr(,"gradient")
##      x
## [1,] 5

Fungsi Kalkulus Integral adalah sebagai berikut

fs <- function(x) (1/2*x^2+3*x)
 integrate(fs,0,1)

## 1.666667 with absolute error < 1.9e-14

Optimasi Numerik Golden Section dan Newton Raphson

Golden Section membutuhkan 2 nilai sebagai selang untuk nilai awal dan fungsi dari nilai minimum yang dicari tidak harus memiliki turunan sedangkan newton raphson perlu 1 nilai sebagai nilai awal dan harus memiliki turunan pada fungsi

golden <- function (f, a, b,tol = 0.0000001) {
  ratio <- 2 / (sqrt(5)+1)
  x1 <- b - ratio * (b - a)
  x2 <- a + ratio * (b - a)
  f1 <- f(x1)
  f2 <- f(x2)
  while(abs(b - a) > tol) {
    if (f2 > f1) {
      b <- x2
      x2 <- x1
      f2 <- f1
      x1 <- b - ratio * (b - a)
      f1 <- f(x1)
    } else {
      a <- x1
      x1 <- x2
      f1 <- f2
      x2 <- a +ratio * (b - a)
      f2 <- f(x2)
    }
  }
  return((a + b) / 2)
}
f <- function(x) {
   (1/2*x^2+3*x)}
golden(f,1,2)

## [1] 1

golden(f,1,5)

## [1] 1

golden(f,3,5)

## [1] 3

newtonr <- function (fx, x0=1){
  fx1 <- deriv(fx,"x") # turunan pertama
  fx2 <- deriv(D(fx,"x"),"x") # turunan kedua
  e <- 1000
  while (e>1e-6){
    x <- x0
    f1 <- attr(eval(fx1),"gradient")[1]
    f2 <- attr(eval(fx2),"gradient")[1]
    e <- abs(f1)
    x1 <- x0 - f1/f2
    x0 <- x1
  }
  return(x1)
}
fx <- expression( (1/2*x^2+3*x))
newtonr(fx,3)

## [1] -3

fx <- expression(exp(-x)*2 + x^3)
newtonr(fx)

## [1] 0.6037442

fx <- expression(x^2 - x*2) 
newtonr(fx)

## [1] 1

Optimasi Numerik Optim dan Optimize

Optim diperlukan jika ingin mencari nilai minimum lebih dari 1 peubah sedangkan optimize hanya untuk 1 puebah

f3 <- function(x) sin(2*x) + cos(x) + cos(3*x) 
curve(f3, from = 0, to = 2*pi)

optimize(f3, interval = c(0, 2*pi)) #minimum global

## $minimum
## [1] 2.946647
## 
## $objective
## [1] -2.194948

optimize(f3, interval = c(4, 2*pi)) #minimum lokal

## $minimum
## [1] 5.247153
## 
## $objective
## [1] -1.366775

optimize(f3, interval = c(0, 2*pi), maximum = T) #maksimum lokal

## $maximum
## [1] 4.177617
## 
## $objective
## [1] 1.366775

optimize(f3, interval = c(0, 1), maximum = T) #maksimumglobal

## $maximum
## [1] 0.1949419
## 
## $objective
## [1] 2.194948

optim(par=2,fn=f3) #minimum global

## Warning in optim(par = 2, fn = f3): one-dimensional optimization by Nelder-Mead is unreliable:
## use "Brent" or optimize() directly

## $par
## [1] 2.946655
## 
## $value
## [1] -2.194948
## 
## $counts
## function gradient 
##       34       NA 
## 
## $convergence
## [1] 0
## 
## $message
## NULL

optim(par=4,fn=f3) #minimum lokal

## Warning in optim(par = 4, fn = f3): one-dimensional optimization by Nelder-Mead is unreliable:
## use "Brent" or optimize() directly

## $par
## [1] 5.247266
## 
## $value
## [1] -1.366775
## 
## $counts
## function gradient 
##       28       NA 
## 
## $convergence
## [1] 0
## 
## $message
## NULL

#cari max
f3a=function(x) -1*f3(x)
optim(par=0.1,fn=f3a) #maksimum global

## Warning in optim(par = 0.1, fn = f3a): one-dimensional optimization by Nelder-Mead is unreliable:
## use "Brent" or optimize() directly

## $par
## [1] 0.1949219
## 
## $value
## [1] -2.194948
## 
## $counts
## function gradient 
##       26       NA 
## 
## $convergence
## [1] 0
## 
## $message
## NULL

optim(par=5,fn=f3a) #maksimum lokal

## Warning in optim(par = 5, fn = f3a): one-dimensional optimization by Nelder-Mead is unreliable:
## use "Brent" or optimize() directly

## $par
## [1] 6.478149
## 
## $value
## [1] -2.194948
## 
## $counts
## function gradient 
##       32       NA 
## 
## $convergence
## [1] 0
## 
## $message
## NULL

f4 <- function(x) 1/2*x^2+3*x 
curve(f4, from = -1, to = 1.5) #utk buat kurva

optim(par = c(-0.5), fn = f4)

## Warning in optim(par = c(-0.5), fn = f4): one-dimensional optimization by Nelder-Mead is unreliable:
## use "Brent" or optimize() directly

## $par
## [1] -2.8
## 
## $value
## [1] -4.48
## 
## $counts
## function gradient 
##       14       NA 
## 
## $convergence
## [1] 0
## 
## $message
## NULL

Output diatas menunjukan beberapa titik maksimum dan minimum baik pada secara global maupun pada lokal tergantung dari nilai awal yang dimasukan.

Contoh lain, optim dan optimize dapat digunakan untuk menduga nilai myu dan sigma dari x

#Duga parameter [mu] dari x ini dengan metode likelihood menggunakan optimize/optimise.
likelihood1=function(myu) {
  -sum((dnorm(x,mean=myu,sd=1,log=T)))
}
optimize(likelihood1, c(0, 1.5),
         tol = 0.0001)

## $minimum
## [1] 1.499939
## 
## $objective
## [1] 1.043969

negloglik <- function(para,xd){
   nilai <- -1*sum(dnorm(xd,mean=para[1],sd=para[2],log=
                            TRUE))
   return(nilai)}
x <- rnorm (10 ,2 ,5)
hasil <- optim(c(1,1),negloglik ,xd=x)
hasil$par

## [1] 2.512628 4.359998

c(mean(x),sd(x)) # pembanding [1] 2.007466 4.411680

## [1] 2.511445 4.595142

Contoh lain, penggunaan optim dan optimize untuk menduga nilai minimum dari suatu fungsi adalah sebagai berikut

f <- function (x, a) (x - a) ^2 + exp(a)
xmin <- optimize(f, c(0, 1),  tol = 0.0001, a = 1/2)
xmin

## $minimum
## [1] 0.5
## 
## $objective
## [1] 1.648721

fr <- function(x) {
    x1 <- x[1]
    x2 <- x[2]
    33 * (x2 - x1^2)^2 +(1-x1)^2
 }
optim(c(-1.2,1), fr)

## $par
## [1] 0.9999954 0.9999652
## 
## $value
## [1] 2.163824e-08
## 
## $counts
## function gradient 
##      117       NA 
## 
## $convergence
## [1] 0
## 
## $message
## NULL

Penggunaan Optim untuk Menduga Nilai Koefisien Regresi

Berikut adalah beberapa contoh penggunaan optim dan optimize pada metode kuadrat terkecil

f <- function(para, y, x){
  X <- cbind(1,x)
yhat <- X %*% as.matrix(para) 
sisa2 <- sum((y-yhat)^2) 
return(sisa2)
}
x1=runif (10 ,1 ,10)
x2= runif (10 ,1 ,10)
galat=rnorm (10 ,0 ,0.5)
y <- 1 + 3*x1 + 3*x2 + galat
hasil <- optim(c(1,1,1),f,y=y,x=cbind(x1,x2))
hasil$par

## [1] 0.9962467 2.9854128 2.9850463

lm(y~x1+x2)

## 
## Call:
## lm(formula = y ~ x1 + x2)
## 
## Coefficients:
## (Intercept)           x1           x2  
##      0.9925       2.9860       2.9850

Penggunaan optim juga bisa pada metode kemungkinan maksimum untuk menduga koefisien beta

regloglik <- function(para,y,x){
  X=cbind(1,x)
  nilai <- -1*sum(dnorm(y,mean=X %*% as.matrix(para),sd=1,log=
                          TRUE))
  return(nilai)}
x1=runif (10 ,1 ,10)
x2= runif (10 ,1 ,10)
galat=rnorm (10 ,0 ,0.5)
y <- 1 + 3*x1 + 3*x2 + galat
hasil <- optim(c(1,1,1),regloglik,y=y,x=cbind(x1,x2))
hasil$par

## [1] -0.4966984  3.1778494  3.0689265

lm(y~x1+x2)

## 
## Call:
## lm(formula = y ~ x1 + x2)
## 
## Coefficients:
## (Intercept)           x1           x2  
##     -0.4965       3.1781       3.0688

Sumber

Sumber yang digunakan pada laman ini adalah materi mata kuliah dan praktikum Pemrograman Statistika pertemuan 6 dan 7