KONSEP DASAR JST 8: SCRIPT PNN DAN CPNN DENGAN MENGGUNAKAN R

Finally, kita sampai di penghujung pembahasan terkait PNN dan CPNN. Yeaaay! Berikut merupakan script R untuk menghitung probabilitas kelas bersyarat dengan menggunakan PNN dan CPNN. Pembahasan PNN dan CPNN berikut algoritma yang digunakan dalam script ini mengacu pada penelitian yang dilakukan oleh Zeinaly dan Story (2017) dan dibuat oleh Pak Hastu tanpa mengubah petunjuk dan arahan yang bapak berikan, hanya menambahkan sedikit keterangan tambahan dan link untuk memahami format fungsi R-nya lebih lanjut. Kalimat yang saya cetak tebal (bold) merupakan tambahan keterangan dari saya. Saya akan coba jelaskan secara garis besar maksud dan alur berpikir dari script yang saya lampirkan berikut ini, ya! Sekaligus akan saya sertakan juga contoh datanya, jadi kalian langsung download juga.

Berikut ini merupakan script PNN dan CPNN beserta dengan penjelasannya

# Ini script pnn dan cpnn yang aku bikin tanpa menggunakan paket dari R

# atau dengan kata lain, dibuat dari awal, mengacu pada paper zeinali

# Buat dipelajari, ada baiknya jangan dijalankan langsung, tapi baris demi baris saja dulu

# caranya, taruh kursor di baris paling atas (nomer satu, berisi komentar ini script pnn ... dst)

# Setelah itu, tekan cntrl+enter, maka R akan mengeksekusi sebuah instruksi di baris bawahnya

# Lakukan hal ini sampai baris paling bawah, sambil dipelajari kira2 apa maksud script yg aku

# sudah aku tulis ini

#Sama seperti mengetikkan “reinit” di GrADS atau “clear all” di Matlab, remove list -> rm(list) di R memiliki peranan yang serupa, yaitu untuk menghapus semua objek atau membersihkan workspace pada menu entri sehingga program kembali ke kondisi “default”, kondisi awal, dimana belum ada fungsi yang aktif, belum ada data yang dipanggil, dan lain-lain. Sehingga tidak ada fungsi atau command yang tumpang tindih nantinya. Sementara itu, penjelasan yang lebih lengkap mengenai dev.list dan  dev.off dapat kalian baca di link ini. 

rm(list = ls())

while(!is.null(dev.list())) dev.off()

# Pastikan di R mu sudah terinstal paket dplyr. kalau baris nomer 18 ini error

# Saat dijalankan, itu berarti paket dplyr belum ada di komputermu.

# Untuk menginstal paket ini bila belum ada, caranya:

# 1. pastikan komputermu terhubung ke internet

# 2. ketik install.packages('dplyr') di bagian console (di bawah script script editor ini)

# Setelah itu jalankan kembali bari nomer 18 ini

# Di sebagian device, termasuk di punya saya ketika saya mengetikkan library(dplyr) maka muncul peringatan berikut.

Attaching package: ‘dplyr’

The following objects are masked from ‘package:stats’:

    filter, lag

The following objects are masked from ‘package:base’:

    intersect, setdiff, setequal, union

# Peringatan tersebut setelah saya baca artinya bahwa kedua packages memiliki fungsi dengan nama yang sama. Dalam kasus ini, dplyr dengan stats memiliki 2 fungsi yang sama serta dplyr dengan base memiliki 4 fungsi yang sama. Jika memang terganggu dan tidak ingin peringatan tersebut muncul kembali, kalian bisa mengetikkan library(dplyr, warn.conflicts=false).

library(dplyr)

# Fungsi di bawah ini digunakan untuk menghitung jarak Euclidian antara nilai 1 dan nilai 2. Fungsi rbind digunakan untuk menggabungkan data by row (berdasar baris) antara nilai 1 dan 2, kemudian baru dihitung jarak Euclidnya dengan fungsi dist. Penjelasan lebih lanjut untuk fungsi dist dapat kalian lihat di link berikut, sementara untuk rbind di link berikut. Ohiya, bagi yang sama kayak aku penasaran sama maksud simbol ini %>%, jadi simbol tersebut sangat identik digunakan ketika kita menggunakan library(dplyr), jadi kayak udah pasangan gitu mereka berdua. Ketika kita tidak memanggil library(dplyr) maka kita tidak mungkin bisa mengeksekusi command di bawah ini.

