Fungsi adalah kumpulan pernyataan yang diatur secara bersama untuk melakukan suatu pekerjaan yang spesifik, seperti perhitungan matematis, pembacaan data, analisis statistik, dan lainnya. Pada bahasa pemrograman R, terdapat dua macam fungsi yaitu fungsi built-in atau fungsi bawaan yang sudah terintegrasi dan fungsi user-defined atau fungsi yang dapat didefinisikan/dibuat oleh pemrogram.

Fungsi

Fungsi built-in

R memiliki banyak sekali fungsi built-in yang dapat dipanggil secara langsung ke dalam program tanpa harus diinisialisasi terlebih dahulu.

Satu fasilitas yang menarik dalam penggunaan fungsi built-in di R adalah argumen fungsi dapat menerima fungsi built-in R lain untuk dijalankan. Berikut ini contohnya

x <- cbind(x1 = 3, x2 = c(4:1, 2:5))
dimnames(x)[[1]] <- letters[1:8]

# argumen fungsi adalah fungsi
apply(x, 1, mean)

Fungsi user-defined

Tidak semua fungsi yang dibutuhkan ada di dalam R. Oleh karena itu, pemrogram dapat menciptakan fungsi sendiri sesuai penggunaan atau analisis yang akan dilakukan. Untuk membuat fungsi, beberapa komponen dari fungsi perlu diperhatikan yaitu nama fungsi, argumen dari fungsi, tubuh atau isi dari fungsi tersebut, dan diakhiri dengan nilai kembali atau return value. Berikut ini contoh penggunaan atau struktur dari fungsi user-defined

myfunction <- function(arg1, arg2, ... ){
  statements
  return(object)
}

Fungsi 1 dengan output hanya nilai z saja.

angka_acak1 <- function(n, pw) {
  x <- runif(n)
  y <- runif(n)
  z <- (x+y)^pw
  return(z)
}
# menggunakan fungsi  
angka_acak1(10,2)
##  [1] 1.34674624 1.68786228 0.57248284 0.90602245 0.04100467 2.26177216
##  [7] 0.99436008 1.67231274 0.58750847 0.34769938

Fungsi 2 dengan output berupa nilai x, y, dan z.

# Membuat fungsi
angka_acak2 <- function(n, pw) {
  x <- runif(n)
  y <- runif(n)
  z <- (x+y)^pw
  return(list(nilai_x=x,nilai_y=y,nilai_z=z))
}

# Menggunakan fungsi
angka_acak2(10,2)
## $nilai_x
##  [1] 0.06807843 0.92660797 0.98512831 0.08753572 0.09339445 0.05967928
##  [7] 0.33244954 0.95844020 0.89438033 0.81671119
## 
## $nilai_y
##  [1] 0.96806471 0.66269044 0.68122873 0.51142296 0.71936567 0.02606532
##  [7] 0.16347424 0.18390138 0.98705169 0.74087569
## 
## $nilai_z
##  [1] 1.073592600 2.525869412 2.776745762 0.358751507 0.660579024 0.007352137
##  [7] 0.245940397 1.304944285 3.539786430 2.426076879

Fungsi 3 dengan memberikan nilai default pada argumen berupa n = 1 dan pw = 2, sehingga ketika fungsi tersebut dipanggil tanpa menuliskan argumen, akan dijalankan fungsi defaultnya.

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

angka_acak3()
## [1] 1.256143

Fungsi 4 dituliskan tanpa menggunakan argumen. Ketika fungsi tersebut akan digunakan maka dilakukan assign nilai yang diperlukan di dalam fungsi tersebut.

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

n <- 5; pw <- 3
angka_acak4()
## [1] 0.8926366 1.0268983 1.2985056 0.4186499 1.7157887

Fungsi 5 dituliskan menggunakan argumen three-dots atau secara teknis disebut ellipsis

halodunia <- function(...) {
  arguments <- list(...)
  paste(arguments)
}

halodunia("Halo", "Dunia", "!")
## [1] "Halo"  "Dunia" "!"
angka_acak5 <- function(n, pw, ...) {
  x <- runif(n, ...)
  y <- runif(n, ...)
  z <- (x+y)^pw
  return(z)
}

angka_acak5(10, 2, min=2, max=5)
##  [1] 32.40305 27.75718 64.22475 44.30598 42.58540 51.21094 62.23961 38.56621
##  [9] 61.12124 72.13708

Penanganan Kesalahan pada Fungsi

Pada dasarnya eksekusi skrip pada R dapat diinterupsi dengan kondisi sinyal seperti:

  • errors
  • warnings
  • info messages
  • interupsi oleh user (dengan menekan tombol CTRL+C / Esc)

