1. PEMROGRAMAN DAN FUNGSI OOP

Fungsi

Fungsi (function) dalam adalah kode-kode yang disusun untuk melakukan tugas tertentu, seperti perhitungan matematis, pembacaan data, analisis statistik, dan lain-lain. Fungsi yang tidak ada dalam R dapat diciptakan sendiri. Isi fungsi merupakan satu objek data. Jika membutuhkan beberapa baris dapat dikelompokan dengan {} dan diakhiri dengan satu objek data. Fungsi pada umumnya memiliki argumen. Argumen fungsi dalam R dapat:

diberikan sebuah nilai default
berulang/tidak didefinisikan pasti (menggunakan “…”)

Output/luaran dari fungsi adalah objek. Dapat secara langsung dituliskan objeknya atau menggunakan return. Jika luarannya memiliki mode berbeda, umumnya digunakan objek list.

Contoh 1

sapaan.pagi <- function ()
  print("selamat pagi")
sapaan.pagi()

## [1] "selamat pagi"

sapa.orang <- function(name)
  print(paste("Selamat Pagi,", name))
sapa.orang("May")

## [1] "Selamat Pagi, May"

Contoh 2

konv_Fahrenheit <- function (temp_F){
          Celcius <- (temp_F - 32)*5/9
          Kelvin <- Celcius + 273.15
          hasil <- cbind(Celcius, Kelvin)
          return (hasil)
          }
konv_Fahrenheit(120)

##       Celcius   Kelvin
## [1,] 48.88889 322.0389

Sintaks di atas membuat fungsi konversi temperatur Fahrenheit ke temperatur Celcius dan Kelvin.

Contoh 3

hitung<- function(x,y)
{
cat(sprintf("Penjumlahan %d + %d = %d\n", x,y,x+y))
cat(sprintf("Pengurangan %d - %d = %d\n", x,y,x-y))
cat(sprintf("Pembagian %d / %d = %d\n", x,y,x/y))
cat(sprintf("Perkalian %d * %d = %d\n", x,y,x*y))
}
hitung(10,2)

## Penjumlahan 10 + 2 = 12
## Pengurangan 10 - 2 = 8
## Pembagian 10 / 2 = 5
## Perkalian 10 * 2 = 20

Sintaks di atas membuat fungsi bernama hitung yang terdiri dari dua argumen x dan y. Fungsi tersebut digunakan untuk menjumlahkan, mengurangkan, membagikan, dan mengalikan antara kedua bilangan x dan y.

Contoh 4

sim.t <- function(n,mu=10,sigma=5) {
  X <- rnorm(n,mu,sigma)
  (mean(X) - mu)/(sd(X)/n)
}
sim.t(4) #menggunakan default

## [1] -3.107167

sim.t(4,3,10) # n=4,mu=3, sigma=10

## [1] -2.429221

sim.t(4,5) # n=4,mu=5,sigma default 5

## [1] 3.220332

sim.t(4,sigma=100) # n=4,mu default 10, sigma=100

## [1] 2.140503

sim.t(4,sigma=100,mu=1) #argumen berbeda dengan pengaturan fungsi

## [1] -1.414985

Sintaks di atas digunakan untuk membuat fungsi bernama sim.t untuk melakukan simulasi nilai t dari pembangkitan distribusi normal dengan argumen n sebagai jumlah data, mu= 10 sebagai rata-rata, dan sigma=5 sebagai standar deviasi. Berikut contoh penggunaan return value.

Contoh 5

angka_acak1=function(n,pw)
{ x=runif(n)
  y=runif(n)
  z=(x+y)^pw
  return(z)
}
angka_acak1(10,2)

##  [1] 0.9723010 1.0817560 0.2194884 2.3132489 1.4941111 0.9557486 0.7061084
##  [8] 0.2679405 2.1612323 0.3051653

Sintaks di atas digunakan untuk membuat fungsi dengan argumen n dan pw. Pada fungsi tersebut akan menghasilkan nilai z yang merupakan penjumlahan dari x dan y kemudian dipangkatkan dengan nilai pw. Pada fungsi ini nilai x dan y adalah pembangkitan bilangan acak uniform sebanyak n.

angka_acak2=function(n,pw)
{ x=runif(n)
y=runif(n)
z=(x+y)^pw
return(list(x=x,y=y,z=z))
}
set.seed(99); angka_acak2(10,2)