jarak.kuadrat <- function(nilai.1, nilai.2) nilai.1 %>% rbind(nilai.2) %>% dist %>% '^'(2)

# Setelah menghitung jarak Euclid, kemudian menghitung nilai kernel (omega.ij) dengan data input baru (x.new), data yang sudah ada (x.cij) dengan spread parameter (sigma.input). Perhitungan ini persis seperti rumus yang tertera dalam paper Zeinali dan Story (2017) dan sudah dijelaskan pada postingan sebelumnya.

omega.ij <- function(x.new, x.c.ij, sigma.input) {

  argumen <- -jarak.kuadrat(x.new, x.c.ij) %>% '/'(2 * (sigma.input^2)) %>% exp

  return(argumen / (

    ((2 * pi)^(length(x.new) / 2)) * (sigma.input^length(x.new))

  )

  )

}

# Setelah mendapatkan nilai kernel untuk tiap data, maka dilanjutkan dengan menghitung probabilitas kelas bersyarat (class-conditional probability, p.x.new.ci), dimana gamma.input tidak diperhitungkan dalam PNN dan diperhitungkan nilainya dalam CPNN. Fungsi p.x.new.ci digunakan untuk menghitung nilai class-conditional probability, sementara jumlah.omega dihitung dengan mempertimbangkan nilai dari gamma.input untuk menyeleksi seberapa banyak data.input yang dipertimbangkan dalam perhitungan. Kemudia nilai kernel yang terpilih diurutkan dengan fungsi sort dari urutan yang terbesar ke terkecil (rev). Setelah itu, sama seperti perhitungan dalam algoritma PNN, nilai tersebut dihitung rata-ratanya (mean).

p.x.new.ci <- function(x.new, data.input, sigma.input, gamma.input = NULL) {

  if(!is.null(gamma.input) & is.numeric(gamma.input)) {

    jumlah.omega <- data.input %>% nrow %>% '*'(gamma.input) %>% round

    omega <- apply(data.input, 1, function(input1)

      omega.ij(x.new, input1, sigma.input)) %>% sort %>% rev

    return(omega[1:jumlah.omega] %>% mean(na.rm = TRUE))

  } else {

    apply(data.input, 1, function(input1)

      omega.ij(x.new, input1, sigma.input)) %>% mean(na.rm = TRUE)

  }

}

# Pada algoritma CPNN, fungsi di atas selanjutnya diterapkan pada “kelas terpilih” SAJA yang ditentukan berdasarkan gamma.input dan untuk dapat melakukan penerapan fungsi pada bagian yang terpilih maka digunakan fungsi tapply(X, index, fun), dimana X adalah objek (vektor), index adalah list yang mengandung vektor, dan fun adalah fungsi yang ingin diterapkan. Selanjutnya juga terdapat sapply yang memiliki fungsi yang sama dengan lapply namun dapat digunakan untuk kembali ke perhitungan vektor. Penjelasan lebih lanjut mengenai fungsi ini dapat dilihat melalui link berikut. Kemudian sebagai output, kelas ditentukan berdasarkan nilai Parzen yang terbesar (which.max)

c.pnn <- function(x.new, data.input, data.kelas, sigma.input, gamma.input = NULL) {

  indeks.kelas <- tapply(1:length(data.kelas), data.kelas, function(input1) return(input1))

  hasil.p.x.new.ci <- sapply(

    indeks.kelas, function(input1) {

      p.x.new.ci(x.new, data.input[input1, ], sigma.input, gamma.input)

    }

  )

  output <- data.frame(

    kelas = (data.kelas %>% as.factor %>% levels)[hasil.p.x.new.ci %>% which.max],

    nilai.parzen.terpilih = hasil.p.x.new.ci[hasil.p.x.new.ci %>% which.max]

  )

  rownames(output) <- NULL

  return(output)

}

# Baris-baris script di atas adalah fungsi2 untuk melakukan proses perhitungan