Untuk menangani kesalahan dalam fungsi disediakan fungsi sebagai berikut:

  • try: pembungkus untuk menjalankan ekspresi yang mungkin gagal dan memungkinkan kode pengguna untuk menangani pemulihan kesalahan.
  • tryCatch: menyediakan mekanisme untuk menangani kondisi yang tidak biasa, termasuk kesalahan dan peringatan.
  • warning: menghasilkan pesan peringatan yang sesuai dengan argumennya
  • stop: menghentikan eksekusi ekspresi saat ini

Contoh kondisi

Kondisi error

log("text")

Kondisi warning

log(-1) 
## Warning in log(-1): NaNs produced
## [1] NaN

Penanganan kondisi

Menggunakan stop() dan stopifnot()

if (1 != 2)
  stop("something is wrong")
stopifnot(1 == 2)

Dengan warning()

warning("bad weather today, don't forget your umbrella")
## Warning: bad weather today, don't forget your umbrella

Dengan message()

message("good morning")
## good morning

Menggunakan try() atau tryCatch()

test <- function() {
  log("not a number")
  print("R does stop due to an error and never executes this line")
}

test()  
try(log("not a number"), silent = T)
print("errors can't stop me")
## [1] "errors can't stop me"
an.error.occured <- FALSE
tryCatch({ 
  result <- log("not a number"); print(result)
}, error = function(e) {
  an.error.occured <<- TRUE
})
print(an.error.occured)
## [1] TRUE

Object Oriented Programming

Pemrograman berorientasi objek merupakan sebuah paradigma dalam pembuatan sebuah program. OOP menitikberatkan pada identifikasi objek-objek yang terlibat dalam sebuah program dan bagaimana objek-objek tersebut berinterakasi. Pada OOP, program yang dibangun akan dibagi-bagi menjadi objek-objek. OOP menyediakan class dan object sebagai alat dasar untuk meminimalisir dan mengatur kompleksitas dari program.

Class (kelas)

Merupakan definisi statik (kerangka dasar) dari objek yang akan diciptakan. Suatu class dibagi menjadi:

  • Property : data atau state yang dimiliki oleh class. Contoh pada class Mobil, memiliki property: warna, Model, Produsen.
  • Method : behavior (perilaku) sebuah class. Bisa dikatakan sebagai aksi atau tindakan yang bisa dilakukan oleh suatu class. Contoh pada class Mobil, memiliki method: Start, Stop, Change Gear, Turn.

Object

Objek adalah komponen yang diciptakan dari class (instance of class). Satu class bisa menghasilkan banyak objek. Proses untuk membuat sebuah objek disebut instantiation. Setiap objek memiliki karakteristik dan fitur masing masing. Objek memiliki siklus creation, manipulation, dan destruction.

Prinsip dasar dari OOP adalah abstraksi, enkapsulasi, inheritance (pewarisan), dan polymorphism.

Object-oriented pada R

R telah mengimplementasikan pemrograman berorientasi objek. Semua dalam R adalah objek. Pengembangan awal objek di R menggunakan Class System S3 yang tidak terlalu ketat. Pendefinisian yang ketat secara formal, R menggunakan Class System S4.

Ilustrasi 1

Class System S3

Prinsip dasarnya adalah memungkinkan pemrogram untuk overloading suatu fungsi dengan memisahkan fungsi tersebut menjadi argumen yang generik dengen methodnya.

Sebagai ilustrasi akan dibuat studentBio yang berisi daftar komponen student_nama, student_umur, and student_kontak. Class ini diberi nama Student Info dan studentBio adalah suatu kelas baru yang memiliki nilai sebagai berikut.

studentBio <- list(student_nama = "Harry Potter", student_umur = 19, student_kontak="London")
class(studentBio) <- "StudentInfo"
studentBio
## $student_nama
## [1] "Harry Potter"
## 
## $student_umur
## [1] 19
## 
## $student_kontak
## [1] "London"
## 
## attr(,"class")
## [1] "StudentInfo"

Kemudian dibuat fungsi generik kontak dimana fungsi ini akan diberikan kepada objek yang akan diinisialisasi. Dengan menggunakan fungsi UseMethod pada fungsi generik kontak, maka properti student_kontak pada class studentBio di atas dapat diakses hanya dengan menyertakan simbol dot menjadi kontak.studentBio.

kontak <- function(object) {
  UseMethod("kontak")
}

Sehingga objek dapat dipanggil dengan contoh berikut

kontak.StudentInfo <- function(object) {
  cat("Kontak anda adalah", object$student_kontak, "\n")
}
kontak(studentBio)
## Kontak anda adalah London
cetakumur <- function(object) {
  UseMethod("cetakumur")
}
cetakumur.StudentInfo <- function(object) {
  cat("Umur ", object$student_nama, " adalah ", object$student_umur, "\n")
}
cetakumur(studentBio)
## Umur  Harry Potter  adalah  19