## $x
##  [1] 0.5847119 0.1137817 0.6842647 0.9925088 0.5349936 0.9666141 0.6714276
##  [8] 0.2945777 0.3583630 0.1753148
## 
## $y
##  [1] 0.54881739 0.50545170 0.19383647 0.63690411 0.68780009 0.64019077
##  [7] 0.35788536 0.10258500 0.09779092 0.18288626
## 
## $z
##  [1] 1.2848885 0.3834500 0.7710617 2.6549864 1.4952244 2.5818218 1.0594851
##  [8] 0.1577382 0.2080764 0.1283080

Sintaks di atas digunakan untuk membuat fungsi dengan argumen n dan pw. Pada fungsi tersebut akan menghasilkan list berupa nilai x, y, dan z. Nilai z yang merupakan penjumlahan dari x dan y kemudian dipangkatkan dengan nilai pw. Adapun nilai x dan y adalah pembangkitan bilangan acak uniform sebanyak n.

angka_acak3=function(n=10,pw=2)
{ x=runif(n)
  y=runif(n)
  z=(x+y)^pw
return(z)
}
angka_acak3()

##  [1] 0.5299979 0.1632382 1.3651631 1.2918624 0.6623991 0.6303300 0.4858673
##  [8] 2.6842154 0.3696226 1.3879950

Sintaks di atas digunakan untuk membuat fungsi dengan argumen n=10 dan pw=2. Pada fungsi tersebut akan menghasilkan nilai z yang merupakan penjumlahan dari x dan y kemudian dipangkatkan dengan nilai pw=2. Adapun nilai x dan y adalah pembangkitan bilangan acak uniform sebanyak 10.

angka_acak4=function()
{ x=runif(n)
y=runif(n)
z=(x+y)^pw
return(z)
}
n <- 5; pw <- 3
angka_acak4()

## [1] 5.6492197 0.6086377 1.7318828 3.5010998 0.2018488

Sintaks di atas digunakan untuk membuat fungsi tanpa argumen. Pada fungsi tersebut akan menghasilkan list berupa nilai z yang merupakan penjumlahan dari x dan y kemudian dipangkatkan dengan nilai pw. Adapun nilai x dan y adalah pembangkitan bilangan acak uniform sebanyak n. Karena fungsi tersebut tanpa argumen, maka sebelum memanggil fungsi tersebut harus didefinisikan terlebih dahulu nilai n dan pw agar fungsi dapat berjalan. Bila tidak didefinisikan, maka fungsi akan error.

Latihan 1

Berikut fungsi untuk mencari median dari suatu vektor.

med <- function(vect) {
  n <- length(vect)
  vects <- sort(vect)
  if(n%%2 == 1) {m <- vects[(n+1)/2]}
  else {m <- (vects[n/2]+vects[(n/2)+1])/2}
  return(m)
}
x1 <- c(1,5,3,7,3,4,2,7)
med(x1)

## [1] 3.5

Dari sintaks di atas, dibuat fungsi untuk mencari median dengan algoritma seperti berikut:

Fungsi terdiri dari argumen vect untuk menyatakan input data sebagai vektor.
Mendefinisikan n sebagai panjang vektor.
Mengurutkan vektor dengan Ascending.
Mencari nilai median dengan cara:
- jika n ganjil if(n%%2 == 1) yang berarti angka dibagi 2 sisa 1, maka nilai median adalah posisi data ke-$(n+1) / 2$.
- jika n tidak ganjil atau genap, maka nilai median adalah data ke- $[(n/2)+((n/2)+1)]/2$.
Mengeluarkan nilai median sebagai m.

Karena data yang diinputkan di atas adalah 1,5,3,7,3,4,2,7 maka apabila di urutkan menjadi : 1,2,3,3,4,5,7,7 dimana terdapat 8 angka sehingga nilai mediannya adalah (data ke-4 + data ke-5)/2 sehingga nilai mediannya adalah $(3+4)/2 = 3,5$.

Latihan 2

Berikut fungsi untuk mencari modus dari suatu vektor.

modus <- function(vect)
{ v <- unique(vect)
  f <- NULL
  for(i in v)
  { byk <- sum(vect==i)
    f <- c(f,byk)
  }
  fmax <- max(f)
  vf <- cbind(v,f)
  mode <- vf[f==fmax,]
  return(mode)
}
modus(x1)

##      v f
## [1,] 3 2
## [2,] 7 2

Berdasarkan sintaks di atas, dibuat fungsi untuk menghitung nilai modus dari data yang diinput sebagai vektor. Algoritma sintaks di atas adalah:

