Praktikum 10: Supervised dan Unsupervised Learning
1. Praktik dengan data padi
Dari data yang sama, kita bisa membuat prediksi atau mencari kelompok. Hari ini kita mencoba keduanya lewat studi kasus pertanian.
| Pertanyaan | Pendekatan | Hasil yang dicari |
|---|---|---|
| Berapa hasil panen pada kondisi tertentu? | Supervised learning: regresi | Prediksi angka |
| Kondisi lahan mana yang mirip? | Unsupervised learning: clustering | Kelompok pengamatan |
Pada akhir praktikum, kita bisa membaca pola data, menambah fitur yang sesuai, menilai prediksi pada data uji, dan menjelaskan hasil K-Means. Waktu praktik sekitar dua jam.
Sebelum mulai: pada pertanyaan pertama, kolom mana yang menjadi target? Apakah kolom itu juga harus dipakai pada pertanyaan kedua?
Mulai di R
Ganti nim_seed sesuai arahan kelas. Jalankan kode secara
berurutan; tombol Code membuka sintaks di setiap
bagian.
nim_seed <- 123
set.seed(nim_seed)
n <- 150
padi <- data.frame(
curah_hujan = rnorm(n, mean = 180, sd = 40),
suhu = rnorm(n, mean = 27, sd = 2),
pupuk = rnorm(n, mean = 110, sd = 20)
)
padi$hasil_panen <- -0.0008 * (padi$curah_hujan - 180)^2 +
0.03 * padi$pupuk + rnorm(n, mean = 0, sd = 1)knitr::kable(head(padi, 5), digits = 2,
col.names = c("Curah hujan", "Suhu", "Pupuk", "Skor hasil panen"),
row.names = FALSE)| Curah hujan | Suhu | Pupuk | Skor hasil panen |
|---|---|---|---|
| 157.6 | 28.58 | 95.70 | 3.90 |
| 170.8 | 28.54 | 94.95 | 3.83 |
| 242.3 | 27.66 | 91.23 | 0.06 |
| 182.8 | 24.98 | 88.95 | 3.38 |
| 185.2 | 26.76 | 101.26 | 3.93 |
Ini adalah data simulasi, mengikuti mekanisme pada
modul praktikum. hasil_panen dibaca sebagai skor
simulasi, bukan ton per hektare. Nilai negatif tidak berarti
produksi fisik yang negatif.
| Variabel | Peran pada regresi | Peran pada clustering hari ini |
|---|---|---|
curah_hujan |
Prediktor | Dasar pengelompokan |
suhu |
Prediktor | Tidak digunakan |
pupuk |
Prediktor | Dasar pengelompokan |
hasil_panen |
Target yang diprediksi | Tidak digunakan |
2. Data latih dan data uji
Model belajar dari data latih. Data uji dipakai untuk memeriksa prediksi pada pengamatan yang belum ikut melatih model.
set.seed(nim_seed + 1)
id_latih <- sample(seq_len(nrow(padi)), size = floor(0.8 * nrow(padi)))
latih <- padi[id_latih, ]
uji <- padi[-id_latih, ]
knitr::kable(data.frame(
Bagian = c("Data latih", "Data uji"),
Jumlah = c(nrow(latih), nrow(uji)),
Kegunaan = c("EDA dan pelatihan model", "Evaluasi prediksi")
), row.names = FALSE)| Bagian | Jumlah | Kegunaan |
|---|---|---|
| Data latih | 120 | EDA dan pelatihan model |
| Data uji | 30 | Evaluasi prediksi |
knitr::kable(data.frame(
Variabel = names(latih),
Nilai_hilang = colSums(is.na(latih))
), col.names = c("Variabel", "Nilai hilang"), row.names = FALSE)| Variabel | Nilai hilang |
|---|---|
| curah_hujan | 0 |
| suhu | 0 |
| pupuk | 0 |
| hasil_panen | 0 |
EDA untuk membentuk model berikut memakai data latih. Dengan begitu, kita tidak mengintip pola target pada data uji untuk merancang fitur.
Diskusi singkat: kalau model dilatih dan dinilai pada pengamatan yang sama, kemampuan apa yang sebenarnya sedang kita ukur?
3. EDA sebelum pemodelan
Distribusi dan pengamatan ekstrem
Mulai dari dua hal: rentang curah hujan dan sebaran skor hasil panen.
par(mfrow = c(1, 2))
tema_plot()
hist(latih$curah_hujan, breaks = 12,
col = "#AAD1DF", border = "white",
main = "Sebaran curah hujan", xlab = "Curah hujan", ylab = "Frekuensi")
tema_plot()
boxplot(latih$hasil_panen, horizontal = TRUE,
col = "#F0C59E", border = jingga,
main = "Sebaran skor hasil panen", xlab = "Skor hasil panen", yaxt = "n")
stripchart(latih$hasil_panen, method = "jitter", add = TRUE,
vertical = FALSE, pch = 16, cex = 0.7,
col = adjustcolor(biru, alpha.f = 0.5))- Apakah ada pengamatan yang jauh dari sebagian besar data?
- Apakah nilai ekstrem itu kesalahan pencatatan atau bagian dari pola yang perlu dipelajari?
Titik di luar whisker boxplot tidak otomatis salah. Periksa konteksnya sebelum memutuskan untuk menghapusnya. Prediktor juga tidak harus berdistribusi normal agar dapat masuk ke regresi linear.
Hubungan prediktor dengan hasil panen
par(mfrow = c(1, 3))
tema_plot()
plot(latih$curah_hujan, latih$hasil_panen,
pch = 19, cex = 0.85, col = adjustcolor(biru, 0.6),
xlab = "Curah hujan", ylab = "Skor hasil panen", main = "Curah hujan")
lines(lowess(latih$curah_hujan, latih$hasil_panen), col = jingga, lwd = 3)
tema_plot()
plot(latih$suhu, latih$hasil_panen,
pch = 19, cex = 0.85, col = adjustcolor(biru, 0.6),
xlab = "Suhu", ylab = "Skor hasil panen", main = "Suhu")
lines(lowess(latih$suhu, latih$hasil_panen), col = jingga, lwd = 3)
tema_plot()
plot(latih$pupuk, latih$hasil_panen,
pch = 19, cex = 0.85, col = adjustcolor(biru, 0.6),
xlab = "Pupuk", ylab = "Skor hasil panen", main = "Pupuk")
lines(lowess(latih$pupuk, latih$hasil_panen), col = jingga, lwd = 3)
Titik adalah pengamatan pada data latih. Garis jingga merangkum
kecenderungan lokal dengan lowess(); garis ini membantu
EDA, belum menjadi model prediksi yang akan kita evaluasi.
korelasi <- cor(latih[c("curah_hujan", "suhu", "pupuk")], latih$hasil_panen)
knitr::kable(data.frame(
Prediktor = rownames(korelasi),
Korelasi_linear = as.numeric(korelasi)
), digits = 3, col.names = c("Prediktor", "Korelasi linear dengan target"),
row.names = FALSE)| Prediktor | Korelasi linear dengan target |
|---|---|
| curah_hujan | -0.213 |
| suhu | 0.094 |
| pupuk | 0.377 |
Amati grafik curah hujan: apakah satu garis lurus sudah cukup? Bandingkan bentuk grafiknya dengan nilai korelasi linear pada tabel.
Korelasi linear yang kecil dapat muncul meskipun hubungan melengkung terlihat jelas. Pola pada simulasi ini memberi alasan untuk mencoba fitur kuadratik. Pola tersebut tidak boleh langsung ditafsirkan sebagai bukti pengaruh sebab akibat pada lahan nyata.
4. Fitur untuk pola melengkung
Kita tambahkan fitur yang mengukur kuadrat selisih curah hujan dari 180. Nilai 180 sudah ditetapkan dalam skenario simulasi, bukan dicari dari data uji.
latih$hujan_kuadrat <- (latih$curah_hujan - 180)^2
uji$hujan_kuadrat <- (uji$curah_hujan - 180)^2
contoh_hujan <- c(130, 155, 180, 205, 230)
knitr::kable(data.frame(
Curah_hujan = contoh_hujan,
Selisih_dari_180 = contoh_hujan - 180,
Kuadrat_selisih = (contoh_hujan - 180)^2
), col.names = c("Curah hujan", "Selisih dari 180", "Kuadrat selisih"),
row.names = FALSE)| Curah hujan | Selisih dari 180 | Kuadrat selisih |
|---|---|---|
| 130 | -50 | 2500 |
| 155 | -25 | 625 |
| 180 | 0 | 0 |
| 205 | 25 | 625 |
| 230 | 50 | 2500 |
Curah hujan yang berjarak sama dari 180 menghasilkan nilai kuadrat yang sama. Fitur ini memberi ruang bagi model untuk membentuk pola melengkung.
Hubungannya boleh melengkung, tetapi model ini tetap linear
terhadap parameter β. Kita masih bisa menduganya menggunakan
lm().
5. Regresi untuk prediksi
Dua bentuk model
Kita membandingkan spesifikasi dengan prediktor linear dan spesifikasi dengan tambahan fitur kuadratik. Keduanya memakai data latih yang sama.
model_linear <- lm(
hasil_panen ~ curah_hujan + suhu + pupuk,
data = latih
)
model_kuadratik <- lm(
hasil_panen ~ curah_hujan + hujan_kuadrat + suhu + pupuk,
data = latih
)knitr::kable(data.frame(
Komponen = names(coef(model_kuadratik)),
Koefisien = unname(coef(model_kuadratik))
), digits = 5, row.names = FALSE)| Komponen | Koefisien |
|---|---|
| (Intercept) | 0.28615 |
| curah_hujan | -0.00069 |
| hujan_kuadrat | -0.00086 |
| suhu | -0.00275 |
| pupuk | 0.03062 |
Perhatikan tanda koefisien hujan_kuadrat. Nilai negatif
memungkinkan pola melengkung ke bawah. Besar koefisien mentah
antarvariabel tidak langsung menunjukkan variabel yang paling penting
karena skala dan bentuk fiturnya berbeda.
Bentuk prediksi yang dipelajari
grid_hujan <- data.frame(
curah_hujan = seq(min(latih$curah_hujan), max(latih$curah_hujan), length.out = 180),
suhu = mean(latih$suhu),
pupuk = mean(latih$pupuk)
)
grid_hujan$hujan_kuadrat <- (grid_hujan$curah_hujan - 180)^2
tema_plot()
plot(latih$curah_hujan, latih$hasil_panen,
pch = 19, col = adjustcolor("#5D7E8D", 0.45),
xlab = "Curah hujan", ylab = "Skor hasil panen",
main = "Garis lurus dan pola kuadratik")
lines(grid_hujan$curah_hujan, predict(model_linear, grid_hujan),
col = jingga, lwd = 3, lty = 2)
lines(grid_hujan$curah_hujan, predict(model_kuadratik, grid_hujan),
col = biru, lwd = 3)
legend("bottom", horiz = TRUE, bty = "n",
legend = c("Linear", "Dengan fitur kuadratik"),
col = c(jingga, biru), lwd = 3, lty = c(2, 1), cex = 0.9)Kurva prediksi menahan suhu dan pupuk pada rata-rata data latih. Titik tetap memakai nilai suhu dan pupuk masing-masing, sehingga tidak harus tepat berada pada kurva.
Prediksi pada data uji
pred_linear <- predict(model_linear, newdata = uji)
pred_kuadratik <- predict(model_kuadratik, newdata = uji)
knitr::kable(head(data.frame(
Aktual = uji$hasil_panen,
Prediksi_linear = pred_linear,
Prediksi_kuadratik = pred_kuadratik
), 5), digits = 3, row.names = FALSE)| Aktual | Prediksi_linear | Prediksi_kuadratik |
|---|---|---|
| 3.899 | 1.999 | 2.595 |
| 2.930 | 0.814 | 1.912 |
| 1.601 | 2.026 | 2.831 |
| -0.681 | 1.764 | -2.598 |
| 2.777 | 3.217 | 3.135 |
newdata = uji memastikan prediksi dihitung untuk
pengamatan uji. Jika newdata dihilangkan,
predict() pada model lm mengembalikan prediksi
untuk data yang dipakai melatih model.
6. Evaluasi pada data uji
Error menunjukkan seberapa jauh prediksi dari nilai aktual. Kita gunakan MAE dan RMSE, keduanya dalam satuan skor hasil panen.
| Ukuran | Cara membaca |
|---|---|
| MAE | Rata-rata besar selisih absolut antara aktual dan prediksi |
| RMSE | Akar rata-rata kuadrat error; lebih peka terhadap error yang besar |
mae <- function(aktual, prediksi) mean(abs(aktual - prediksi))
rmse <- function(aktual, prediksi) sqrt(mean((aktual - prediksi)^2))
pred_baseline <- rep(mean(latih$hasil_panen), nrow(uji))
evaluasi <- data.frame(
Model = c("Rata-rata data latih", "Linear", "Dengan fitur kuadratik"),
MAE_latih = c(
mae(latih$hasil_panen, rep(mean(latih$hasil_panen), nrow(latih))),
mae(latih$hasil_panen, fitted(model_linear)),
mae(latih$hasil_panen, fitted(model_kuadratik))
),
MAE_uji = c(mae(uji$hasil_panen, pred_baseline),
mae(uji$hasil_panen, pred_linear),
mae(uji$hasil_panen, pred_kuadratik)),
RMSE_uji = c(rmse(uji$hasil_panen, pred_baseline),
rmse(uji$hasil_panen, pred_linear),
rmse(uji$hasil_panen, pred_kuadratik))
)
knitr::kable(evaluasi, digits = 3,
col.names = c("Model", "MAE latih", "MAE uji", "RMSE uji"), row.names = FALSE)| Model | MAE latih | MAE uji | RMSE uji |
|---|---|---|---|
| Rata-rata data latih | 1.518 | 1.423 | 1.987 |
| Linear | 1.394 | 1.418 | 1.920 |
| Dengan fitur kuadratik | 0.747 | 0.745 | 0.890 |
MAE uji model kuadratik adalah 0.745. Artinya, pada data uji ini, rata-rata besar selisih prediksi dari skor aktual sekitar 0.745 poin.
Baseline selalu menebak rata-rata target pada data latih. Model yang lebih rumit perlu memberikan manfaat dibandingkan tebakan sederhana ini.
rentang <- range(c(uji$hasil_panen, pred_linear, pred_kuadratik))
par(mfrow = c(1, 2))
tema_plot()
plot(uji$hasil_panen, pred_linear,
xlim = rentang, ylim = rentang, pch = 19, col = adjustcolor(jingga, 0.8),
xlab = "Skor aktual", ylab = "Skor prediksi", main = "Model linear")
abline(a = 0, b = 1, col = "#80919B", lty = 2, lwd = 2)
tema_plot()
plot(uji$hasil_panen, pred_kuadratik,
xlim = rentang, ylim = rentang, pch = 19, col = adjustcolor(biru, 0.8),
xlab = "Skor aktual", ylab = "Skor prediksi", main = "Model kuadratik")
abline(a = 0, b = 1, col = "#80919B", lty = 2, lwd = 2)Semua titik pada kedua panel berasal dari data uji yang sama. Makin dekat titik ke garis putus-putus, makin dekat prediksi ke nilai aktual.
Diskusi: apakah error harus menjadi nol agar model berguna? Apa yang terjadi jika error data latih sangat kecil, tetapi error data uji besar?
Perbandingan ini dipakai untuk membaca kinerja dua spesifikasi yang telah ditentukan. Jika ingin mencari model atau parameter terbaik dari banyak percobaan, lakukan validasi atau cross-validation pada data latih. Simpan data uji untuk penilaian akhir.
7. K-Means untuk pengelompokan
Sekarang pertanyaannya berubah: pengamatan mana yang memiliki
kombinasi curah hujan dan pupuk yang mirip? Kita memakai
seluruh pengamatan untuk eksplorasi clustering, tanpa memasukkan
hasil_panen.
Samakan skala sebelum menghitung jarak
X_cluster <- padi[c("curah_hujan", "pupuk")]
X_standar <- scale(X_cluster)
knitr::kable(data.frame(
Variabel = colnames(X_cluster),
SD_awal = sapply(X_cluster, sd),
Rata_rata_setelah_scale = colMeans(X_standar),
SD_setelah_scale = apply(X_standar, 2, sd)
), digits = 3,
col.names = c("Variabel", "SD awal", "Rata-rata setelah scale", "SD setelah scale"),
row.names = FALSE)| Variabel | SD awal | Rata-rata setelah scale | SD setelah scale |
|---|---|---|---|
| curah_hujan | 37.99 | 0 | 1 |
| pupuk | 20.63 | 0 | 1 |
scale() membuat kedua fitur memiliki rata-rata sekitar 0
dan simpangan baku 1. Ini membantu agar perbedaan skala tidak membuat
satu variabel mendominasi jarak.
Contoh partisi menjadi tiga cluster
centers = 3: banyak cluster untuk contoh ini.nstart = 25: mencoba 25 inisialisasi dan mengambil hasil dengan SSE terkecil di antara percobaan tersebut.iter.max = 100: batas iterasi untuk satu percobaan.
tema_plot()
plot(padi$curah_hujan, padi$pupuk,
pch = 19, col = adjustcolor(warna_cluster[km3$cluster], 0.8),
xlab = "Curah hujan", ylab = "Pupuk",
main = "K-Means dengan K = 3")
pusat3 <- aggregate(X_cluster, by = list(Cluster = km3$cluster), FUN = mean)
points(pusat3$curah_hujan, pusat3$pupuk, pch = 4, cex = 2.1, lwd = 3)
legend("topright", legend = paste("Cluster", 1:3),
col = warna_cluster[1:3], pch = 19, bty = "n", cex = 0.85)K-Means dihitung pada data standar. Grafik ditampilkan kembali pada skala awal agar mudah dibaca. Tanda silang menunjukkan rata-rata setiap cluster pada skala awal.
profil <- pusat3
profil$Jumlah <- as.integer(table(km3$cluster))
profil <- profil[c("Cluster", "Jumlah", "curah_hujan", "pupuk")]
knitr::kable(profil, digits = 2,
col.names = c("Cluster", "Jumlah pengamatan", "Rata-rata curah hujan", "Rata-rata pupuk"),
row.names = FALSE)| Cluster | Jumlah pengamatan | Rata-rata curah hujan | Rata-rata pupuk |
|---|---|---|---|
| 1 | 60 | 155.4 | 125.5 |
| 2 | 48 | 169.0 | 88.9 |
| 3 | 42 | 224.3 | 108.7 |
Gunakan tabel ini untuk memberi deskripsi, misalnya kelompok dengan rata-rata curah hujan lebih tinggi. Nomor cluster tidak menunjukkan urutan kualitas atau produktivitas lahan.
8. Jumlah cluster dan kualitasnya
Elbow dan silhouette
SSE mengukur jumlah kuadrat jarak ke pusat cluster. Penambahan cluster biasanya menurunkan SSE, sehingga SSE terkecil saja belum cukup untuk menentukan K.
K <- 1:6
SSE <- numeric(length(K))
siluet <- rep(NA_real_, length(K))
model_k <- vector("list", length(K))
for (k in K) {
set.seed(nim_seed)
model_k[[k]] <- kmeans(X_standar, centers = k, nstart = 25, iter.max = 100)
SSE[k] <- model_k[[k]]$tot.withinss
if (k >= 2) {
siluet[k] <- mean(cluster::silhouette(
model_k[[k]]$cluster, dist(X_standar)
)[, "sil_width"])
}
}
knitr::kable(data.frame(K = K, SSE = SSE, Silhouette = siluet),
digits = 3, row.names = FALSE)| K | SSE | Silhouette |
|---|---|---|
| 1 | 298.00 | NA |
| 2 | 185.90 | 0.334 |
| 3 | 127.80 | 0.352 |
| 4 | 100.84 | 0.330 |
| 5 | 79.44 | 0.341 |
| 6 | 64.39 | 0.348 |
par(mfrow = c(1, 2))
tema_plot()
plot(K, SSE, type = "b", pch = 19, lwd = 2.5, col = biru,
xlab = "Jumlah cluster (K)", ylab = "SSE", main = "Elbow method", xaxt = "n")
axis(1, at = K)
tema_plot()
plot(K[-1], siluet[-1], type = "b", pch = 19, lwd = 2.5, col = hijau,
xlab = "Jumlah cluster (K)", ylab = "Rata-rata silhouette",
main = "Silhouette", xaxt = "n", ylim = c(0, 1))
axis(1, at = K[-1])| Yang diperhatikan | Cara membaca |
|---|---|
| Elbow | Cari perubahan saat tambahan K mulai memberi penurunan SSE yang lebih kecil. Jika tekukannya tidak jelas, jangan dipaksakan. |
| Silhouette mendekati 1 | Pengamatan relatif dekat dengan kelompoknya dan jauh dari kelompok lain. |
| Silhouette sekitar 0 | Pengamatan berada dekat batas antarkelompok. |
| Silhouette negatif | Pengamatan dapat lebih dekat dengan kelompok lain. |
Silhouette tidak didefinisikan untuk satu cluster; karena itu nilai K
= 1 pada tabel ditulis NA.
Coba ganti K
Pilih jumlah cluster, lalu perhatikan titik mana yang berpindah kelompok. Grafik ini memakai hasil perhitungan R yang sama dengan tabel di atas.
K = 2; SSE = 185.900; rata-rata silhouette = 0.334.
K = 3; SSE = 127.799; rata-rata silhouette = 0.352.
K = 4; SSE = 100.842; rata-rata silhouette = 0.330.
K = 5; SSE = 79.443; rata-rata silhouette = 0.341.
K = 6; SSE = 64.392; rata-rata silhouette = 0.348.
K = 3 di bagian sebelumnya adalah contoh untuk praktik, bukan jumlah kelompok alami yang sudah diketahui. Data ini dibangkitkan dari distribusi kontinu, tanpa membuat tiga populasi terpisah. Hasil partisi perlu dibaca bersama kurva evaluasi dan tujuan analisis.
Diskusi: kalau K dinaikkan terus, apakah hasilnya pasti lebih berguna? Apakah mengganti nama Cluster 1 menjadi Cluster 2 mengubah kualitas pengelompokannya?
9. Latihan penutup
A. Regresi dan fitur
Gunakan pembagian data yang sama. Coba model kuadratik tanpa
suhu.
model_tanpa_suhu <- lm(
hasil_panen ~ curah_hujan + hujan_kuadrat + pupuk,
data = latih
)
pred_tanpa_suhu <- predict(model_tanpa_suhu, newdata = uji)
mae(uji$hasil_panen, pred_tanpa_suhu)Bandingkan MAE-nya dengan model kuadratik awal. Jelaskan mengapa menambah satu prediktor tidak selalu memperbaiki prediksi pada data uji. Jangan menjadikan satu pembagian data sebagai bukti bahwa suatu fitur selalu tidak berguna.
B. Pengelompokan dan skala
set.seed(nim_seed)
km4 <- kmeans(X_standar, centers = 4, nstart = 25)
table(km4$cluster)
set.seed(nim_seed)
km_tanpa_scale <- kmeans(X_cluster, centers = 3, nstart = 25)Bandingkan K = 3 dengan K = 4 melalui grafik interaktif dan tabel evaluasi. Lalu jelaskan mengapa hasil tanpa standardisasi dapat berbeda. Bandingkan SSE hanya jika memakai skala fitur yang sama.
Ringkasan hasil praktik
| Bagian | Hasil yang dituliskan |
|---|---|
| Regresi | Tabel MAE model awal dan model tanpa suhu, disertai interpretasi singkat |
| Clustering | Perbandingan K = 3 dan K = 4 serta deskripsi profil kelompok |
| Refleksi | Peran EDA, alasan menambah fitur kuadratik, dan perbedaan prediksi dengan pengelompokan |
Cek pemahaman sebelum selesai
- Mengapa error tidak nol? Ada komponen acak dalam simulasi, parameter diduga dari sampel, dan model bisa belum menangkap seluruh pola.
- Mengapa tetap perlu data uji? Kita ingin mengetahui kemampuan prediksi pada pengamatan yang tidak ikut melatih model.
- Apakah hasil clustering dinilai dengan MAE hasil panen? Tidak. Target itu tidak menjadi acuan pembentukan cluster dalam praktik ini.
- Apakah model lebih kompleks selalu lebih baik? Tidak. Periksa manfaatnya pada evaluasi yang sesuai dan perhatikan kompleksitasnya.
Dokumentasi fungsi R
Dokumentasi resmi: regresi linear, prediksi model, standardisasi, K-Means, dan silhouette.