Class System S4

Berbeda dengan S3 Class, S4 Class lebih ketat, konvensional, dan lebih mirip dengan konsep object-oriented. Secara spesifik S4, memilki fungsi setter dan getter untuk fungsi method dan generiknya. Dalam menginisialisasi suatu class, digunakan fungsi setClass().

Berikut ini dibuat sebuat class mahasiswa dengan karakter yaitu

setClass("mahasiswa", slots=list(nama="character", nim="numeric", kontak="character"))

Buat objek menggunakan new isi dengan nilai yang sesuai

obj <- new("mahasiswa", nama="Alfa", nim=1501211013, kontak="Bogor")
obj
## An object of class "mahasiswa"
## Slot "nama":
## [1] "Alfa"
## 
## Slot "nim":
## [1] 1501211013
## 
## Slot "kontak":
## [1] "Bogor"

Dengan membuat method generik di Class S4, maka akses properti atau method menggunakan simbol @

setMethod("show", "mahasiswa",
  function(object) {
    cat("Nama:",object@nama, "\n")
    cat("NIM:",object@nim, "\n")
    cat("Kontak:", object@kontak, "\n")
  }
)
obj
## Nama: Alfa 
## NIM: 1501211013 
## Kontak: Bogor

Ilustrasi 2

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 untuk setiap titik pada koordinat X dan Y. Metode pada class vcoords merupakan pewarisan dari class coords dan operasi-operasi aritmetik terhadap nilainya.

Class System S3

Contoh

# List creation with its attributes x and y.
pts <- list(x = round(rnorm(5),2),
            y = round(rnorm(5),2))
class(pts)
## [1] "list"

Menjadikan pts sebagai class baru:

class(pts) <- "coords"
class(pts)
## [1] "coords"
pts
## $x
## [1]  1.35 -1.74 -0.52  1.02 -0.67
## 
## $y
## [1]  0.27  1.44  0.11  0.07 -0.14
## 
## attr(,"class")
## [1] "coords"
Konstruktor

Fungsi Konstruktor untuk Membuat class coords

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))
pts
## $x
## [1]  0.19  0.77 -0.57 -1.60 -1.60
## 
## $y
## [1]  1.33 -0.09 -0.55  0.86  0.19
## 
## attr(,"class")
## [1] "coords"

Fungsi Konstruktor untuk Membuat class mobil

# Membuat list Mobil1
Mobil1 <- list(Nama="Toyota",
               Panjang=3.5,
               Lebar=2,
               Kecepatan=180)
class(Mobil1)
## [1] "list"
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"
Aksesor

Akses pada class coord dengan menggunakan 2 fungsi

xcoords <- function(obj) obj$x
ycoords <- function(obj) obj$y
xcoords(pts)
## [1]  0.19  0.77 -0.57 -1.60 -1.60
ycoords(pts)
## [1]  1.33 -0.09 -0.55  0.86  0.19

Akses pada class mobil menggunakan fungsi aksesor

nama <- function(objek) objek$Nama
kecepatan <- function(objek) objek$Kecepatan
panjang <- function(objek) objek$Panjang
lebar<- function(objek) objek$Lebar
nama(Mobil1)
## [1] "Toyota"
kecepatan(Mobil3)
## [1] 120
panjang(Mobil3)
## [1] 2.1
Fungsi Generik

Fungsi generik bertindak untuk beralih memilih fungsi tertentu atau metode tertentu yang dijalankan sesuai dengan class-nya. Untuk mendefinisi ulang suatu fungsi generik digunakan syntax

method.class <-function() ekspresibaru
Print

Untuk class coords

print.coords <- function(obj) {
    print(paste("(", format(xcoords(obj)), ", ", format(ycoords(obj)),
        ")", sep = ""), quote = FALSE)
}
pts
## [1] ( 0.19,  1.33) ( 0.77, -0.09) (-0.57, -0.55) (-1.60,  0.86) (-1.60,  0.19)

Untuk class mobil

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

print.mobil(Mobil1)
## Nama : Toyota
## Kecepatan : 180
## Panjang:3.5
## Lebar:2
## NULL
Length
length(pts)
## [1] 2

Definisi ulang

length.coords <- function(obj) length(xcoords(obj))
length(pts)
## [1] 5
Membuat Fungsi Generik Baru

Misal ingin membuat method bbox yang merupakan boundary box

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.60 -0.55
## max  0.77  1.33

Plot khusus untuk class coords

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 class

Sebagai ilustrasi jika diinginkan sebuah objek yang berisi lokasi (coords) dan terdapat nilai pada lokasi tersebut maka diperlukan class baru vcoords sebagai turunan dari coords