Input data sebagai vektor.
Menjadikan data input sebagai nilai unik.
Melakukan perulangan sebanyak nilai unik tersebut.
Menemukan mana nilai yang muncul lebih sering daripada yang lain.
Nilai yang sering muncul tersebut dipanggil sebagai nilai mode beserta jumlah berapa kali kemunculannya. Kemudian, nilai yang paling sering muncul itu akan diekstrak ke list baru beserta duplikatnya (nilai sesamanya yang muncul setelahnya). Dengan mencarinya menggunakan for loop dengan parameter bahwa jumlah kemunculan terbanyak dikurang satu harus lebih kecil ketimbang jumlah kemunculan tiap nilai data.

Latihan 3

Berikut fungsi untuk menduga parameter pada regresi berganda.

p.est<-function(A){
if(!is.matrix(A))
stop("input must be on matrix") #Data yang diinput harus berupa matriks
x1<-A[,-1] #Mendefinisikan matriks A selain kolom ke-1 sebagai peubah x
y <-A[,1] #Mendefinisikan matriks A kolom ke-1 sebagai peubah y
one<-rep(1,nrow(A)) #Menambahkan 1 kolom berisi angka 1 dengan jumlah baris sebanyak jumlah baris matriks A
x <-cbind(one,x1) #Menggabungkan peubah x dengan vektor angka 1
colnames(x)<-paste("x",1:ncol(x),sep="") #Membuat nama kolom
b.est<-as.vector(solve(t(x) %*% x) %*% (t(x) %*% y)) #Menghitung nilai beta nol duga dan beta satu, beta dua duga, dst sebanyak jumlah peubah x melalui perkalian matriks invers matriks (X'X) dikali dengan matriks X'Y.
names(b.est)<-paste("b",0:(length(b.est)-1),sep="") #Memberi nama hasil beta duga
fitted.value<-as.vector(x%*%b.est) 
error<-as.vector(y-fitted.value) #Menghitung nilai error
names(fitted.value)<-names(error)<-1:nrow(A)
list(beta.est=b.est,fit.val=fitted.value,error=error)
} #Memanggil hasil hitungan dengan format list

Berikut penggunaan fungsi di atas dari data dengan pendapatan sebagai variabel y, biaya iklan sebagai x1 dan jumlah warung sebagai x2.

Pendapatan<-c(3.5,3.2,3.0,2.9,4.0,2.5,2.3)
Biaya.Iklan<-c(3.1,3.4,3.0,3.2,3.9,2.8,2.2)
Jumlah.Warung<-c(30,25,20,30,40,25,30)
X<-cbind(Pendapatan,Biaya.Iklan,Jumlah.Warung)
p.est(X)

## $beta.est
##          b0          b1          b2 
## -0.21381852  0.89843390  0.01745279 
## 
## $fit.val
##        1        2        3        4        5        6        7 
## 3.094910 3.277176 2.830539 3.184754 3.988185 2.738116 2.286320 
## 
## $error
##           1           2           3           4           5           6 
##  0.40508982 -0.07717642  0.16946108 -0.28475357  0.01181483 -0.23811608 
##           7 
##  0.01368033

model<-lm(Pendapatan~Biaya.Iklan+Jumlah.Warung)
model$coefficients

##   (Intercept)   Biaya.Iklan Jumlah.Warung 
##   -0.21381852    0.89843390    0.01745279

model$fitted.values

##        1        2        3        4        5        6        7 
## 3.094910 3.277176 2.830539 3.184754 3.988185 2.738116 2.286320

model$residuals

##           1           2           3           4           5           6 
##  0.40508982 -0.07717642  0.16946108 -0.28475357  0.01181483 -0.23811608 
##           7 
##  0.01368033

Berdasarkan output di atas, maka dapat dibuat persamaan model regresi:

$\widehat {Pendapatan} = -0.21381852 + 0.89843390 \ Biayaiklan + 0.01745279 \ Jumlah warung$

Latihan 4

Buat fungsi bernama three.M yang digunakan untuk menghitung mean, median, dan modus dari suatu vektor modus (tanpa menggunakan fungsi mean, quantile, ataupun fungsi “instan” lain yang sudah tersedia sebelumnya di R)! Hitung mean, median, modus dari X dibawah ini dengan menggunakan fungsi three.M tersebut!

