Pemrograman Berorientasi Objek dalam R Class System S4

Objek: Class System S4

• Class System S4: Mengatasi masalah dalam Class System S3 dengan sistem objek lebih formal
• Salah satu keuntungan: sistem penurunan dari class/objek
• Dalam sistem objek formal: setiap objek didefinisikan secara formal dalam suatu class
• Sebuah class terdiri dari slot dengan tipe atau class spesifik
• Class dideklarasikan dengan fungsi setClass berikut

setClass("coords", 
         representation(x = "numeric", y = "numeric"))

Konstruktor dan Aksesor

Berikut adalah definisi ulang class sebelumnya ke Class System S4 dengan menggunakan fungsi konstruktor:

coords <- function(x, y){
  if (length(x) != length(y))
    stop("length x dan y harus bernilai sama")
  if (!is.numeric(x) || !is.numeric(y))
    stop("x dan y harus vektor numeric")
  new("coords", x = as.vector(x), y = as.vector(y))
  }
pts <- coords(round(rnorm(5), 2), round(rnorm(5),2))
pts

An object of class "coords"
Slot "x":
[1]  0.69  0.20  1.72  1.76 -2.62

Slot "y":
[1]  0.77 -1.34 -0.57  0.52  0.29

Akses terhadap slot menggunakan fungsi slot atau operator @

#Menggunakan fungsi slot
slot(pts,"x") 

[1]  0.69  0.20  1.72  1.76 -2.62

slot(pts,"y")

[1]  0.77 -1.34 -0.57  0.52  0.29

#Menggunakan operayor @
pts@x

[1]  0.69  0.20  1.72  1.76 -2.62

pts@y

[1]  0.77 -1.34 -0.57  0.52  0.29

Penggunaan fungsi slot dan operator @ menghasilkan output yang sama. Tetapi lebih disarankan mengakses dengan 2 fungsi seperti sebelumnya.

xcoords <- function(obj) obj@x
ycoords <- function(obj) obj@y
xcoords(pts)

[1]  0.69  0.20  1.72  1.76 -2.62

ycoords(pts)

[1]  0.77 -1.34 -0.57  0.52  0.29

Fungsi Generik

Fungsi generik diciptakan menggunakan fungsi setMethod . Argumen didefinisikan dalam signature seperti berikut.

setMethod(show, signature(object = "coords"),
          function(object)
            print(paste("(",
                        format(xcoords(object)),", ",
                        format(ycoords(object)), ")", sep=""),
                  quote=FALSE))
pts

[1] ( 0.69,  0.77) ( 0.20, -1.34)
[3] ( 1.72, -0.57) ( 1.76,  0.52)
[5] (-2.62,  0.29)

Fungsi generik show setara dengan fungsi print pada class system S3.

Definisi Fungsi Generik Baru

Mendefinisikan fungsi baru sebagai fungsi generik menggunakan:setGeneric dan setMethod Sebagai contoh akan dibuat fungsi generik berikut.

Fungsi Generik Bbox

setGeneric("bbox", function(obj)
  standardGeneric("bbox"))

[1] "bbox"