Konstruktor untuk 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", "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.13, -1.92) (-0.48,  1.00) ( 0.39, -0.22) ( 0.62,  0.55) ( 1.00,  1.05)
xcoords(vpts)
## [1]  1.13 -0.48  0.39  0.62  1.00
ycoords(vpts)
## [1] -1.92  1.00 -0.22  0.55  1.05
bbox(vpts)
##        x:    y:
## min -0.48 -1.92
## max  1.13  1.05

Pendefinisian ulang method print

print.vcoords <- function(obj) {
    print(paste("(", format(xcoords(obj)), ", ", format(ycoords(obj)),
        "; ", format(nilai(obj)), ")", sep = ""), quote = FALSE)
}
vpts
## [1] ( 1.13, -1.92; 81) (-0.48,  1.00;  7) ( 0.39, -0.22; 79) ( 0.62,  0.55; 60)
## [5] ( 1.00,  1.05; 77)

Pendefinisian ulang method plot

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

Menampilkan plot

plot(vpts)

plot(vpts, txt = T, bbox = T, col = "red")

Subseting

`[.vcoords` <- function(x, i) {
    vcoords(xcoords(x)[i], ycoords(x)[i], nilai(x)[i])
}
vpts[1:3]
## [1] ( 1.13, -1.92; 81) (-0.48,  1.00;  7) ( 0.39, -0.22; 79)
Pemeriksaan suatu class objek
inherits(pts, " coords ")
## [1] FALSE
inherits(pts, " vcoords ")
## [1] FALSE
inherits(vpts, " coords ")
## [1] FALSE
inherits(vpts, " vcoords ")
## [1] FALSE
model <- list(1:10)
class(model) <- "lm"

model
## 
## Call:
## NULL
## 
## No coefficients

Object : Class System S4

Class System S4 mengatasi masalah dalam Class System S3 dengan sistem objek lebih formal. Sebuah class terdiri dari slot dengan tipe atau class spesifik.

Deklarasi

Class dideklarasikan dengan fungsi setClass

Contoh 1, mendefinisikan ulang class coords ke class system S4

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

Contoh 2, deklarasi class car

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

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

Membuat objek coords

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))
}
set.seed(123)
pts <- coords(round(rnorm(5), 2), round(rnorm(5), 2))
pts
## An object of class "coords"
## Slot "x":
## [1] -0.56 -0.23  1.56  0.07  0.13
## 
## Slot "y":
## [1]  1.72  0.46 -1.27 -0.69 -0.45

Membuat object car 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] "list"
Aksesor

Akses terhadap slot menggunakan operator @

slot(pts, "x")
## [1] -0.56 -0.23  1.56  0.07  0.13
pts@x
## [1] -0.56 -0.23  1.56  0.07  0.13
slot(pts, "y")
## [1]  1.72  0.46 -1.27 -0.69 -0.45
pts@y
## [1]  1.72  0.46 -1.27 -0.69 -0.45

Disarankan menggunakan fungsi

xcoords <- function(obj) obj@x
ycoords <- function(obj) obj@y
xcoords(pts)
## [1] -0.56 -0.23  1.56  0.07  0.13

Akses terhadap slot pada objek car

Car1@Nama
## [1] "Toyota"
Car2@Kecepatan
## [1] 150

Akses terhadap slot pada objek car dengan fungsi aksesor

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

nama1(Car1)
## [1] "Toyota"
kecepatan1(Car2)
## [1] 150
Fungsi generik

Penciptaan fungsi generik menggunakan fungsi setMethod. Argumen didefinisikan dalam signature

Contoj: show (setara dengan print pada S3)

setMethod(show, signature(object = "coords"), 
          function(object) print(paste("(",
                                       format(xcoords(object)), 
                                       ", ", format(ycoords(object)),
                                       ")", sep = ""), 
                                 quote = FALSE))
pts
## [1] (-0.56,  1.72) (-0.23,  0.46) ( 1.56, -1.27) ( 0.07, -0.69) ( 0.13, -0.45)
setMethod(show, "car",
          function(object) {
            print(cat("Nama : ", nama1(object), "\n",
                      "Kecepatan : ", kecepatan1(object),
                      sep="")
                  )}
          )
Car2
## Nama : Suzuki
## Kecepatan : 150NULL
Definisi fungsi generik baru
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 -0.56 -1.27
## max  1.56  1.72
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 = "red", xlab = "x",
     ylab = "y")

Pewarisan class

Akan dibuat 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.56,  1.72) (-0.23,  0.46) ( 1.56, -1.27) ( 0.07, -0.69) ( 0.13, -0.45)

Definisi ulang 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.56,  1.72; 89) (-0.23,  0.46; 69) ( 1.56, -1.27; 64) ( 0.07, -0.69; 99)
## [5] ( 0.13, -0.45; 66)

Definisi ulang 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 = "red")


  1. Mahasiswa Pascasarjana IPB, ↩︎