three.M <- function(vektor){
  n <- length(vektor)
  mean <- sum(vektor)/n
  vektor2 <- sort(vektor)
  if(n%%2 == 1) {median <- vektor2[(n+1)/2]}
  else {median <- (vektor2[n/2]+vektor2[(n/2)+1])/2}
  v <- unique(vektor)
  f <- NULL
  for(i in v)
  { byk <- sum(vektor==i)
  f <- c(f,byk)
  }
  fmax <- max(f)
  vf <- cbind(v,f)
  modus <- vf[f==fmax,]
return(list(mean=mean, median=median, modus=modus))
}

Berikut contoh penggunaan fungsi three.M di atas.

set.seed(123)
X<-rbinom(100,10,0.5)
three.M (X)

## $mean
## [1] 4.99
## 
## $median
## [1] 5
## 
## $modus
##      v  f
## [1,] 6 24
## [2,] 5 24

Object Oriented Programming (OOP)

Pemrograman Berorientasi Objek (PBO) merupakan metode yang berorientasi terhadap objek. Pada PBO semua data maupuan fungsi di definisikan ke dalam beberapa kelas atau objek yang tujuannya saling bekerjasama untuk memecahkan suatu masalah. PBO merupakan sebuah paradigma dalam pembuatan sebuah program. PBO menitikberatkan pada identifikasi objek-objek yang terlibat dalam sebuah program dan bagaimana objek-objek tersebut berinteraksi. Pada PBO, program yang dibangun akan dibagi-bagi menjadi objek-objek. Beberapa prinsip dari PBO, yaitu:

Abstraksi : informasi abstrak dan metode-metode dari sekumpulan data.
Enkapsulasi : konsep tentang pengikatan data atau metode yang berbeda yang disatukan atau “dikapsulkan” menjadi satu unit data. Encapsulation dapat mempermudah dalam pembacaan code karena informasi yang disajikan tidak perlu dibaca secara rinci dan sudah merupakan satu kesatuan.
Inheritance (pewarisan) : konsep OOP di mana kita dapat membentuk class baru yang “mewarisi” atau memiliki bagian-bagian dari class yang sudah ada sebelumnya. Konsep ini menggunakan sistem hirarki atau bertingkat.
Polymorphism : konsep di mana suatu objek yang berbeda-beda dapat diakses melalui interface yang sama. Sebuah objek yang polymorphic dapat beradaptasi dengan metode apapun yang diimplementasikan pada objek tersebut, dan setiap class memiliki interpretasinya tersendiri terhadap interfacenya.

Kelas (Class)

Class merupakan definisi statik (kerangka dasar) dari objek yang akan diciptakan. Sebuah class berisi kode-kode yang menjelaskan bagaimana sebuah object akan berperilaku dan berinteraksi satu sama lain. Class dalam pemrograman diartikan seperti sebuah cetakan atau template. Class berupa struktur yang mendefinisikan data (property) dan method dari objek. Class bisa disebut gambaran umum dari benda. Contoh penamaan kelas: Mobil, Laptop, Anggota, Buku, dll.

Object

Object merupakan abstraksi dari sesuatu yang mewakili sesuatu pada dunia nyata. Pada bahasa pemrograman, object adalah komponen yang diciptakan dari class (instance of class). Object merupakan entitas pada saat RUN TIME. Object memiliki siklus creation, manipulation, dan destruction. Dalam satu class bisa menghasil banyak object.

Class System S3

Suatu Class dalam System S3 tidak didefinisikan dengan ketat. Fungsi class digunakan untuk menjadikan sebuah objek menjadi class yang diinginkan.

A1 <- c(1:10)
class(A1)

## [1] "integer"

A2 <- matrix(A1,2,5)
A2

##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    3    5    7    9
## [2,]    2    4    6    8   10

class(A2)

## [1] "matrix" "array"

A3 <- 1:12
A3

##  [1]  1  2  3  4  5  6  7  8  9 10 11 12

A4 <- letters[1:12]
A4

##  [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l"

B1 <- data.frame(A3,A4)
class(B1)

## [1] "data.frame"

B1$A4

##  [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l"

A5 <- 10+A3+rnorm(12)
A5

##  [1] 11.25332 11.97145 12.95713 15.36860 14.77423 17.51647 15.45125 18.58461
##  [9] 19.12385 20.21594 21.37964 21.49768

B2 <- lm(A5~A3) #membuat model linear
class(B2)

## [1] "lm"

methods(class=class(B2))