setMethod("bbox", signature(obj = "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 -2.62 -1.34
max  1.76  0.77

pts

[1] ( 0.69,  0.77) ( 0.20, -1.34)
[3] ( 1.72, -0.57) ( 1.76,  0.52)
[5] (-2.62,  0.29)

Fungsi Generik Plot

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

plot(pts,bbox=T, pch=19, col="blue",xlab="x", ylab="y")

Pewarisan Class

Terdapat class baru yang diturunkan dari coords dengan menambahkan slot nilai

setClass("vcoords", representation(nilai = "numeric"), contains = "coords")
vcoords <- function(x, y, nilai){
  if ((length(x) != length(y)) || (length(x) != length(nilai)))
    stop("length x, y, dan nilai harus bernilai sama")
  if (!is.numeric(x) || !is.numeric(y) || !is.numeric(nilai))
    stop("x, y, dan nilai harus vektor numeric")
  new("vcoords", x = as.vector(x), y = as.vector(y),
      nilai = as.vector(nilai))
}
nilai <- function(obj) obj@nilai
vpts <- vcoords(xcoords(pts), ycoords(pts), round(100*runif(5)))
vpts

[1] ( 0.69,  0.77) ( 0.20, -1.34)
[3] ( 1.72, -0.57) ( 1.76,  0.52)
[5] (-2.62,  0.29)

pts

[1] ( 0.69,  0.77) ( 0.20, -1.34)
[3] ( 1.72, -0.57) ( 1.76,  0.52)
[5] (-2.62,  0.29)

Karena ada penambahan slot nilai sehingga method yang diwariskan perlu didefinisi ulang seperti berikut.

Method Show

setMethod(show, signature(object = "vcoords"),
          function(object) 
            print(paste("(", 
                        format(xcoords(object)), ", ",
                        format(ycoords(object)), "; ",
                        format(nilai(object)),")", 
                        sep=""), 
                  quote=FALSE))
vpts

[1] ( 0.69,  0.77; 75)
[2] ( 0.20, -1.34; 31)
[3] ( 1.72, -0.57; 47)
[4] ( 1.76,  0.52; 38)
[5] (-2.62,  0.29; 54)

pts

[1] ( 0.69,  0.77) ( 0.20, -1.34)
[3] ( 1.72, -0.57) ( 1.76,  0.52)
[5] (-2.62,  0.29)

Method Plot

setMethod("plot", signature(x="vcoords"),
          function(x, txt=FALSE, bbox=FALSE, ...){
            if (bbox) {
              if (!txt) {plot(xcoords(x),ycoords(x), ...);} 
              else {
                plot(xcoords(x),ycoords(x), type="n", ...);
                text(xcoords(x),ycoords(x), nilai(x), ...)}
              x.1 <- c(bbox(x)[1],bbox(x)[2],bbox(x)[2],bbox(x)[1]);
              y.1 <- c(bbox(x)[3],bbox(x)[3],bbox(x)[4],bbox(x)[4]);
              polygon(x.1,y.1)} 
            else {
              if (!txt) {plot(xcoords(x),ycoords(x), ...)}
              else {
                plot(xcoords(x),ycoords(x), type="n", ...);
                text(xcoords(x),ycoords(x), nilai(x), ...);}}
})
plot(vpts)

plot(vpts, txt=T, bbox=T, pch=19, col="blue")

Transformasi dengan Matematik

Sebagai contoh dilakukan tranformasi terhadap nilai dengan cos berikut.

 setMethod("cos", signature(x = "vcoords"),
 function(x)
 vcoords(xcoords(x),
 ycoords(x),
 cos(nilai(x))))
 cos(vpts)

[1] ( 0.69,  0.77;  0.9217513)
[2] ( 0.20, -1.34;  0.9147424)
[3] ( 1.72, -0.57; -0.9923355)
[4] ( 1.76,  0.52;  0.9550736)
[5] (-2.62,  0.29; -0.8293098)

Seperti pada class system S3, terdapat group Math seperti berikut.

setMethod("Math", signature(x = "vcoords"),
          function(x) vcoords(xcoords(x), ycoords(x), callGeneric(nilai(x))))
cos(vpts)

[1] ( 0.69,  0.77;  0.9217513)
[2] ( 0.20, -1.34;  0.9147424)
[3] ( 1.72, -0.57; -0.9923355)
[4] ( 1.76,  0.52;  0.9550736)
[5] (-2.62,  0.29; -0.8293098)

sin(vpts)

[1] ( 0.69,  0.77; -0.3877816)
[2] ( 0.20, -1.34; -0.4040376)
[3] ( 1.72, -0.57;  0.1235731)
[4] ( 1.76,  0.52;  0.2963686)
[5] (-2.62,  0.29; -0.5587890)

sqrt(vpts)

[1] ( 0.69,  0.77; 8.660254)
[2] ( 0.20, -1.34; 5.567764)
[3] ( 1.72, -0.57; 6.855655)
[4] ( 1.76,  0.52; 6.164414)
[5] (-2.62,  0.29; 7.348469)

Operasi Aritmetika

Langkah dalam menyusun operasi aritmetika mirip dengan sistem S3 yaitu menyusun fungsi untuk lokasi terlebih dahulu.

sameloc <- function(e1, e2) 
  (length(nilai(e1)) == length(nilai(e2)) || any(xcoords(e1) == xcoords(e2))
  || any(ycoords(e1) == ycoords(e2)))

lalu menyusun method aritmetika dengan kedua operand merupakan kelas vcoords, seperti berikut.

setMethod("Arith", signature(e1 = "vcoords", e2 = "vcoords"),
          function(e1, e2){
            if (!sameloc(e1, e2))
              stop("Dibutuhkan titik identik")
            vcoords(xcoords(e1), ycoords(e2), 
                    callGeneric(nilai(e1), nilai(e2)))
})
vpts

[1] ( 0.69,  0.77; 75)
[2] ( 0.20, -1.34; 31)
[3] ( 1.72, -0.57; 47)
[4] ( 1.76,  0.52; 38)
[5] (-2.62,  0.29; 54)

vpts+vpts

[1] ( 0.69,  0.77; 150)
[2] ( 0.20, -1.34;  62)
[3] ( 1.72, -0.57;  94)
[4] ( 1.76,  0.52;  76)
[5] (-2.62,  0.29; 108)

2+vpts

Error in 2 + vpts : non-numeric argument to binary operator

bisa dilihat pada saat mengoperasikan suatu numerik sebagai operand, operasi mengalami error. Maka perlu menambahkan setMethod("Arith",...) untuk operasi dengan numerik seperti berikut. ## Menambah operasi aritmetika dengan awal numerik

setMethod("Arith", signature(e1 = "numeric", e2 = "vcoords"),
          function(e1, e2){
            if (length(e1)>length(nilai(e2)))
              stop("length yang tidak benar")
            vcoords(xcoords(e2), ycoords(e2), 
                    callGeneric(as.vector(e1), nilai(e2)))
})
vpts

[1] ( 0.69,  0.77; 75)
[2] ( 0.20, -1.34; 31)
[3] ( 1.72, -0.57; 47)
[4] ( 1.76,  0.52; 38)
[5] (-2.62,  0.29; 54)

2+vpts

[1] ( 0.69,  0.77; 77)
[2] ( 0.20, -1.34; 33)
[3] ( 1.72, -0.57; 49)
[4] ( 1.76,  0.52; 40)
[5] (-2.62,  0.29; 56)

2*vpts

[1] ( 0.69,  0.77; 150)
[2] ( 0.20, -1.34;  62)
[3] ( 1.72, -0.57;  94)
[4] ( 1.76,  0.52;  76)
[5] (-2.62,  0.29; 108)

Menambah operasi aritmetika dengan akhir numerik

setMethod("Arith", signature(e1 = "vcoords", e2 = "numeric"),
          function(e1, e2){
            if (length(nilai(e1)) < length(e2))
              stop("length yang tidak benar")
            vcoords(xcoords(e1), ycoords(e1), 
                    callGeneric(nilai(e1), as.vector(e2)))
})
vpts+2

[1] ( 0.69,  0.77; 77)
[2] ( 0.20, -1.34; 33)
[3] ( 1.72, -0.57; 49)
[4] ( 1.76,  0.52; 40)
[5] (-2.62,  0.29; 56)

Method Subset

Mendefinisikan method untuk subset dengan syntax berikut.

setMethod("[", signature(x = "vcoords", i = "ANY",
                         j = "missing", drop = "missing"),
          function(x, i, j) vcoords(xcoords(x)[i], ycoords(x)[i],
                                    nilai(x)[i]))
vpts[1:3]

[1] (0.69,  0.77; 75)
[2] (0.20, -1.34; 31)
[3] (1.72, -0.57; 47)

Pemeriksaan Suatu Class Objek

Untuk mengecek apakah suatu objek merupakan suatu class digunakan fungsi is() berikut.

is(pts,"coords")

[1] TRUE

is(pts,"vcoords")

[1] FALSE

is(vpts,"coords")

[1] TRUE

is(vpts,"vcoords")

[1] TRUE

Untuk men-coerce objek ke objek lain dari suatu class digunakan fungsi as() berikut.

as(vpts,"coords")

[1] ( 0.69,  0.77) ( 0.20, -1.34)
[3] ( 1.72, -0.57) ( 1.76,  0.52)
[5] (-2.62,  0.29)

output di atas menampilkan vpts sebagai coords, sehingga hanya menampilkan xcoords dan ycoords tanpa nilai.

as(pts,"vcoords")

[1] ( 0.69,  0.77; ) ( 0.20, -1.34; )
[3] ( 1.72, -0.57; ) ( 1.76,  0.52; )
[5] (-2.62,  0.29; )

output di atas menampilkan pts sebagai vcoords, sehingga menampilkan xcoords, ycoords, dan nilai. Namun karena pts tidak memiliki atribut nilai maka ditampilkan sebagai blankspace setelah tanda ;

---

1. Mahasiswa Statistika dan Sains Data IPB, annissa_nff@apps.ipb.ac.id↩︎