# PNN dan CPNN. kedua algoritma tersebut dipanggil menggunakan fungsi yang sama,

# yaitu c.pnn(). yang membedakan adalah: untuk pnn, parameter gamma tidak usah diisi,

# atau diisi dengan 'NULL', sedangkan untuk melakukan proses perhitungan cpnn,

# Parameter gamma diisi dengan angka real 0 s/d 1.

# Implementasi pada contoh data adalah sbb:

# Buka filenya

# Pastikan mengisi dengan lengkap nama direktorinya juga, di dalam tanda petik,

# Misalnya:

# 'D:/skripsi/contohdata.csv'

# Tapi karena di komputerku sudah aku set direktorinya, jadi tdk perlu aku tambahkan

# Kalau di komputermu, tambahkan nama direktorinya

contoh.data <- read.csv('D:/contohdata.csv', sep = ';')

# Standardisasi fitur-fiturnya kecuali fitur respon

# Seperti yang kita ketahui bahwa syarat perhitungan dengan PNN dan CPNN, prediktor yang dimiliki harus distandardisasi atau dinormalisasi. Dalam R, perhitungan ini dilakukan dengan menggunakan fungsi scale, KECUALI pada kolom VINTAGES karena merupakan variabel respon dalam kasus ini

contoh.data.scale <- scale(contoh.data %>% select(-vintages))

# Ambil beberapa contoh data untuk dicoba, misalnya sejumlah 10

# Sebelum digunakan untuk menguji data diluar data training, maka perlu dicoba dulu untuk menguji beberapa sampel dari training data itu sendiri. Ketika hal ini dilakukan, kita dapat mengetahui apakah model kita underfitting atau overfitting. Command selanjutnya insyaAllah lebih mudah dimengerti dan sudah disertai dengan keterangan yang sudah cukup membantu, ya kan?

indeks.coba <- sample(1:nrow(contoh.data.scale), 10, replace = FALSE)

# Pisahkan data training dengan testing

training <- contoh.data.scale[-indeks.coba,]

testing <- contoh.data.scale[indeks.coba,]

# Buat daftar respon training dan testing sesuai uruta pengambilan acak

respon.training <- contoh.data$vintages[-indeks.coba]

respon.testing <- contoh.data$vintages[indeks.coba]

# Coba kita lihat hasilnya

head(training, 30)

View(testing)

head(respon.training, 30)

View(respon.testing)

# Sekarang kita coba menjalankan pnn dg nilai sigma = 0.7

hasil.pnn <- apply(

  testing, 1, function(input) {

    c.pnn(x.new = input,

          data.input = training,

          data.kelas = respon.training,

          sigma.input = 0.7)

  }

)

# Sekarang kita coba menjalankan cpnn dengan nilai sigma 0.7 dan nilai gamma 0.9

hasil.cpnn <- apply(

  testing, 1, function(input) {

    c.pnn(x.new = input,

          data.input = training,

          data.kelas = respon.training,

          sigma.input = 0.7,

          gamma.input = 0.9

    )

  }

)

# Sekarang lihat hasil pnn:

(hasil.pnn)

# Sekarang lihat hasil cpnn:

(hasil.cpnn)

# Sekarang kita lihat confussion:

# Fungsi table disini adalah untuk membuat tabel dengan respon.testing sebagai row dan hasil sapply sebagai kolom dengan format karakter (as.karakter). Penjelasan lebih lanjut terkait tabel dapat kit abaca melalui link berikut. 

conf.pnn <- table(respon.testing %>% as.character,

                  sapply(hasil.pnn, function(input) input$kelas) %>% as.character)

# Sekarang kita lihat confussion:

conf.cpnn <- table(respon.testing %>% as.character,

                   sapply(hasil.cpnn, function(input) input$kelas) %>% as.character)

# Tampilkan hasilnya:

(conf.pnn)

(conf.cpnn)

Jadi seperti itulah, script PNN dan CPNN. Catatan: INGAAT! untuk semua tulisan yang bold harus dihapus terlebih dahulu ya sebelum mengeksekusi script ini di R. Semoga tulisan ini bisa bermanfaat dan mohon doanya agar tugas akhirku dapat diselesaikan dengan baik, yaa! See you next time! Hehe.