##  [1] add1           alias          anova          case.names     coerce        
##  [6] confint        cooks.distance deviance       dfbeta         dfbetas       
## [11] drop1          dummy.coef     effects        extractAIC     family        
## [16] formula        hatvalues      influence      initialize     kappa         
## [21] labels         logLik         model.frame    model.matrix   nobs          
## [26] plot           predict        print          proj           qr            
## [31] residuals      rstandard      rstudent       show           simulate      
## [36] slotsFromS3    summary        variable.names vcov          
## see '?methods' for accessing help and source code

summary(B2)

## 
## Call:
## lm(formula = A5 ~ A3)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.70634 -0.37935 -0.03672  0.38335  1.32502 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 10.39462    0.51345   20.25 1.91e-09 ***
## A3           0.96614    0.06976   13.85 7.51e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8343 on 10 degrees of freedom
## Multiple R-squared:  0.9504, Adjusted R-squared:  0.9455 
## F-statistic: 191.8 on 1 and 10 DF,  p-value: 7.514e-08

names(B2)

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

B2$coefficients

## (Intercept)          A3 
##  10.3946172   0.9661381

Mengubah menjadi Class

Mobil1 <- list(Nama="Toyota", Panjang=3.5, Lebar=2, Kecepatan=180)
class(Mobil1)

## [1] "list"

class(Mobil1) <- "mobil"
Mobil2 <- list(Nama="Suzuki", Panjang=1, Lebar=1.8, Kecepatan=150)
class(Mobil2) <- "mobil" #Mengubah class Mobil2 yang tadinya list menjadi mobil
class(Mobil2)

## [1] "mobil"

Mengubah menjadi Class (Menggunakan Fungsi Konstruktor)

Lebih direkomendasikan menggunakan fungsi konstruktor karena pada fungsi konstruktor akan menambahkan screening sebelum menambahkan class.

Mobil <- function(Nama,Panjang,Lebar,Kecepatan){
if(Panjang<2 || Lebar<1.5 || Kecepatan<80)
stop("atribut tidak sesuai")
Mobil <- list(Nama=Nama, Panjang=Panjang,
Lebar=Lebar, Kecepatan=Kecepatan)
class(Mobil) <- "mobil"
Mobil
}

Mobil3 <- Mobil("Daihatsu", 2.1, 1.9, 120)
Mobil3

## $Nama
## [1] "Daihatsu"
## 
## $Panjang
## [1] 2.1
## 
## $Lebar
## [1] 1.9
## 
## $Kecepatan
## [1] 120
## 
## attr(,"class")
## [1] "mobil"

Mobil4 <- Mobil("Proton", 2, 1.8, 70)
Mobil4

Pada syntaks di atas, mobil4 tidak masuk dalam kelas mobil karena mobil4 memiliki kecepatan 70, sedangakan pada syntax sebelumnya dibuat persyaratan bahwa peubah yang memiliki: $if(Panjang<2||Lebar<1.5||Kecepatan<80)$ akan diberikan peringatan atribut tidak sesuai. Dengan begitu ada screening tambahan untuk mendefinisikan kelas sehingga tidak asal atribut bisa masuk.

Fungsi Aksesor

Cara langsung (tidak direkomendasikan)

Mobil2$Nama

## [1] "Suzuki"

Mobil3$Panjang

## [1] 2.1

Dengan fungsi aksesor

Langkah sederhana dalam membuat objek dari suatu class sebelumnya sangat tidak dianjurkan karena nilai-nilai instan-nya mungkin tidak tepat. Sebuah fungsi konstruktor dibutuhkan untuk mengecek instan sesuai dengan objek.

nama <- function(objek) objek$Nama
kecepatan <- function(objek) objek$Kecepatan
nama(Mobil1)

## [1] "Toyota"

kecepatan(Mobil3)

## [1] 120

Fungsi Generik Print Method

print.mobil <- function(objek) {
print(cat("Nama : ", nama(objek), "\n","Kecepatan : ", kecepatan(objek), sep=""))
}
Mobil1

## Nama : Toyota
## Kecepatan : 180NULL

Class System S4

setClass("car",
representation(Nama="character",
Panjang="numeric",
Lebar="numeric",
Kecepatan="numeric"))

Car1 <- new("car", Nama="Toyota",
Panjang=3.5, Lebar=2,
Kecepatan=180)

Menggunakan Fungsi Konstruktor

Car <- function(Nama,Panjang,Lebar,Kecepatan){
if(Panjang<2 || Lebar<1.5 || Kecepatan<80)
stop("atribut tidak sesuai")
new("car", Nama=Nama, Panjang=Panjang,
Lebar=Lebar, Kecepatan=Kecepatan)
}

Car2 <- Car("Suzuki", 2.4, 1.8, 150)
class(Car2)

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

class(Mobil1)

## [1] "mobil"

Akses terhadap Slot

Cara langsung (tidak direkomendasikan)

Car1@Nama

## [1] "Toyota"

Car2@Kecepatan

## [1] 150

Dengan fungsi aksesor

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

## [1] "Toyota"

kecepatan1(Car2)

## [1] 150

Class Method

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

## Nama : Suzuki
## Kecepatan : 150NULL

Tambahan

Sebuah class coords dirancang untuk digunakan dengan menyimpan data koordinat titik pada dua buah vektor X dan y. Metode pada class ini terdiri dari metode print, length, bbox, dan plot. Class lain dirancang sebagai turunan dari class coords dengan menambahkan data nilai (value) untuk setiap titik pada koordinat x dan y. Metode pada class vcoords merupakan pewarisan dari class coords dan operasi-operasi aritmetik terhadap nilai (value)-nya.

Menggunakan Class System S3

Fungsi konstruktur untuk membuat class coords adalah:

coords <- function(x,y) {
  if (!is.numeric (x) || !is.numeric(y) || !all(is.finite(x)) || !all(is.finite(y)))
    stop ("Titik koordinat tidak tepat!")
  if (length(x) != length (y))
    stop ("Panjang koordinat berbeda")
  pts <- list (x=x, y=y)
  class(pts) = "coords"
  pts
}
pts <- coords(x =round(rnorm(5),2),
              y = round(rnorm(5),2))

xcoords = function (obj) obj $x
ycoords = function (obj) obj $y
xcoords (pts)

## [1] -0.33 -1.02 -1.07  0.30  0.45

ycoords (pts)

## [1]  0.05  0.92  2.05 -0.49 -2.31

Method print sebagai cara menampilkan data pada suatu objek Class System S3.

print.coords <- function(obj) {
  print(paste("(",format(xcoords(obj)),", ",format(ycoords(obj)),")",sep=""),quote = FALSE )
}
pts

## [1] (-0.33,  0.05) (-1.02,  0.92) (-1.07,  2.05) ( 0.30, -0.49) ( 0.45, -2.31)

Method Length untuk menghitung banyaknya anggota dari objek.

length(pts)

## [1] 2

length.coords = function(obj) length(xcoords(obj))
length(pts)

## [1] 5

Method bbox (boundary box) sebagai fungsi generik baru.

bbox <- function(obj)
  UseMethod("bbox") # menjadikan bbox sebagai fungsi generik
bbox.coords <- function(obj) {
  matrix(c(range(xcoords(obj)),range(ycoords(obj))),nc = 2, dimnames = list(c("min", "max"),c("x:", "y:")))
}
bbox(pts)

##        x:    y:
## min -1.07 -2.31
## max  0.45  2.05

Method plot

plot.coords <- function(obj,bbox =FALSE, ...) {
  if (bbox) {
    plot(xcoords(obj),ycoords(obj), ...) ;
    x <- c(bbox(obj)[1],bbox(obj)[2],bbox(obj)[2],bbox(obj)[1]);
    y <- c(bbox(obj)[3],bbox(obj)[3],bbox(obj)[4],bbox(obj)[4]);
    polygon(x,y)
  } else {
    plot(xcoords(obj),ycoords(obj), ...)
  }
}

plot(pts)

plot(pts,bbox=T,pch=19,col ="red")

Pewarisan Kelas

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", "coords")
  pts
}
nilai <- function (obj) obj$v

vpts <- vcoords(x = round(rnorm(5),2),y = round(rnorm(5),2),v = round(runif(5,0,100)))
vpts

## [1] ( 1.01, -1.22) (-0.71,  0.18) (-0.69, -0.14) ( 1.03,  0.01) (-0.28,  0.39)

xcoords(vpts)

## [1]  1.01 -0.71 -0.69  1.03 -0.28

bbox(vpts)

##        x:    y:
## min -0.71 -1.22
## max  1.03  0.39

Pemeriksaan suatu kelas objek

inherits(pts,"coords")

## [1] TRUE

inherits(pts,"vcoords")

## [1] FALSE

inherits(vpts,"coords")

## [1] TRUE

inherits(vpts,"vcoords")

## [1] TRUE

2. OPTIMASI

Beberapa metode statistik menggunakan metode pendugaan nilai optimum dari suatu fungsi tujuan. Contoh:

Metode kemungkinan maksimum: mencari nilai maksimum dari fungsi kemungkinan (likelihood).
Metode kuadrat terkecil: mencari nilai minimum dari fungsi jumlah kuadrat galat.

Mendapatkan nilai optimum dari suatu fungsi merupakan suatu teknik optimasi numerik. Beberapa metode yang sudah dikembangkan, diantaranya:

Golden section search

Dilakukan dengan Mencari nilai minimum untuk fungsi peubah tunggal dari suatu selang yang diketahui. Berikut langkah-langkahnya:

Mulai dengan selang $[a, b]$ yang memuat minimum.
Perkecil selang $[a', b']$ yang memuat minimum.
Berhenti sampai $[b'- a']$ lebih kecil dari nilai tolerans.

Adapun Pemilihan nilai $a'$ dan $b'$ adalah sebagai berikut:

Nilai antara $[a,b]$ memiliki sifat golden ratio: $\phi = (\sqrt{5} + 1) / 2$
Tentukan $x_1$ dan $x_2$: $x_1 = b - (b - a) / \phi$ $x_2 = a + (b - a) / \phi$
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]$

Contoh 1

Berikut sintaks untuk membuat fungsi golden.

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) {abs(x -3.5) + (x -2) ^2}

golden (f,1,2) #selang secara intuitif saja, bebas.

## [1] 2

golden (f,1,5)

## [1] 2.5

golden (f,3,5)

## [1] 3

Apabila nilai yang didapat sama dengan nilai selang maka berarti nilai tersebut bukan nilai optimumnya. Dari hasil di atas, maka nilai x yang membuat y-nya minimum adalah 2.5.

Newton-Raphson

Jika suatu fungsi memiliki turunan pertama dan kedua, maka nilai minimum dapat menggunakan metode Newton Raphson:

\[ x_n = x_{n-1} - \frac{f'(x_{n-1})}{f''(x_{n-1})} \]

Metode Newton Raphson lebih cepat dibanding Golden Section Search. Iterasi berhenti jika $f'(x_{n-1})$ dekat dengan 0 atau lebih kecil dari nilai tolerans. Fungsi nlm dalam R salah satunya yang mengimplementasikan Newton Raphson.

Contoh 2

Berikut sintaks untuk membuat fungsi dengan metode Newton Raphson.

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) # bisa juga e <- abs (x1 -x0)
    x1 <- x0 - f1/f2
    x0 <- x1
  }
  return (x1)
}

Selanjutnya, akan di cari nilai x yang meminimumkan fungsinya :

\[f(x) = 4x^2 - 3x - 7$ \]

fx <- expression(4*x^2-3*x-7)
newtonr(fx,2) #angka 2 ini adalah nilai inisial, bisa diisi angka berapapun kecuali nol. Namun lebih baik angka inisial ini tidak terlalu jauh, agar tidak terlalu lama dalam melakukan running.

## [1] 0.375

Nilai x yang meminimumkan fungsi :

\[f(x) = e^{-x} + x^4\]

fx <- expression(exp(-x)+x^4)
newtonr(fx)

## [1] 0.5282519

Nilai x yang meminimumkan fungsi :

\[f(x) = x^2 - x\]

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

## [1] 0.5

Nelder-Mead

Algoritma Nelder-Mead adalah salah satu metode optimasi untuk fungsi yang memiliki lebih dari satu peubah. R telah menyiapkan fungsi optimasi dengan salah satu algoritmanya adalah Nelder-Mead:

optimize atau optimise (satu peubah)

Contoh 3

Misal akan dicari nilai minimum dari fungsi:

\[f(x) = (x - \frac{1}{3})^2\]

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

## $minimum
## [1] 0.3333333
## 
## $objective
## [1] 0

Nilai minimum adalah nilai xnya, adapun nilai objective adalah nilai $f(x)$ ketika x minimum.

optim (lebih dari satu peubah)

Contoh 4

Misal mencari nilai $x_1$ dan $x_2$ yang membuat \[f(x_1,x_2)= 100(x_2 - x_1^2)^2 + (1 - x_1)^2\] minimum.

fr <- function(x) {
  x1 <- x[1]
  x2 <- x[2]
  100 * (x2 - x1 ^2) ^2 + (1 - x1)^2
}
optim (c( -1.2 ,1) , fr)  #nilai selang -1.2, 1 ini bebas yang penting jangan 0 dan jangan terlalu besar.

## $par
## [1] 1.000260 1.000506
## 
## $value
## [1] 8.825241e-08
## 
## $counts
## function gradient 
##      195       NA 
## 
## $convergence
## [1] 0
## 
## $message
## NULL

Fungsi di atas sudah konvergen. Hal ini dapat dilihat dari nilai convergence nya yang sama dengan 0. Bila tidak sama dengan 0 maka belum konvergen. Hal ini bisa karena fungsinya memang tidak memiliki nilai minimum, iterasinya kurang, atau karena nilai inisialnya yang terlalu jauh.

Contoh 5

Jika $x_1, x_2, ...., x_n$ berasal dari peubah acak $X \tilde\ N (\mu, \sigma)$, tentukan penduga $\mu$ dan $\sigma$ menggunakan MLE.

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] 1.358460 2.387043

c(mean(x),sd(x)) # pembanding

## [1] 1.358641 2.516450

Latihan 1

Carilah hasil integral tak tentu berikut menggunakan fungsi yac_str dari package Ryacas.

\[\int x^{2} + 4\,dx\]

library(Ryacas)

## Warning: package 'Ryacas' was built under R version 4.0.3

## 
## Attaching package: 'Ryacas'

## The following object is masked from 'package:stats':
## 
##     integrate

## The following objects are masked from 'package:base':
## 
##     %*%, diag, diag<-, lower.tri, upper.tri

yac_str("Integrate(x) x^2 + 4*x")

## [1] "x^3/3+2*x^2"

Kemudian cari hasil integral tentu berikut menggunakan fungsi integrate \[\int_{-10}^{10} x^{2} + 4\,dx\]

library(Ryacas)
f1 <-function(x) x^2 + 4*x
integrate(f1,lower = -10,upper = 10)

## 666.6667 with absolute error < 7.6e-12

Latihan 2

Carilah hasil integral tak tentu berikut menggunakan fungsi yac_str dari package Ryacas.

\[\int t^{4} + e^{-t}\,dx\]

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)"

Kemudian cari hasil integral tentu berikut menggunakan fungsi integrate, bandingkan hasilnya dengan menghitung Γ(5)dengan menggunakan fungsi gamma.

\[\int_{0}^{\infty} t^{4} + e^{-t}\,dx\]

f2 <-function(t) t^(4) * exp(-t)
integrate(f2,lower = 0,upper = Inf)

## 24 with absolute error < 2.2e-05

gamma(5)

## [1] 24

Latihan 3

Carilah titik minimum dari fungsi: \[f(x) = 4x^{4} - 2x^{3}-3x\]

f3 <-function(x) 4*x^4-2*x^3-3*x
x3 <-seq(-1,1.5,by=.1)
plot(x3,f3(x3),type="l")

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

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

## $par
## [1] 0.728418
## 
## $value
## [1] -1.832126
## 
## $counts
## function gradient 
##       36       NA 
## 
## $convergence
## [1] 0
## 
## $message
## NULL

Referensi

Guntoro. 2020. Mengenal Pemrograman Berorientasi Objek. (https://badoystudio.com/pemrograman-berorientasi-objek/).
M Sholeh, Agus. 2020. Modul Kuliah Pemrograman Fungsi R. Bogor: Statistika dan Sains Data IPB.
M Sholeh, Agus. 2020. Modul Kuliah Optimasi Secara Numerik. Bogor: Statistika dan Sains Data IPB.
Raharjo, Mulianto. 2020. Modul Praktikum 6 Pemrograman dan Fungsi OOP. Bogor: Statistika dan Sains Data IPB.
Raharjo, Mulianto. 2020. Modul Praktikum 7 Optimasi. Bogor: Statistika dan Sains Data IPB.

Laporan Praktikum Pemrograman Ke-3

Chumairoh - G1501201021

18 Oktober 2020

1. PEMROGRAMAN DAN FUNGSI OOP

Fungsi

Contoh 1

Contoh 2

Contoh 3

Contoh 4

Contoh 5

Latihan 1

Latihan 2

Latihan 3

Latihan 4

Object Oriented Programming (OOP)

Kelas (Class)

Object

Class System S3

Mengubah menjadi Class

Mengubah menjadi Class (Menggunakan Fungsi Konstruktor)

Fungsi Aksesor

Fungsi Generik Print Method

Class System S4

Akses terhadap Slot

Class Method

Tambahan

Menggunakan Class System S3

2. OPTIMASI

Golden section search

Contoh 1

Newton-Raphson

Contoh 2

Nelder-Mead

Contoh 3

Contoh 4

Contoh 5

Latihan 1

Latihan 2

Latihan 3

Referensi