Kata Pengantar
Mata kuliah Spatial Statistics dimulai dengan memahami konsep paling dasar yaitu lokasi, jarak, dan matriks bobot spasial. Tiga konsep ini merupakan fondasi penting sebelum masuk ke analisis spasial yang lebih lanjut seperti autokorelasi, regresi spasial, maupun geostatistik.
Lokasi adalah representasi posisi objek pada ruang geografis. Dalam data spasial, lokasi dapat direpresentasikan dalam berbagai bentuk: - Koordinat titik (point): misalnya lokasi rumah sakit, sekolah, kasus penyakit. - Garis (line): misalnya jalan, sungai, jaringan listrik. - Poligon (area): misalnya batas kecamatan, provinsi, atau wilayah administrasi.
Lokasi dapat ditentukan melalui sistem koordinat geografis (latitude–longitude) atau sistem koordinat proyeksi (misalnya UTM). Pemilihan sistem koordinat memengaruhi interpretasi jarak dan arah.
Lokasi memungkinkan kita menghubungkan data dengan ruang. Misalnya: - Kasus demam berdarah di setiap kelurahan Bandung. - Pusat kesehatan terdekat bagi penduduk. - Perubahan tutupan lahan pada suatu wilayah.
Jarak adalah ukuran kedekatan atau keterpisahan antara dua lokasi. Dalam data spasial, jarak sangat penting karena sering kali menentukan hubungan antar-unit.
Euclidean distance
Jarak garis lurus antara dua titik \((x_i,
y_i)\) dan \((x_j, y_j)\):
\[ d_{ij} = \sqrt{(x_i - x_j)^2 + (y_i - y_j)^2} \]
Manhattan distance
Jarak berbasis grid (seperti jalan kota):
\[ d_{ij} = |x_i - x_j| + |y_i - y_j| \]
Great-circle distance (Haversine)
Digunakan pada permukaan bumi (koordinat lintang–bujur).
Matriks bobot spasial (\(W\)) adalah representasi formal dari keterkaitan antar-unit spasial. Elemen \(w_{ij}\) menyatakan tingkat kedekatan atau hubungan antara unit \(i\) dan \(j\).
Unit dianggap bertetangga jika jarak \(d_{ij} \leq d_0\) (threshold).
Bobot bisa diberikan sebagai fungsi jarak, misalnya:
\[ w_{ij} = \frac{1}{d_{ij}^2} \]
Matriks \(W\) sering dinormalisasi agar setiap baris menjumlah ke 1:
\[ w_{ij}^{*} = \frac{w_{ij}}{\sum_j w_{ij}} \]
Hal ini memudahkan interpretasi dan analisis lanjutan.
Misalkan ada 4 kelurahan dengan pola tetangga sebagai berikut:
Maka matriks bobot \(W\) (rook contiguity) adalah:
\[ W = \begin{bmatrix} 0 & 1 & 1 & 0 \\\\ 1 & 0 & 0 & 1 \\\\ 1 & 0 & 0 & 0 \\\\ 0 & 1 & 0 & 0 \end{bmatrix} \]
library(spdep)
library(sf)
# Contoh data shapefile
nc <- st_read(system.file("shape/nc.shp", package="sf"))
# Membuat matriks bobot Queen contiguity
nb <- poly2nb(nc, queen=TRUE)
W <- nb2mat(nb, style="W") # Normalisasi row-standardized
# Menampilkan matriks bobot
print(W[1:5, 1:5])
Spatial mapping adalah proses visualisasi data yang memiliki dimensi
geografis.
Tujuan utama dari mapping adalah:
Dalam materi ini kita akan menggunakan data kasus Diare di Kota Bandung untuk contoh pemetaan.
library(spdep)
library(sp)
library(sf)
library(ggplot2)
library(dplyr)
# Arahkan ke folder kerja Anda
setwd("/Users/mindra/Library/CloudStorage/GoogleDrive-mindra@unpad.ac.id/My Drive/Spatial")
# Data kasus
Diare <- read.csv("Diare.csv", sep=";")
# Peta administratif Indonesia level kecamatan (gadm36 level 3)
Indo_Kec <- readRDS('gadm36_IDN_3_sp.rds')
# Ambil hanya Kota Bandung
Bandung <- Indo_Kec[Indo_Kec$NAME_2 == "Kota Bandung",]
plot(Bandung)
# Tambahkan id untuk join
Bandung$id <- c(1:30)
# Ubah ke format sf
Bandung_sf <- st_as_sf(Bandung)
# Gabungkan dengan data kasus
Bandung_merged <- Bandung_sf %>%
left_join(Diare, by = "id")
ggplot() +
geom_sf(data=Bandung_merged, aes(fill = Diare), color=NA) +
theme_bw() +
scale_fill_gradient(low = "yellow", high = "red") +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
legend.position = "right") +
labs(title = "Peta Kasus Diare Kota Bandung",
fill = "Jumlah Kasus")
Interpretasi: Warna merah menandakan kasus lebih tinggi, kuning lebih rendah.
# Interval kategori
breaks <- c(-Inf, 550, 800, 1200, Inf)
labels <- c("Very Low", "Low", "High", "Very High")
# Buat variabel diskrit
Bandung_merged$Diare_Discrete <- cut(Bandung_merged$Diare,
breaks = breaks,
labels = labels,
right = TRUE)
ggplot() +
geom_sf(data=Bandung_merged, aes(fill = Diare_Discrete), color=NA) +
theme_bw() +
scale_fill_manual(values = c("Very Low" = "yellow",
"Low" = "orange",
"High" = "red",
"Very High" = "red3")) +
theme(axis.text.x = element_blank(),
axis.text.y = element_blank(),
legend.position = "right") +
labs(title = "Kategori Kasus Diare Kota Bandung",
fill = "Kategori")
Interpretasi: Kategori “High” dan “Very High” dapat mengindikasikan wilayah dengan risiko lebih besar.
Autokorelasi spasial digunakan untuk melihat apakah data memiliki pola keterkaitan antar wilayah tetangga.
# Matriks bobot spasial
row.names(Bandung) <- as.character(1:30)
W <- poly2nb(Bandung, row.names(Bandung), queen=FALSE)
WB <- nb2mat(W, style='B', zero.policy = TRUE)
WL <- nb2listw(W)
# Plot jaringan tetangga
CoordK <- coordinates(Bandung)
plot(Bandung, axes=T, col="gray90")
text(CoordK[,1], CoordK[,2], row.names(Bandung), col="black", cex=0.8, pos=1.5)
points(CoordK[,1], CoordK[,2], pch=19, cex=0.7, col="blue")
plot.nb(W, CoordK, add=TRUE, col="red", lwd=2)
# Global Moran's I
Global_Moran <- moran.test(Diare$Diare, WL)
Global_Moran
##
## Moran I test under randomisation
##
## data: Diare$Diare
## weights: WL
##
## Moran I statistic standard deviate = 0.67226, p-value = 0.2507
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic Expectation Variance
## 0.04045578 -0.03448276 0.01242630
Interpretasi: Nilai Moran’s I menunjukkan apakah ada pola clustering (positif) atau sebaran acak.
Local Moran’s I digunakan untuk mengidentifikasi cluster lokal (misalnya high-high, low-low).
Local_Moran <- localmoran(Diare$Diare, WL)
# Ambil informasi quadran
mean_values_char <- as.character(attr(Local_Moran, "quadr")$mean)
Bandung_sf$mean_values <- mean_values_char
# Plot hasil LISA
ggplot() +
geom_sf(data = Bandung_sf, aes(fill = mean_values)) +
scale_fill_manual(values = c("Low-Low" = "blue",
"High-Low" = "green",
"Low-High" = "yellow",
"High-High" = "red")) +
labs(title = "Local Moran's I Kota Bandung",
fill = "Cluster Type") +
theme_minimal()
Interpretasi:
High-High (Merah): cluster wilayah dengan kasus tinggi dikelilingi wilayah tinggi.
Low-Low (Biru): cluster wilayah dengan kasus rendah dikelilingi wilayah rendah.
Low-High / High-Low: wilayah dengan nilai berbeda dari tetangganya (potensi outlier spasial).
Spatial autocorrelation mengukur derajat kemiripan nilai antar lokasi. Dua ukuran global yang klasik adalah Moran’s \(I\) (Moran, 1950) dan Geary’s \(C\) (Geary, 1954). Analisis lokal menggunakan Local Moran’s \(I\) (Anselin, 1995) dan Getis–Ord untuk mengidentifikasi hot spots dan cold spots.
Misalkan terdapat \(N\) area dengan variabel minat \(x_i\). Rata-rata \(\bar x\). Matriks bobot spasial \(W=(w_{ij})\) dengan \(w_{ii}=0\) kecuali dinyatakan lain. Jumlah total bobot \(S_0=\sum_i \sum_j w_{ij}\).
\[ I = \frac{N}{S_0} \cdot \frac{\sum_{i=1}^{N}\sum_{j=1}^{N} w_{ij}(x_i-\bar{x})(x_j-\bar{x})}{\sum_{i=1}^{N}(x_i-\bar{x})^2}. \]
Interpretasi:
Karakteristik:
\[ I_i = \frac{x_i - \bar{x}}{m_2} \sum_{j=1}^{N} w_{ij}(x_j-\bar{x}), \qquad m_2 = \frac{1}{N}\sum_{k=1}^N (x_k-\bar{x})^2. \]
Interpretasi:
Karakteristik:
Definisi asli dari statistik lokal Getis–Ord tidak terstandar adalah rasio massa tetangga dengan massa total (Ord & Getis, 1995). Untuk suatu band jarak \(d\) (atau bobot ketetanggaan biner) dengan \(w_{ij}(d)\in\{0,1\}\):
Tanpa memasukkan lokasi \(i\) (local \(G_i\)): \[ G_i(d) = \frac{\sum_{j \ne i} w_{ij}(d)\, x_j}{\sum_{j \ne i} x_j}. \]
Memasukkan lokasi \(i\) (local \(G_i^*\)): \[ G_i^*(d) = \frac{\sum_{j=1}^{N} w_{ij}(d)\, x_j}{\sum_{j=1}^{N} x_j}, \qquad \text{dengan } w_{ii}(d) = 1. \]
Nilai besar \(G_i^*\) mengindikasikan hot spot (nilai tinggi dikelilingi tinggi), sedangkan kecil mengindikasikan cold spot.
Untuk inferensi, \(G_i^*\) biasanya distandarisasi menjadi \(z(G_i^*)\). Bentuk z-skor (yang umum dihitung oleh paket perangkat lunak) adalah:
\[ z(G_i^*) = \frac{\sum_j w_{ij} x_j - \bar{x}\sum_j w_{ij}} { s \sqrt{\dfrac{ N \sum_j w_{ij}^2 - \left( \sum_j w_{ij} \right)^2 }{N-1}} }, \qquad s = \sqrt{\frac{\sum_k (x_k - \bar{x})^2}{N}}. \]
Catatan: Rumus di atas adalah z-skor dari \(G_i^*\), bukan definisi raw \(G_i^*\).
Interpretasi:
Karakteristik:
\[ C = \frac{(N-1)\sum_{i=1}^N \sum_{j=1}^N w_{ij} (x_i - x_j)^2}{2 S_0 \sum_{i=1}^N (x_i-\bar{x})^2}. \]
Interpretasi:
Karakteristik:
Ringkasan Perbedaan
| Indeks | Jenis | Fokus utama | Nilai referensi | Sensitivitas |
|---|---|---|---|---|
| Moran’s \(I\) | Global | Kovarians antar lokasi | \(I \approx 0\) | Kemiripan global (mirip Pearson) |
| Geary’s \(C\) | Global | Variasi/perbedaan antar tetangga | \(C = 1\) | Lebih peka terhadap contrast lokal |
| Getis–Ord \(G_i^*\) | Lokal | Deteksi hot/cold spots (klaster nilai) | \(Z\)-skor \(\approx 0\) | Identifikasi lokasi cluster tinggi/rendah |
library(sf)
library(sp)
library(spdep)
library(dplyr)
library(ggplot2)
library(mapview)
library(spData)
# ==== Opsi A: menggunakan file RDS Anda ====
setwd("/Users/mindra/Library/CloudStorage/GoogleDrive-mindra@unpad.ac.id/My Drive/Spatial")
Indo_Kec <- readRDS("gadm36_IDN_3_sp.rds")
Bandung <- Indo_Kec[Indo_Kec$NAME_2 == "Kota Bandung", ]
Bandung$id <- seq_len(nrow(Bandung))
Bandung_sf <- sf::st_as_sf(Bandung)
# Untuk keperluan *knit* tanpa data eksternal, siapkan grid mock 30 poligon (DEMO).
if(!exists("Bandung_sf")) {
bb <- sf::st_as_sfc(sf::st_bbox(c(xmin=107.55, ymin=-6.98, xmax=107.72,
ymax=-6.85), crs=4326))
grid <- sf::st_make_grid(bb, n=c(6,5)) |> sf::st_as_sf() |> dplyr::mutate(id = dplyr::row_number())
Bandung_sf <- grid
}
Bandung_sf <- sf::st_make_valid(Bandung_sf)
Bandung_sf$id <- if(!"id" %in% names(Bandung_sf)) seq_len(nrow(Bandung_sf)) else Bandung_sf$id
ggplot(Bandung_sf) + geom_sf(fill="grey90", color="white") +
labs(title="Kota Bandung - Unit (contoh)") + theme_minimal()
Sketsa batas kecamatan (mock atau Bandung sebenarnya)
# Neighbor queen
nb <- spdep::poly2nb(sf::as_Spatial(Bandung_sf), queen = TRUE)
# Listw untuk analitik global/lokal (row-standar & biner)
lwW <- spdep::nb2listw(nb, style="W") # row-standardized
lwB <- spdep::nb2listw(nb, style="B") # binary (untuk raw G)
N <- nrow(Bandung_sf)
z <- rnorm(N)
lz <- spdep::lag.listw(lwW, z)
beta0 <- 1.2; beta1 <- 0.6; beta2 <- 1.0
lambda <- exp(beta0 + beta1*scale(z) + beta2*scale(lz))
pop <- round(runif(N, 3000, 8000))
cases <- rpois(N, lambda=lambda * (pop/10000))
Diare <- dplyr::tibble(id = Bandung_sf$id, pop = pop, cases = cases,
rate10k = (cases/pop)*10000)
Bandung_merged <- dplyr::left_join(Bandung_sf, Diare, by="id")
ggplot(Bandung_merged) +
geom_sf(aes(fill = rate10k), color="white", size=0.2) +
scale_fill_viridis_c(option="magma") +
labs(title="Rate Diare (per 10.000) — Simulasi", fill="Rate") +
theme_minimal()
Rate Diare (per 10.000) — Simulasi
moran_res <- spdep::moran.test(Bandung_merged$rate10k, lwW,
randomisation = TRUE, alternative = "two.sided")
moran_res
##
## Moran I test under randomisation
##
## data: Bandung_merged$rate10k
## weights: lwW
##
## Moran I statistic standard deviate = 4.8496, p-value = 1.237e-06
## alternative hypothesis: two.sided
## sample estimates:
## Moran I statistic Expectation Variance
## 0.50481782 -0.03448276 0.01236637
geary_res <- spdep::geary.test(Bandung_merged$rate10k, lwW,
randomisation = TRUE, alternative = "two.sided")
geary_res
##
## Geary C test under randomisation
##
## data: Bandung_merged$rate10k
## weights: lwW
##
## Geary C statistic standard deviate = 4.3461, p-value = 1.386e-05
## alternative hypothesis: two.sided
## sample estimates:
## Geary C statistic Expectation Variance
## 0.47515619 1.00000000 0.01458327
x <- scale(Bandung_merged$rate10k)[,1]
lagx <- spdep::lag.listw(lwW, x)
lisa <- spdep::localmoran(x, lwW, alternative = "two.sided", zero.policy = TRUE)
lisa_df <- as.data.frame(lisa)
names(lisa_df) <- c("Ii","Ei","Vi","Zi","Pi.two.sided")
alpha <- 0.05
quad <- dplyr::case_when(
x >= 0 & lagx >= 0 ~ "High-High",
x < 0 & lagx < 0 ~ "Low-Low",
x >= 0 & lagx < 0 ~ "High-Low (Outlier)",
x < 0 & lagx >= 0 ~ "Low-High (Outlier)"
)
Bandung_LISA <- dplyr::bind_cols(Bandung_merged, lisa_df) |>
dplyr::mutate(quad = ifelse(Pi.two.sided <= alpha, quad, "Not significant"))
ggplot(Bandung_LISA) +
geom_sf(aes(fill = quad), color="white", size=0.2) +
scale_fill_manual(values=c(
"High-High"="#d73027","Low-Low"="#4575b4",
"High-Low (Outlier)"="#fdae61","Low-High (Outlier)"="#74add1",
"Not significant"="grey85"
)) +
labs(title="Local Moran's I (LISA)", fill="Kategori") +
theme_minimal()
Local Moran’s I (LISA) — Cluster & Outlier (p≤0.05)
x_raw <- Bandung_merged$rate10k
sum_x <- sum(x_raw)
# Matriks bobot biner (tidak distandarisasi)
Wb <- spdep::listw2mat(lwB) # diag=0 secara default
# G_i (tanpa i)
num_G <- as.numeric(Wb %*% x_raw) # Σ_{j≠i} w_ij x_j
den_G <- (sum_x - x_raw) # Σ_{j≠i} x_j
G_raw <- num_G / den_G
# G_i^* (dengan i) — set w_ii = 1
Wb_star <- Wb; diag(Wb_star) <- 1
num_Gs <- as.numeric(Wb_star %*% x_raw) # Σ_j w_ij^* x_j
den_Gs <- sum_x # Σ_j x_j
G_star_raw <- num_Gs / den_Gs
# Z-skor (yang dihitung spdep::localG)
Gz <- spdep::localG(x_raw, listw = lwW) # z(G_i^*) dengan listw yang diberikan
Bandung_G <- dplyr::mutate(Bandung_merged,
G_raw = G_raw,
G_star_raw = G_star_raw,
z_Gistar = as.numeric(Gz),
hotcold = dplyr::case_when(
z_Gistar >= 1.96 ~ "Hot spot (p≈0.05)",
z_Gistar <= -1.96 ~ "Cold spot (p≈0.05)",
TRUE ~ "Not significant"
))
summary(dplyr::select(Bandung_G, G_raw, G_star_raw, z_Gistar))
## G_raw G_star_raw z_Gistar geometry
## Min. :0.00000 Min. :0.01069 Min. :-1.7571 MULTIPOLYGON :30
## 1st Qu.:0.05115 1st Qu.:0.07107 1st Qu.:-1.1364 epsg:NA : 0
## Median :0.09574 Median :0.11959 Median :-0.9334 +proj=long...: 0
## Mean :0.13832 Mean :0.16419 Mean :-0.2353
## 3rd Qu.:0.16788 3rd Qu.:0.18923 3rd Qu.: 0.1827
## Max. :0.48942 Max. :0.53346 Max. : 4.1541
ggplot(Bandung_G) +
geom_sf(aes(fill = G_star_raw), color="white", size=0.2) +
scale_fill_viridis_c() +
labs(title="Raw Getis–Ord G* (proporsi massa tetangga)", fill="G*_raw") +
theme_minimal()
ggplot(Bandung_G) +
geom_sf(aes(fill = hotcold), color="white", size=0.2) +
scale_fill_manual(values=c("Hot spot (p≈0.05)"="#b2182b",
"Cold spot (p≈0.05)"="#2166ac",
"Not significant"="grey85")) +
labs(title="Getis–Ord Gi* — Hot/Cold Spots (z-skor)", fill=NULL) +
theme_minimal()
# Rook: buat ulang neighbor dengan queen = FALSE
nb_rook <- spdep::poly2nb(sf::as_Spatial(Bandung_sf), queen = FALSE)
lw_rook <- spdep::nb2listw(nb_rook, style="W")
# kNN (k = 4)
coords <- sf::st_coordinates(sf::st_centroid(Bandung_sf))
nb_knn <- spdep::knn2nb(spdep::knearneigh(coords, k = 4))
lw_knn <- spdep::nb2listw(nb_knn, style="W")
# Bandingkan rata-rata z(Gi*) untuk tiga bobot
c(
mean_z_queen = mean(spdep::localG(Bandung_merged$rate10k, lwW)),
mean_z_rook = mean(spdep::localG(Bandung_merged$rate10k, lw_rook)),
mean_z_knn4 = mean(spdep::localG(Bandung_merged$rate10k, lw_knn))
)
## mean_z_queen mean_z_rook mean_z_knn4
## -0.2353182 -0.2481379 -0.1905173
readr::write_csv(dplyr::as_tibble(Diare), "diare_simulasi_bandung.csv")
sf::st_write(Bandung_LISA, "bandung_lisa.geojson", delete_dsn=TRUE)
sf::st_write(Bandung_G, "bandung_getis.geojson", delete_dsn=TRUE)
Referensi
Mahasiswa memahami konsep dasar autokorelasi spasial, mampu menghitung ukuran global dan lokal (Moran’s I, Geary’s C, Local Moran’s I, Getis–Ord), serta menginterpretasikan hasil dalam konteks nyata.
Bagian A. Konsep Teori
Bagian B. Analisis Data (Simulasi)
Bagian C. Pengukuran Autokorelasi
Bagian D. Diskusi Kritis
Penilaian
Mengapa OLS biasa tidak cukup?
Notasi umum:
Kita gunakan dua sumber data agar komprehensif:
spData.# Install jika perlu:
# install.packages(c("spdep", "spatialreg", "Matrix", "spData", "sp"))
library(spdep)
library(spatialreg)
library(Matrix)
library(spData) # untuk data columbus
library(sp)
set.seed(123)
nrow_grid <- 15; ncol_grid <- 15
N <- nrow_grid * ncol_grid
nb <- cell2nb(nrow_grid, ncol_grid, type = "queen")
lw <- nb2listw(nb, style = "W", zero.policy = TRUE) # W row-standardized
W <- listw2mat(lw)
W_mat <- Matrix(W, sparse = TRUE)
# Kovariat & outcome untuk contoh
p <- 3
X <- cbind(1, matrix(rnorm(N*(p-1)), N, p-1))
colnames(X) <- c("(Intercept)", paste0("x", 1:(p-1)))
beta_true <- c(2, 1.0, -0.8)
rho_true <- 0.4; sigma_true <- 1.0
I_N <- Diagonal(N)
eps <- rnorm(N, sd = sigma_true)
y_mean <- as.numeric(X %*% beta_true)
y <- as.numeric(solve(I_N - rho_true * W_mat, y_mean + eps)) # SAR DGP
dat_grid <- data.frame(y = y, X[, -1, drop = FALSE])
data(columbus, package = "spData")
# 'columbus' umumnya hadir sebagai SpatialPolygonsDataFrame di beberapa versi spData/spdep.
# Jika tidak tersedia sebagai objek 'Spatial', kita buat poligon sederhana dari centroid via k-NN agar contoh tetap jalan.
# Jika columbus berupa 'Spatial*DataFrame'
if (inherits(columbus, "Spatial")) {
coords <- coordinates(columbus)
nb_c <- poly2nb(columbus) # ROOK dari poligon
} else {
# Fallback: gunakan koordinat X,Y lalu buat nb KNN
coords <- as.matrix(columbus[, c("X", "Y")])
knn <- knearneigh(coords, k = 5)
nb_c <- knn2nb(knn)
}
lw_c <- nb2listw(nb_c, style = "W")
d_col <- as.data.frame(columbus)
d_col$CRIME <- d_col$CRIME
d_col$INC <- d_col$INC
d_col$HOVAL <- d_col$HOVAL
Catatan: Perbedaan versi paket dapat mengubah kelas objek
columbus. Blok di atas membuat contoh tetap replikabel.
Ide dasar. Hanya spillover dari
kovariat tetangga dimodelkan, bukan dari \(y\). Tidak ada umpan-balik antar
respon.
Kapan digunakan. Saat kita percaya bahwa karakteristik
tetangga (mis. pendapatan, fasilitas publik) memengaruhi wilayah, tetapi
hasil/respon tidak saling menular.
Contoh aplikasi. Kemiskinan kota dipengaruhi oleh
pendidikan di kota tetangga; tingkat vaksinasi tetangga
memengaruhi risiko lokal meski prevalensi lokal tidak “menular”
antary.
Rumus. \[ y = X\beta + W X\theta + \epsilon, \quad \epsilon \sim \mathcal{N}(0, \sigma^2 I). \]
R di data grid (simulasi).
slx_grid <- lmSLX(y ~ ., data = dat_grid, listw = lw, Durbin = TRUE)
summary(slx_grid)
##
## Call:
## lm(formula = formula(paste("y ~ ", paste(colnames(x)[-1], collapse = "+"))),
## data = as.data.frame(x), weights = weights)
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.351e+00 6.823e-02 4.911e+01 1.528e-120
## x1 9.767e-01 7.262e-02 1.345e+01 1.712e-30
## x2 -8.080e-01 6.825e-02 -1.184e+01 2.424e-25
## lag.x1 6.620e-01 2.003e-01 3.305e+00 1.108e-03
## lag.x2 -2.933e-02 1.845e-01 -1.590e-01 8.738e-01
R di data Columbus (aplikasi nyata). Kita ingin melihat pengaruh INC (pendapatan) dan HOVAL (nilai rumah) lokal dan tetangga terhadap CRIME.
slx_col <- lmSLX(CRIME ~ INC + HOVAL, data = d_col, listw = lw_c, Durbin = TRUE)
summary(slx_col)
##
## Call:
## lm(formula = formula(paste("y ~ ", paste(colnames(x)[-1], collapse = "+"))),
## data = as.data.frame(x), weights = weights)
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.609e+01 6.168e+00 1.234e+01 7.058e-16
## INC -1.255e+00 3.857e-01 -3.253e+00 2.194e-03
## HOVAL -2.638e-01 1.031e-01 -2.559e+00 1.403e-02
## lag.INC -5.277e-01 6.667e-01 -7.916e-01 4.328e-01
## lag.HOVAL -1.481e-01 2.594e-01 -5.709e-01 5.710e-01
Interpretasi. Koefisien pada \(X\) = efek langsung; pada \(WX\) = spillover. Tidak
perlu impacts() karena tidak ada lag \(y\).
Ide dasar. Respon suatu wilayah dipengaruhi respon
tetangga: umpan balik & difusi.
Kapan digunakan. Harga rumah, kriminalitas, adopsi
teknologi, pertumbuhan ekonomi regional.
Rumus.
\[ y = \rho Wy + X\beta + \epsilon, \qquad \epsilon \sim \mathcal{N}(0, \sigma^2 I). \] Dengan \(A(\rho)=I-\rho W\), model setara: \(A(\rho)y = X\beta + \epsilon\).
Likelihoood ML (ringkas). \[
\ell(\beta,\rho,\sigma^2) = \log|A(\rho)| - \frac{N}{2}\log\sigma^2
- \frac{1}{2\sigma^2}\big(A(\rho)y - X\beta\big)^\top\big(A(\rho)y -
X\beta\big).
\] Likelihood terkonsentrasi: untuk setiap \(\rho\),
\(\hat{\beta}(\rho)=(X^\top X)^{-1}X^\top
A(\rho)y\),
\(\hat{\sigma}^2(\rho)=\frac{1}{N}\|A(\rho)y -
X\hat{\beta}(\rho)\|^2\).
Maksimalkan \(\ell_c(\rho)=\log|A(\rho)| -
\tfrac{N}{2}\log\hat{\sigma}^2(\rho)\).
R (grid & Columbus).
sar_grid <- lagsarlm(y ~ ., data = dat_grid, listw = lw, method = "eigen")
sar_col <- lagsarlm(CRIME ~ INC + HOVAL, data = d_col, listw = lw_c, method = "eigen")
summary(sar_grid)
##
## Call:lagsarlm(formula = y ~ ., data = dat_grid, listw = lw, method = "eigen")
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.795576 -0.616588 0.048715 0.703882 2.411899
##
## Type: lag
## Coefficients: (asymptotic standard errors)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.928892 0.257210 7.4993 6.417e-14
## x1 0.952970 0.068100 13.9936 < 2.2e-16
## x2 -0.805996 0.063997 -12.5943 < 2.2e-16
##
## Rho: 0.42618, LR test value: 27.234, p-value: 1.8027e-07
## Asymptotic standard error: 0.074348
## z-value: 5.7322, p-value: 9.9132e-09
## Wald statistic: 32.858, p-value: 9.9132e-09
##
## Log likelihood: -313.5954 for lag model
## ML residual variance (sigma squared): 0.92292, (sigma: 0.96069)
## Number of observations: 225
## Number of parameters estimated: 5
## AIC: 637.19, (AIC for lm: 662.42)
## LM test for residual autocorrelation
## test value: 0.80142, p-value: 0.37067
summary(sar_col)
##
## Call:lagsarlm(formula = CRIME ~ INC + HOVAL, data = d_col, listw = lw_c,
## method = "eigen")
##
## Residuals:
## Min 1Q Median 3Q Max
## -34.87401 -6.05795 0.11128 5.94981 22.51885
##
## Type: lag
## Coefficients: (asymptotic standard errors)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 40.745935 7.181891 5.6734 1.4e-08
## INC -0.910833 0.301872 -3.0173 0.002551
## HOVAL -0.260186 0.084861 -3.0660 0.002169
##
## Rho: 0.46489, LR test value: 14.121, p-value: 0.00017145
## Asymptotic standard error: 0.11549
## z-value: 4.0255, p-value: 5.6857e-05
## Wald statistic: 16.205, p-value: 5.6857e-05
##
## Log likelihood: -180.3169 for lag model
## ML residual variance (sigma squared): 88.291, (sigma: 9.3963)
## Number of observations: 49
## Number of parameters estimated: 5
## AIC: 370.63, (AIC for lm: 382.75)
## LM test for residual autocorrelation
## test value: 3.1695, p-value: 0.075025
Dampak (direct/indirect/total). Pada SAR, koefisien
\(\beta\) bukan efek
marjinal jangka panjang. Gunakan impacts().
imp_grid <- impacts(sar_grid, listw = lw, R = 500)
imp_col <- impacts(sar_col, listw = lw_c, R = 500)
summary(imp_grid, zstats = TRUE)
## Impact measures (lag, exact):
## Direct Indirect Total
## x1 0.9843937 0.6763428 1.660737
## x2 -0.8325739 -0.5720327 -1.404607
## ========================================================
## Simulation results ( variance matrix):
## Direct:
##
## Iterations = 1:500
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 500
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## x1 0.9874 0.07134 0.003190 0.003190
## x2 -0.8331 0.06504 0.002909 0.002342
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## x1 0.8558 0.9385 0.9847 1.0353 1.1361
## x2 -0.9566 -0.8779 -0.8329 -0.7877 -0.7047
##
## ========================================================
## Indirect:
##
## Iterations = 1:500
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 500
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## x1 0.6996 0.2193 0.009805 0.009805
## x2 -0.5891 0.1835 0.008207 0.008207
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## x1 0.3184 0.5526 0.6672 0.8417 1.1531
## x2 -1.0069 -0.7037 -0.5585 -0.4692 -0.2685
##
## ========================================================
## Total:
##
## Iterations = 1:500
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 500
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## x1 1.687 0.2577 0.011526 0.011526
## x2 -1.422 0.2152 0.009623 0.009623
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## x1 1.215 1.522 1.663 1.857 2.223
## x2 -1.907 -1.551 -1.388 -1.283 -1.052
##
## ========================================================
## Simulated standard errors
## Direct Indirect Total
## x1 0.07133920 0.2192545 0.2577311
## x2 0.06504308 0.1835187 0.2151677
##
## Simulated z-values:
## Direct Indirect Total
## x1 13.84085 3.190707 6.545473
## x2 -12.80801 -3.209856 -6.609454
##
## Simulated p-values:
## Direct Indirect Total
## x1 < 2.22e-16 0.0014192 5.9307e-11
## x2 < 2.22e-16 0.0013280 3.8574e-11
summary(imp_col, zstats = TRUE)
## Impact measures (lag, exact):
## Direct Indirect Total
## INC -0.9542578 -0.7478805 -1.7021382
## HOVAL -0.2725909 -0.2136376 -0.4862285
## ========================================================
## Simulation results ( variance matrix):
## Direct:
##
## Iterations = 1:500
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 500
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## INC -0.9554 0.31176 0.013942 0.013942
## HOVAL -0.2747 0.08672 0.003878 0.003878
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## INC -1.6300 -1.1643 -0.9529 -0.7563 -0.4013
## HOVAL -0.4524 -0.3315 -0.2730 -0.2188 -0.1144
##
## ========================================================
## Indirect:
##
## Iterations = 1:500
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 500
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## INC -0.7911 0.3795 0.016972 0.016972
## HOVAL -0.2408 0.1417 0.006338 0.006909
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## INC -1.6974 -0.9566 -0.7432 -0.5333 -0.27526
## HOVAL -0.6088 -0.3037 -0.2099 -0.1429 -0.05387
##
## ========================================================
## Total:
##
## Iterations = 1:500
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 500
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## INC -1.7465 0.5821 0.026031 0.026031
## HOVAL -0.5155 0.2061 0.009218 0.009893
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## INC -3.084 -2.0691 -1.7338 -1.3510 -0.7374
## HOVAL -1.000 -0.6293 -0.4869 -0.3706 -0.1900
##
## ========================================================
## Simulated standard errors
## Direct Indirect Total
## INC 0.3117554 0.3795156 0.5820792
## HOVAL 0.0867234 0.1417271 0.2061268
##
## Simulated z-values:
## Direct Indirect Total
## INC -3.064683 -2.084436 -3.000464
## HOVAL -3.167153 -1.699260 -2.500875
##
## Simulated p-values:
## Direct Indirect Total
## INC 0.0021790 0.037121 0.0026957
## HOVAL 0.0015394 0.089270 0.0123887
Ide dasar. Tidak ada lag pada \(y\), tapi error saling
berkorelasi: variabel penting terabaikan berpola spasial.
Kapan digunakan. Jika Moran’s I pada residual OLS
signifikan, dan teori tidak mendukung endogenous interaction
pada \(y\).
Rumus.
\[ \begin{aligned} y &= X\beta + u,\\ u &= \lambda Wu + \epsilon, \qquad \epsilon \sim \mathcal{N}(0, \sigma^2 I). \end{aligned} \] Dengan \(B(\lambda)=I-\lambda W\), log-likelihood: \[ \ell(\beta,\lambda,\sigma^2)=\log|B(\lambda)| - \tfrac{N}{2}\log\sigma^2 - \tfrac{1}{2\sigma^2}\,\|B(\lambda)(y - X\beta)\|^2. \]
R (grid & Columbus).
sem_grid <- errorsarlm(y ~ ., data = dat_grid, listw = lw, method = "eigen")
sem_col <- errorsarlm(CRIME ~ INC + HOVAL, data = d_col, listw = lw_c, method = "eigen")
summary(sem_grid)
##
## Call:errorsarlm(formula = y ~ ., data = dat_grid, listw = lw, method = "eigen")
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.736741 -0.650379 0.030066 0.702579 2.270119
##
## Type: error
## Coefficients: (asymptotic standard errors)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 3.359068 0.125819 26.698 < 2.2e-16
## x1 0.908493 0.067459 13.467 < 2.2e-16
## x2 -0.795855 0.063042 -12.624 < 2.2e-16
##
## Lambda: 0.48915, LR test value: 23.206, p-value: 1.4554e-06
## Asymptotic standard error: 0.088634
## z-value: 5.5187, p-value: 3.4148e-08
## Wald statistic: 30.456, p-value: 3.4148e-08
##
## Log likelihood: -315.6094 for error model
## ML residual variance (sigma squared): 0.92952, (sigma: 0.96412)
## Number of observations: 225
## Number of parameters estimated: 5
## AIC: 641.22, (AIC for lm: 662.42)
summary(sem_col)
##
## Call:errorsarlm(formula = CRIME ~ INC + HOVAL, data = d_col, listw = lw_c,
## method = "eigen")
##
## Residuals:
## Min 1Q Median 3Q Max
## -34.19485 -5.49306 -0.10805 5.81121 21.92606
##
## Type: error
## Coefficients: (asymptotic standard errors)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 55.830269 5.949030 9.3848 < 2.2e-16
## INC -1.014431 0.306651 -3.3081 0.0009393
## HOVAL -0.246757 0.081733 -3.0191 0.0025356
##
## Lambda: 0.6788, LR test value: 15.814, p-value: 6.9889e-05
## Asymptotic standard error: 0.11407
## z-value: 5.9509, p-value: 2.6672e-09
## Wald statistic: 35.413, p-value: 2.6672e-09
##
## Log likelihood: -179.4703 for error model
## ML residual variance (sigma squared): 80.04, (sigma: 8.9465)
## Number of observations: 49
## Number of parameters estimated: 5
## AIC: 368.94, (AIC for lm: 382.75)
Ide dasar. SAR + SLX: respon dipengaruhi \(Wy\) dan juga \(WX\).
Kapan digunakan. Ada interaksi endogen pada \(y\) dan spillover dari
kovariat; model kaya untuk menilai kebijakan yang menular antar
wilayah.
Rumus. \[
y = \rho Wy + X\beta + WX\theta + \epsilon.
\]
R (grid & Columbus) + impacts.
sdm_grid <- lagsarlm(y ~ ., data = dat_grid, listw = lw, Durbin = TRUE, method = "eigen")
sdm_col <- lagsarlm(CRIME ~ INC + HOVAL, data = d_col, listw = lw_c, Durbin = TRUE, method = "eigen")
summary(sdm_grid)
##
## Call:lagsarlm(formula = y ~ ., data = dat_grid, listw = lw, Durbin = TRUE,
## method = "eigen")
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.7233396 -0.6444892 0.0073549 0.6571302 2.3417941
##
## Type: mixed
## Coefficients: (asymptotic standard errors)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.841731 0.313645 5.8720 4.305e-09
## x1 0.942181 0.067925 13.8709 < 2.2e-16
## x2 -0.807055 0.063488 -12.7120 < 2.2e-16
## lag.x1 0.104119 0.217525 0.4787 0.63218
## lag.x2 0.313018 0.186639 1.6771 0.09352
##
## Rho: 0.45084, LR test value: 19.891, p-value: 8.1986e-06
## Asymptotic standard error: 0.091615
## z-value: 4.921, p-value: 8.6086e-07
## Wald statistic: 24.217, p-value: 8.6086e-07
##
## Log likelihood: -311.8131 for mixed model
## ML residual variance (sigma squared): 0.90482, (sigma: 0.95122)
## Number of observations: 225
## Number of parameters estimated: 7
## AIC: 637.63, (AIC for lm: 655.52)
## LM test for residual autocorrelation
## test value: 0.14516, p-value: 0.70321
summary(sdm_col)
##
## Call:lagsarlm(formula = CRIME ~ INC + HOVAL, data = d_col, listw = lw_c,
## Durbin = TRUE, method = "eigen")
##
## Residuals:
## Min 1Q Median 3Q Max
## -33.20282 -6.19526 -0.28693 4.85019 22.19628
##
## Type: mixed
## Coefficients: (asymptotic standard errors)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 23.0866190 9.0368595 2.5547 0.0106274
## INC -1.0149657 0.3065914 -3.3105 0.0009314
## HOVAL -0.2542240 0.0820306 -3.0991 0.0019409
## lag.INC 0.8360698 0.5429754 1.5398 0.1236108
## lag.HOVAL 0.0051799 0.2116339 0.0245 0.9804731
##
## Rho: 0.6519, LR test value: 12.594, p-value: 0.00038703
## Asymptotic standard error: 0.12077
## z-value: 5.3979, p-value: 6.7437e-08
## Wald statistic: 29.137, p-value: 6.7437e-08
##
## Log likelihood: -179.0855 for mixed model
## ML residual variance (sigma squared): 79.639, (sigma: 8.9241)
## Number of observations: 49
## Number of parameters estimated: 7
## AIC: 372.17, (AIC for lm: 382.76)
## LM test for residual autocorrelation
## test value: 4.0639, p-value: 0.04381
summary(impacts(sdm_grid, listw = lw, R = 500), zstats = TRUE)
## Impact measures (mixed, exact):
## Direct Indirect Total
## x1 0.9864373 0.91884630 1.9052836
## x2 -0.8113090 -0.08831963 -0.8996287
## ========================================================
## Simulation results ( variance matrix):
## Direct:
##
## Iterations = 1:500
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 500
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## x1 0.9869 0.07527 0.003366 0.003366
## x2 -0.8167 0.06938 0.003103 0.003103
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## x1 0.8538 0.9349 0.9853 1.0358 1.1363
## x2 -0.9505 -0.8625 -0.8190 -0.7696 -0.6794
##
## ========================================================
## Indirect:
##
## Iterations = 1:500
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 500
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## x1 0.93844 0.3603 0.01611 0.01611
## x2 -0.08369 0.3017 0.01349 0.01370
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## x1 0.2867 0.6897 0.9105 1.1758 1.6537
## x2 -0.6199 -0.2913 -0.0753 0.1293 0.4956
##
## ========================================================
## Total:
##
## Iterations = 1:500
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 500
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## x1 1.9253 0.3958 0.01770 0.0177
## x2 -0.9004 0.3302 0.01477 0.0146
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## x1 1.220 1.651 1.9088 2.1844 2.6696
## x2 -1.523 -1.116 -0.9059 -0.6726 -0.2693
##
## ========================================================
## Simulated standard errors
## Direct Indirect Total
## x1 0.07527155 0.3602884 0.3958025
## x2 0.06938481 0.3016917 0.3302043
##
## Simulated z-values:
## Direct Indirect Total
## x1 13.11127 2.604704 4.864421
## x2 -11.77091 -0.277413 -2.726844
##
## Simulated p-values:
## Direct Indirect Total
## x1 < 2.22e-16 0.0091954 1.1479e-06
## x2 < 2.22e-16 0.7814630 0.0063943
summary(impacts(sdm_col, listw = lw_c, R = 500), zstats = TRUE)
## Impact measures (mixed, exact):
## Direct Indirect Total
## INC -0.9819288 0.4680021 -0.5139266
## HOVAL -0.2846355 -0.4308104 -0.7154459
## ========================================================
## Simulation results ( variance matrix):
## Direct:
##
## Iterations = 1:498
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 498
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## INC -0.9764 0.33158 0.01486 0.01392
## HOVAL -0.2928 0.09729 0.00436 0.00436
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## INC -1.6035 -1.2049 -0.9875 -0.7494 -0.3363
## HOVAL -0.4857 -0.3604 -0.2915 -0.2305 -0.1097
##
## ========================================================
## Indirect:
##
## Iterations = 1:498
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 498
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## INC 0.6503 2.0586 0.09225 0.09225
## HOVAL -0.5220 0.8763 0.03927 0.03927
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## INC -2.771 -0.3451 0.6053 1.44029 4.9712
## HOVAL -2.386 -0.8556 -0.4433 -0.06552 0.8535
##
## ========================================================
## Total:
##
## Iterations = 1:498
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 498
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## INC -0.3261 2.208 0.09895 0.09895
## HOVAL -0.8148 0.934 0.04185 0.04185
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## INC -3.963 -1.404 -0.3819 0.5853 4.3460
## HOVAL -2.801 -1.186 -0.7325 -0.3275 0.7446
##
## ========================================================
## Simulated standard errors
## Direct Indirect Total
## INC 0.33158007 2.0585525 2.2082167
## HOVAL 0.09729073 0.8762607 0.9340098
##
## Simulated z-values:
## Direct Indirect Total
## INC -2.944688 0.3159212 -0.1476574
## HOVAL -3.009349 -0.5956923 -0.8723286
##
## Simulated p-values:
## Direct Indirect Total
## INC 0.0032328 0.75206 0.88261
## HOVAL 0.0026181 0.55138 0.38303
Ide dasar. Tidak ada lag \(y\), tetapi ada WX dan
error SEM.
Kapan digunakan. Respon tidak saling menular, namun
kovariat tetangga dan faktor tak terukur (berpola spasial) memengaruhi
respon.
Rumus. \[
\begin{aligned}
y &= X\beta + WX\theta + u,\\
u &= \lambda Wu + \epsilon.
\end{aligned}
\]
R (grid & Columbus).
sdem_grid <- errorsarlm(y ~ ., data = dat_grid, listw = lw, Durbin = TRUE, method = "eigen")
sdem_col <- errorsarlm(CRIME ~ INC + HOVAL, data = d_col, listw = lw_c, Durbin = TRUE, method = "eigen")
summary(sdem_grid)
##
## Call:errorsarlm(formula = y ~ ., data = dat_grid, listw = lw, Durbin = TRUE,
## method = "eigen")
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.75174930 -0.63204781 -0.00014401 0.69128917 2.40517545
##
## Type: error
## Coefficients: (asymptotic standard errors)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 3.353648 0.115372 29.0682 < 2.2e-16
## x1 0.973797 0.070290 13.8539 < 2.2e-16
## x2 -0.809610 0.066648 -12.1475 < 2.2e-16
## lag.x1 0.608037 0.222470 2.7331 0.006274
## lag.x2 -0.058292 0.205883 -0.2831 0.777075
##
## Lambda: 0.44962, LR test value: 19.553, p-value: 9.7822e-06
## Asymptotic standard error: 0.09252
## z-value: 4.8596, p-value: 1.176e-06
## Wald statistic: 23.616, p-value: 1.176e-06
##
## Log likelihood: -311.9819 for error model
## ML residual variance (sigma squared): 0.90636, (sigma: 0.95203)
## Number of observations: 225
## Number of parameters estimated: 7
## AIC: 637.96, (AIC for lm: 655.52)
summary(sdem_col)
##
## Call:errorsarlm(formula = CRIME ~ INC + HOVAL, data = d_col, listw = lw_c,
## Durbin = TRUE, method = "eigen")
##
## Residuals:
## Min 1Q Median 3Q Max
## -31.15319 -5.83223 -0.95878 5.18274 22.76056
##
## Type: error
## Coefficients: (asymptotic standard errors)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 53.422602 12.940877 4.1282 3.656e-05
## INC -0.934886 0.308678 -3.0287 0.002456
## HOVAL -0.275318 0.085404 -3.2237 0.001265
## lag.INC 0.821946 0.797123 1.0311 0.302475
## lag.HOVAL -0.277941 0.280238 -0.9918 0.321294
##
## Lambda: 0.72231, LR test value: 12.918, p-value: 0.00032549
## Asymptotic standard error: 0.10205
## z-value: 7.0783, p-value: 1.4597e-12
## Wald statistic: 50.102, p-value: 1.4596e-12
##
## Log likelihood: -178.9235 for error model
## ML residual variance (sigma squared): 76.757, (sigma: 8.7611)
## Number of observations: 49
## Number of parameters estimated: 7
## AIC: 371.85, (AIC for lm: 382.76)
Ide dasar. Gabungan SAR + SEM: ada
Wy dan error SEM.
Kapan digunakan. Ada interaksi endogen dan juga omitted
variables berpola spasial.
Rumus. \[
\begin{aligned}
y &= \rho Wy + X\beta + u,\\
u &= \lambda Wu + \epsilon.
\end{aligned}
\]
R (grid & Columbus).
sac_grid <- sacsarlm(y ~ ., data = dat_grid, listw = lw, method = "eigen")
sac_col <- sacsarlm(CRIME ~ INC + HOVAL, data = d_col, listw = lw_c, method = "eigen")
summary(sac_grid)
##
## Call:sacsarlm(formula = y ~ ., data = dat_grid, listw = lw, method = "eigen")
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.79687 -0.61385 0.03868 0.68742 2.39961
##
## Type: sac
## Coefficients: (asymptotic standard errors)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.216086 0.464593 4.770 1.843e-06
## x1 0.947340 0.068164 13.898 < 2.2e-16
## x2 -0.814330 0.064009 -12.722 < 2.2e-16
##
## Rho: 0.34052
## Asymptotic standard error: 0.13667
## z-value: 2.4915, p-value: 0.012719
## Lambda: 0.17137
## Asymptotic standard error: 0.19116
## z-value: 0.89643, p-value: 0.37002
##
## LR test value: 28.029, p-value: 8.196e-07
##
## Log likelihood: -313.1979 for sac model
## ML residual variance (sigma squared): 0.92629, (sigma: 0.96244)
## Number of observations: 225
## Number of parameters estimated: 6
## AIC: 638.4, (AIC for lm: 662.42)
summary(sac_col)
##
## Call:sacsarlm(formula = CRIME ~ INC + HOVAL, data = d_col, listw = lw_c,
## method = "eigen")
##
## Residuals:
## Min 1Q Median 3Q Max
## -34.51350 -5.53228 -0.27094 5.52658 22.13005
##
## Type: sac
## Coefficients: (asymptotic standard errors)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 48.866523 9.908562 4.9317 8.15e-07
## INC -1.032095 0.307752 -3.3537 0.0007975
## HOVAL -0.254910 0.083354 -3.0582 0.0022270
##
## Rho: 0.26441
## Asymptotic standard error: 0.23835
## z-value: 1.1093, p-value: 0.26729
## Lambda: 0.47403
## Asymptotic standard error: 0.25075
## z-value: 1.8904, p-value: 0.058701
##
## LR test value: 16.879, p-value: 0.0002161
##
## Log likelihood: -178.9375 for sac model
## ML residual variance (sigma squared): 82.309, (sigma: 9.0724)
## Number of observations: 49
## Number of parameters estimated: 6
## AIC: 369.87, (AIC for lm: 382.75)
Ide dasar. Model paling umum: gabungkan SAR + SLX +
SEM (sering disebut SAC + Durbin).
Kapan digunakan. Saat ingin kerangka paling kaya,
kemudian lakukan reduksi berdasarkan signifikansi parameter/teori.
Rumus. \[
\begin{aligned}
y &= \rho Wy + X\beta + WX\theta + u,\\
u &= \lambda Wu + \epsilon.
\end{aligned}
\]
R (grid & Columbus).
gns_grid <- sacsarlm(y ~ ., data = dat_grid, listw = lw, Durbin = TRUE, method = "eigen")
gns_col <- sacsarlm(CRIME ~ INC + HOVAL, data = d_col, listw = lw_c, Durbin = TRUE, method = "eigen")
summary(gns_grid)
##
## Call:sacsarlm(formula = y ~ ., data = dat_grid, listw = lw, Durbin = TRUE,
## method = "eigen")
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.7527333 -0.6451218 0.0066546 0.6795943 2.3712426
##
## Type: sacmixed
## Coefficients: (asymptotic standard errors)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.217002 2.193647 1.0106 0.3122
## x1 0.950920 0.084273 11.2838 <2e-16
## x2 -0.807459 0.064255 -12.5665 <2e-16
## lag.x1 0.235516 0.798014 0.2951 0.7679
## lag.x2 0.218957 0.550015 0.3981 0.6906
##
## Rho: 0.33888
## Asymptotic standard error: 0.65396
## z-value: 0.51819, p-value: 0.60433
## Lambda: 0.14675
## Asymptotic standard error: 0.74906
## z-value: 0.19591, p-value: 0.84468
##
## LR test value: 30.899, p-value: 3.2095e-06
##
## Log likelihood: -311.7627 for sacmixed model
## ML residual variance (sigma squared): 0.91581, (sigma: 0.95698)
## Number of observations: 225
## Number of parameters estimated: 8
## AIC: 639.53, (AIC for lm: 662.42)
summary(gns_col)
##
## Call:sacsarlm(formula = CRIME ~ INC + HOVAL, data = d_col, listw = lw_c,
## Durbin = TRUE, method = "eigen")
##
## Residuals:
## Min 1Q Median 3Q Max
## -32.19511 -5.64820 -0.33221 4.85169 22.57305
##
## Type: sacmixed
## Coefficients: (asymptotic standard errors)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 36.490647 118.632989 0.3076 0.7583922
## INC -1.017589 0.305562 -3.3302 0.0008678
## HOVAL -0.260051 0.099702 -2.6083 0.0090996
## lag.INC 0.817395 1.880142 0.4348 0.6637427
## lag.HOVAL -0.113744 0.735706 -0.1546 0.8771325
##
## Rho: 0.39954
## Asymptotic standard error: 2.0013
## z-value: 0.19964, p-value: 0.84176
## Lambda: 0.45966
## Asymptotic standard error: 1.8707
## z-value: 0.24572, p-value: 0.8059
##
## LR test value: 17.985, p-value: 0.0012423
##
## Log likelihood: -178.3846 for sacmixed model
## ML residual variance (sigma squared): 79.321, (sigma: 8.9062)
## Number of observations: 49
## Number of parameters estimated: 8
## AIC: 372.77, (AIC for lm: 382.75)
summary(impacts(gns_grid, listw = lw, R = 300), zstats = TRUE)
## Impact measures (sacmixed, exact):
## Direct Indirect Total
## x1 0.9829227 0.81165277 1.7945755
## x2 -0.8105957 -0.07955803 -0.8901537
## ========================================================
## Simulation results ( variance matrix):
## Direct:
##
## Iterations = 1:253
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 253
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## x1 0.9945 0.09743 0.006126 0.004856
## x2 -0.8117 0.07456 0.004688 0.004688
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## x1 0.8481 0.9335 0.9857 1.0409 1.2098
## x2 -0.9668 -0.8504 -0.8153 -0.7585 -0.6874
##
## ========================================================
## Indirect:
##
## Iterations = 1:253
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 253
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## x1 1.3689 2.667 0.1677 0.1677
## x2 -0.2642 1.986 0.1249 0.1249
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## x1 0.2631 0.5489 0.73410 1.1124 9.3632
## x2 -2.4803 -0.2770 -0.05042 0.1076 0.5526
##
## ========================================================
## Total:
##
## Iterations = 1:253
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 253
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## x1 2.363 2.721 0.1710 0.1710
## x2 -1.076 2.015 0.1267 0.1267
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## x1 1.159 1.514 1.7255 2.1040 10.5083
## x2 -3.426 -1.090 -0.8699 -0.7092 -0.1838
##
## ========================================================
## Simulated standard errors
## Direct Indirect Total
## x1 0.09743357 2.666743 2.720518
## x2 0.07456303 1.986151 2.015460
##
## Simulated z-values:
## Direct Indirect Total
## x1 10.20695 0.5133141 0.8687228
## x2 -10.88563 -0.1330090 -0.5337944
##
## Simulated p-values:
## Direct Indirect Total
## x1 < 2.22e-16 0.60773 0.38500
## x2 < 2.22e-16 0.89419 0.59348
summary(impacts(gns_col, listw = lw_c, R = 300), zstats = TRUE)
## Impact measures (sacmixed, exact):
## Direct Indirect Total
## INC -0.9838744 0.6504729 -0.3334015
## HOVAL -0.2779118 -0.3446018 -0.6225136
## ========================================================
## Simulation results ( variance matrix):
## Direct:
##
## Iterations = 1:170
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 170
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## INC -1.0332 0.5625 0.04314 0.04314
## HOVAL -0.2753 0.1595 0.01223 0.01223
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## INC -1.9037 -1.2999 -1.0117 -0.7742 -0.18730
## HOVAL -0.5208 -0.3433 -0.2869 -0.2088 -0.02505
##
## ========================================================
## Indirect:
##
## Iterations = 1:170
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 170
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## INC 1.0998 10.39 0.7971 0.7971
## HOVAL -0.2927 3.25 0.2493 0.2493
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## INC -1.836 0.02435 0.4946 1.05626 8.6218
## HOVAL -3.107 -0.44547 -0.2301 -0.07977 0.8262
##
## ========================================================
## Total:
##
## Iterations = 1:170
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 170
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## INC 0.06665 10.81 0.8287 0.8287
## HOVAL -0.56801 3.37 0.2584 0.2584
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## INC -3.225 -0.9671 -0.6535 0.04396 7.8674
## HOVAL -3.455 -0.7109 -0.4742 -0.37465 0.6704
##
## ========================================================
## Simulated standard errors
## Direct Indirect Total
## INC 0.5625249 10.393146 10.805067
## HOVAL 0.1595073 3.250207 3.369674
##
## Simulated z-values:
## Direct Indirect Total
## INC -1.836649 0.10582045 0.006168089
## HOVAL -1.725789 -0.09006702 -0.168565956
##
## Simulated p-values:
## Direct Indirect Total
## INC 0.066262 0.91572 0.99508
## HOVAL 0.084385 0.92823 0.86614
Langkah praktis:
# Grid (simulasi)
ols_grid <- lm(y ~ ., data = dat_grid)
moran_grid <- lm.morantest(ols_grid, listw = lw)
lmtests_grid <- lm.LMtests(ols_grid, listw = lw, test = c("LMlag","LMerr","RLMlag","RLMerr"))
moran_grid; lmtests_grid
##
## Global Moran I for regression residuals
##
## data:
## model: lm(formula = y ~ ., data = dat_grid)
## weights: lw
##
## Moran I statistic standard deviate = 5.5575, p-value = 1.368e-08
## alternative hypothesis: greater
## sample estimates:
## Observed Moran I Expectation Variance
## 0.190959210 -0.004498787 0.001236931
##
## Rao's score (a.k.a Lagrange multiplier) diagnostics for spatial
## dependence
##
## data:
## model: lm(formula = y ~ ., data = dat_grid)
## test weights: listw
##
## RSlag = 33.202, df = 1, p-value = 8.308e-09
##
##
## Rao's score (a.k.a Lagrange multiplier) diagnostics for spatial
## dependence
##
## data:
## model: lm(formula = y ~ ., data = dat_grid)
## test weights: listw
##
## RSerr = 28.591, df = 1, p-value = 8.94e-08
##
##
## Rao's score (a.k.a Lagrange multiplier) diagnostics for spatial
## dependence
##
## data:
## model: lm(formula = y ~ ., data = dat_grid)
## test weights: listw
##
## adjRSlag = 6.3766, df = 1, p-value = 0.01156
##
##
## Rao's score (a.k.a Lagrange multiplier) diagnostics for spatial
## dependence
##
## data:
## model: lm(formula = y ~ ., data = dat_grid)
## test weights: listw
##
## adjRSerr = 1.7658, df = 1, p-value = 0.1839
# Columbus (nyata)
ols_col <- lm(CRIME ~ INC + HOVAL, data = d_col)
moran_col <- lm.morantest(ols_col, listw = lw_c)
lmtests_col <- lm.LMtests(ols_col, listw = lw_c, test = c("LMlag","LMerr","RLMlag","RLMerr"))
moran_col; lmtests_col
##
## Global Moran I for regression residuals
##
## data:
## model: lm(formula = CRIME ~ INC + HOVAL, data = d_col)
## weights: lw_c
##
## Moran I statistic standard deviate = 4.7784, p-value = 8.836e-07
## alternative hypothesis: greater
## sample estimates:
## Observed Moran I Expectation Variance
## 0.330982441 -0.033095098 0.005805358
##
## Rao's score (a.k.a Lagrange multiplier) diagnostics for spatial
## dependence
##
## data:
## model: lm(formula = CRIME ~ INC + HOVAL, data = d_col)
## test weights: listw
##
## RSlag = 15.933, df = 1, p-value = 6.561e-05
##
##
## Rao's score (a.k.a Lagrange multiplier) diagnostics for spatial
## dependence
##
## data:
## model: lm(formula = CRIME ~ INC + HOVAL, data = d_col)
## test weights: listw
##
## RSerr = 15.186, df = 1, p-value = 9.74e-05
##
##
## Rao's score (a.k.a Lagrange multiplier) diagnostics for spatial
## dependence
##
## data:
## model: lm(formula = CRIME ~ INC + HOVAL, data = d_col)
## test weights: listw
##
## adjRSlag = 3.8044, df = 1, p-value = 0.05112
##
##
## Rao's score (a.k.a Lagrange multiplier) diagnostics for spatial
## dependence
##
## data:
## model: lm(formula = CRIME ~ INC + HOVAL, data = d_col)
## test weights: listw
##
## adjRSerr = 3.0573, df = 1, p-value = 0.08037
Checklist ringkas pemilihan model.
impacts() untuk
lag-\(y\); jangan mengartikan koefisien
\(\beta\) langsung sebagai efek
marjinal jangka panjang.Geographically Weighted Regression (GWR) adalah metode regresi yang memperhitungkan variasi spasial dalam data. GWR memungkinkan parameter model regresi berubah di setiap lokasi, memberikan fleksibilitas untuk menangkap pola lokal daripada satu model global yang seragam.
Kapan Menggunakan GWR?
GWR cocok digunakan ketika terdapat indikasi bahwa hubungan antara variabel dependen dan independen berubah-ubah berdasarkan lokasi geografis. GWR sering digunakan dalam penelitian yang melibatkan data spasial seperti ekologi, geografi, epidemiologi, dan ekonomi regional.
Model GWR dituliskan sebagai:
\[ y_i = \beta_0(u_i, v_i) + \sum_{k=1}^{p} \beta_k(u_i, v_i) x_{ik} + \varepsilon_i \]
Di mana:
\(y_i\) adalah nilai variabel dependen di lokasi \(i\).
\(\beta_k(u_i, v_i)\) adalah parameter regresi untuk variabel \(k\) pada lokasi geografis \((u_i, v_i)\).
\(x_{ik}\) adalah variabel independen ke-\(k\) pada lokasi \(i\).
\(\varepsilon_i\) adalah error residual pada lokasi \(i\).
Setiap lokasi \((u_i, v_i)\) memiliki nilai \(\beta_k\) yang berbeda, membuat GWR model lokal di setiap titik.
Bandwidth dalam GWR menentukan seberapa banyak pengaruh lokasi tetangga di sekitar titik yang diamati. Pilihan bandwidth sangat mempengaruhi hasil estimasi parameter. Terdapat dua jenis bandwidth yang umum digunakan:
Fixed Bandwidth: Semua titik observasi menggunakan ukuran bandwidth yang sama, baik untuk lokasi yang padat maupun jarang.
Adaptive Bandwidth: Bandwidth disesuaikan dengan kepadatan titik observasi, sehingga di wilayah dengan observasi lebih sedikit, bandwidth diperluas untuk memasukkan lebih banyak tetangga.
Pemilihan bandwidth yang optimal dilakukan dengan metode berikut:
Cross-Validation (CV): Bandwidth dipilih yang meminimalkan nilai fungsi loss pada data yang tidak dilatih.
Akaike Information Criterion (AICc): Bandwidth dipilih berdasarkan nilai AIC yang disesuaikan, dengan memilih bandwidth yang meminimalkan AIC.
Untuk mengestimasi parameter dalam model GWR, digunakan metode weighted least squares (WLS). Setiap titik observasi memiliki bobot yang berbeda berdasarkan jaraknya dari titik target. Secara matematis, estimasi \(\beta_k(u_i, v_i)\) diestimasi dengan:
\[ \hat{\beta}(u_i, v_i) = (X^T W_i X)^{-1} X^T W_i y \]
Di mana:
\(W_i\) adalah matriks bobot untuk lokasi ke-\(i\), dan elemen dari matriks ini ditentukan oleh fungsi kernel yang bergantung pada jarak antara titik \(i\) dan titik lainnya.
\(X\) adalah matriks desain (covariates), dan \(y\) adalah vektor variabel dependen.
Bobot dihitung menggunakan fungsi kernel yang mendekati nol ketika jarak semakin besar. Beberapa jenis kernel yang umum digunakan:
\[ w_{ij} = \exp \left( - \frac{d_{ij}^2}{2h^2} \right) \]
\[ w_{ij} = \left( 1 - \left( \frac{d_{ij}}{h} \right)^2 \right)^2 \text{ jika } d_{ij} < h, \text{ sebaliknya } w_{ij} = 0 \]
Untuk menguji apakah GWR lebih baik daripada model regresi global, dapat digunakan test statistik F. Pengujian ini membandingkan varians dari model global dengan varians yang dihasilkan oleh GWR.
Di setiap lokasi, koefisien \(\beta_k(u_i, v_i)\) dapat diuji secara lokal. t-statistik dapat dihitung untuk setiap koefisien pada setiap lokasi, guna melihat apakah parameter tersebut signifikan secara statistik pada level tertentu.
Sama seperti regresi linear biasa, GWR memiliki asumsi-asumsi yang harus diuji. Namun, beberapa asumsi ini memiliki nuansa berbeda karena adanya faktor spasial.
Normalitas residual dapat diuji dengan metode Shapiro-Wilk Test. Hipotesis nol dari uji ini adalah bahwa residual berdistribusi normal.
Rumus uji Shapiro-Wilk:
\[ W = \frac{\left( \sum_{i=1}^{n} a_i r_{(i)} \right)^2}{\sum_{i=1}^{n} (y_i - \bar{y})^2} \]
Di mana:
\(r_{(i)}\) adalah residual yang diurutkan.
\(a_i\) adalah koefisien yang diperoleh dari matriks kovarian teoretis distribusi normal.
\(\bar{y}\) adalah rata-rata variabel respon.
Jika nilai \(p\) kecil (misalnya, kurang dari 0.05), maka dapat disimpulkan bahwa residual tidak berdistribusi normal.
Untuk memeriksa homoskedastisitas (atau varians yang tetap), Breusch-Pagan Test dapat digunakan. Uji ini memeriksa apakah error residual bervariasi secara sistematis terhadap variabel prediktor.
Rumus uji Breusch-Pagan:
\[ BP = \frac{n}{2} R^2 \]
Di mana:
\(R^2\) adalah koefisien determinasi dari model regresi tambahan yang mengkuadratkan residual sebagai variabel dependen.
\(n\) adalah jumlah observasi.
Hipotesis nol menyatakan bahwa varians residual konstan (homoskedastisitas). Jika nilai \(p\) kecil, ada indikasi heteroskedastisitas.
Uji autokorelasi spasial, seperti Moran’s I, digunakan untuk memeriksa apakah residual memiliki pola spasial yang signifikan.
Rumus Moran’s I:
\[ I = \frac{n}{W} \frac{\sum_{i=1}^{n} \sum_{j=1}^{n} w_{ij} (y_i - \bar{y})(y_j - \bar{y})}{\sum_{i=1}^{n} (y_i - \bar{y})^2} \]
Di mana:
\(n\) adalah jumlah observasi.
\(w_{ij}\) adalah elemen dari matriks bobot spasial.
\(\bar{y}\) adalah rata-rata nilai residual.
Nilai \(I\) yang mendekati +1 menunjukkan autokorelasi positif, sementara nilai mendekati -1 menunjukkan autokorelasi negatif. Jika \(I\) signifikan, berarti ada pola spasial dalam residual.
Untuk mendeteksi multikolinearitas antara variabel independen, dapat digunakan Variance Inflation Factor (VIF).
Rumus VIF:
\[ VIF_k = \frac{1}{1 - R_k^2} \]
Di mana:
Jika VIF lebih dari 10, hal ini menunjukkan adanya multikolinearitas yang serius, sehingga model perlu dikoreksi.
GWR adalah alat yang kuat untuk analisis data spasial karena mampu menangkap variasi lokal dalam hubungan antara variabel. Dengan pemilihan bandwidth yang tepat, estimasi yang akurat, dan pengujian asumsi yang lengkap, GWR dapat memberikan wawasan yang lebih dalam tentang bagaimana hubungan antara variabel berubah di ruang geografis.
data_spasial <- data.frame(
y = runif(100),
x1 = runif(100),
x2 = runif(100),
longitude = runif(100, min = -100, max = -90),
latitude = runif(100, min = 30, max = 40)
)
coordinates(data_spasial) <- ~longitude+latitude
bandwidth_optimal <- gwr.sel(
y ~ x1 + x2,
data = data_spasial,
coords = cbind(data_spasial$longitude, data_spasial$latitude),
adapt = TRUE
)
## Adaptive q: 0.381966 CV score: 8.118229
## Adaptive q: 0.618034 CV score: 8.128019
## Adaptive q: 0.236068 CV score: 8.143954
## Adaptive q: 0.4636324 CV score: 8.1206
## Adaptive q: 0.3262379 CV score: 8.126476
## Adaptive q: 0.4115305 CV score: 8.117914
## Adaptive q: 0.4037411 CV score: 8.117152
## Adaptive q: 0.3978179 CV score: 8.116531
## Adaptive q: 0.391763 CV score: 8.117982
## Adaptive q: 0.3955052 CV score: 8.117039
## Adaptive q: 0.3994483 CV score: 8.116204
## Adaptive q: 0.401088 CV score: 8.116415
## Adaptive q: 0.3996285 CV score: 8.116169
## Adaptive q: 0.3999755 CV score: 8.116103
## Adaptive q: 0.4004004 CV score: 8.116216
## Adaptive q: 0.4001378 CV score: 8.116139
## Adaptive q: 0.3999196 CV score: 8.116114
## Adaptive q: 0.4000162 CV score: 8.116103
## Adaptive q: 0.3999755 CV score: 8.116103
model_gwr <- gwr(
y ~ x1 + x2,
data = data_spasial,
coords = cbind(data_spasial$longitude, data_spasial$latitude),
adapt = bandwidth_optimal,
hatmatrix = TRUE,
se.fit = TRUE
)
coef_gwr <- model_gwr$SDF@data[, c("x1", "x2")]
# Menampilkan ringkasan model
summary(model_gwr)
## Length Class Mode
## SDF 100 SpatialPointsDataFrame S4
## lhat 10000 -none- numeric
## lm 11 -none- list
## results 14 -none- list
## bandwidth 100 -none- numeric
## adapt 1 -none- numeric
## hatmatrix 1 -none- logical
## gweight 1 -none- character
## gTSS 1 -none- numeric
## this.call 7 -none- call
## fp.given 1 -none- logical
## timings 12 -none- numeric
proj_longlat <- CRS("+proj=longlat +datum=WGS84")
proj_utm <- CRS("+proj=utm +zone=33 +datum=WGS84")
proj4string(data_spasial) <- CRS("+proj=longlat +datum=WGS84")
data_spasial_utm <- spTransform(data_spasial, proj_utm)
bandwidth_optimal <- gwr.sel(y ~ x1 + x2, data = data_spasial_utm, adapt = TRUE)
## Adaptive q: 0.381966 CV score: 8.131951
## Adaptive q: 0.618034 CV score: 8.129777
## Adaptive q: 0.763932 CV score: 8.124636
## Adaptive q: 0.854102 CV score: 8.112163
## Adaptive q: 0.9098301 CV score: 8.107845
## Adaptive q: 0.9748563 CV score: 8.101248
## Adaptive q: 0.9500185 CV score: 8.105789
## Adaptive q: 0.9844604 CV score: 8.100525
## Adaptive q: 0.9916947 CV score: 8.100276
## Adaptive q: 0.9951674 CV score: 8.100056
## Adaptive q: 0.9970133 CV score: 8.099937
## Adaptive q: 0.9981541 CV score: 8.099863
## Adaptive q: 0.9988592 CV score: 8.099817
## Adaptive q: 0.9992949 CV score: 8.099788
## Adaptive q: 0.9995642 CV score: 8.099771
## Adaptive q: 0.9997307 CV score: 8.09976
## Adaptive q: 0.9998336 CV score: 8.099753
## Adaptive q: 0.9998971 CV score: 8.099749
## Adaptive q: 0.9999378 CV score: 8.099746
## Adaptive q: 0.9999378 CV score: 8.099746
model_gwr <- gwr(y ~ x1 + x2, data = data_spasial_utm, adapt = bandwidth_optimal)
model_ols <- lm(y ~ x1 + x2, data = data_spasial)
summary(model_ols)
##
## Call:
## lm(formula = y ~ x1 + x2, data = data_spasial)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.50760 -0.24753 0.04085 0.22413 0.60271
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.39876 0.06920 5.762 9.8e-08 ***
## x1 -0.03077 0.08836 -0.348 0.7284
## x2 0.25947 0.09943 2.610 0.0105 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2799 on 97 degrees of freedom
## Multiple R-squared: 0.06595, Adjusted R-squared: 0.0467
## F-statistic: 3.425 on 2 and 97 DF, p-value: 0.03655
bptest(model_ols)
##
## studentized Breusch-Pagan test
##
## data: model_ols
## BP = 4.7724, df = 2, p-value = 0.09198
AIC(model_ols)
## [1] 34.10179
model_gwr$results$AICc
## NULL
vif(model_ols)
## x1 x2
## 1.00338 1.00338
residual_gwr <- model_gwr$SDF$gwr.e
coords <- cbind(data_spasial$longitude, data_spasial$latitude)
nb <- knn2nb(knearneigh(coords, k=4))
listw <- nb2listw(nb, style="W")
moran.test(residual_gwr, listw)
##
## Moran I test under randomisation
##
## data: residual_gwr
## weights: listw
##
## Moran I statistic standard deviate = -0.76665, p-value = 0.7784
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic Expectation Variance
## -0.058962898 -0.010101010 0.004062043
shapiro.test(residual_gwr)
##
## Shapiro-Wilk normality test
##
## data: residual_gwr
## W = 0.95395, p-value = 0.001524
coef_x1 <- model_gwr$SDF$x1
coef_x2 <- model_gwr$SDF$x2
spplot(model_gwr$SDF, "x1", main = "Koefisien GWR untuk x1", col.regions = terrain.colors(100))
spplot(model_gwr$SDF, "x2", main = "Koefisien GWR untuk x2", col.regions = terrain.colors(100))
gwr_df <- as.data.frame(model_gwr$SDF)
# Plot koefisien lokal untuk x1
ggplot(gwr_df, aes(x = coords.x1, y = coords.x2)) +
geom_point(aes(color = x1), size = 2) +
scale_color_viridis_c() +
labs(title = "Koefisien GWR untuk x1", color = "Koefisien") +
theme_minimal()
# Plot koefisien lokal untuk x2
ggplot(gwr_df, aes(x = coords.x1, y = coords.x2)) +
geom_point(aes(color = x2), size = 2) +
scale_color_viridis_c() +
labs(title = "Koefisien GWR untuk x2", color = "Koefisien") +
theme_minimal()
proj4string(data_spasial)
## [1] "+proj=longlat +datum=WGS84 +no_defs"
data_spasial_wgs84 <- spTransform(data_spasial, CRS("+proj=longlat +datum=WGS84 +no_defs"))
x.range <- range(data_spasial$longitude)
y.range <- range(data_spasial$latitude)
grd <- expand.grid(
longitude = seq(from = x.range[1], to = x.range[2], length.out = 100),
latitude = seq(from = y.range[1], to = y.range[2], length.out = 100)
)
coordinates(grd) <- ~longitude + latitude
proj4string(grd) <- CRS("+proj=longlat +datum=WGS84 +no_defs")
data_spasial$coef_x1 <- coef_x1
idw_output <- idw(coef_x1 ~ 1, data_spasial, newdata = grd, idp = 2.0) # idp = power parameter
## [inverse distance weighted interpolation]
idw_df <- as.data.frame(idw_output)
ggplot() +
geom_tile(data = idw_df, aes(x = longitude, y = latitude, fill = var1.pred)) +
scale_fill_viridis_c() +
labs(title = "Surface Plot of GWR Coefficients for x1 (IDW)",
fill = "Koefisien x1") +
theme_minimal()
Spatial interpolation adalah prosedur memperkirakan nilai variabel pada lokasi tidak teramati berdasarkan nilai di lokasi teramati di sekitarnya. Tujuannya membuat permukaan kontinu (surface) dari data titik, misalnya peta curah hujan, kualitas udara, kandungan logam tanah, atau ketinggian.
Intuisi: lokasi yang berdekatan cenderung memiliki nilai yang mirip (Tobler’s first law). Perbedaannya ada pada cara memberi bobot dan asumsi model yang digunakan untuk “menjahit” titik-titik menjadi peta kontinu.
Interpolasi spasial bukan sekadar masalah matematis — ia juga
memerlukan pemahaman mendalam tentang struktur spasial
data, asumsi model, dan implikasi
praktis dari setiap pendekatan.
Bagian ini menguraikan secara rinci asumsi-asumsi utama yang mendasari
sebagian besar metode interpolasi.
Autokorelasi spasial merupakan fondasi utama dari
semua metode interpolasi. Prinsip dasarnya dikenal sebagai Hukum
Pertama Geografi (Tobler, 1970):
> “Everything is related to everything else, but near things are more
related than distant things.”
Autokorelasi spasial menyatakan bahwa nilai suatu variabel di
lokasi tertentu cenderung mirip dengan nilai di lokasi lain yang
berdekatan secara geografis.
Jika \(Z(s)\) adalah nilai variabel di
lokasi \(s\), maka untuk dua lokasi
berdekatan \(s_i\) dan \(s_j\):
\[ \text{Cov}(Z(s_i), Z(s_j)) = C(h) \quad \text{dengan } h = \|s_i - s_j\| \]
Artinya, semakin kecil jarak \(h\), semakin besar korelasi antar nilai.
Metode geostatistik klasik, terutama Kriging, mengasumsikan bahwa data berasal dari proses spasial stasioner, yakni:
Namun dalam kenyataannya, banyak fenomena memiliki tren global (misal: ketinggian yang meningkat dari barat ke timur). Dalam kasus ini, asumsi stasioneritas ketat tidak terpenuhi.
Jika terdapat pola sistematik, misalnya perubahan rata-rata secara
spasial, pendekatan seperti Universal Kriging (UK) atau
Trend Surface Analysis lebih sesuai.
Keduanya mengizinkan mean yang bervariasi dengan lokasi:
\[ E[Z(s)] = \beta_0 + \beta_1 x + \beta_2 y + \varepsilon(s) \]
Di mana \(\varepsilon(s)\) tetap dianggap stasioner secara lokal.
Hubungan spasial bisa berbeda pada berbagai skala observasi. Misalnya, variabilitas suhu pada skala 1 km bisa berbeda drastis dengan skala 100 km. Oleh karena itu, pemilihan resolusi grid dan parameter variogram harus sesuai dengan skala analisis.
\[ C(h) = \sigma^2 \exp\left(-\frac{h}{a}\right) \]
Parameter \(a\) (range) mengatur seberapa jauh pengaruh spasial berlaku. Jika skala salah dipilih, interpolasi bisa terlalu halus atau terlalu kasar.
Anisotropi terjadi ketika korelasi spasial bergantung pada arah. Misalnya, penyebaran polutan bisa lebih cepat ke arah angin dibanding arah tegak lurusnya.
Secara matematis, anisotropi dapat dimodelkan dengan transformasi jarak arah-spesifik:
\[ h' = \sqrt{ \left(\frac{x}{a_x}\right)^2 + \left(\frac{y}{a_y}\right)^2 } \]
di mana \(a_x\) dan \(a_y\) menunjukkan jangkauan korelasi yang berbeda menurut arah.
vgm() di R
bisa mendeteksi lewat alpha).Interpolasi membutuhkan titik pengamatan yang cukup rapat dan merata agar hasil representatif.
Distribusi titik menentukan pilihan metode:
Tidak ada model interpolasi yang sempurna; karena itu validasi sangat penting.
Gunakan Leave-One-Out (LOO) atau k-fold cross-validation untuk menguji seberapa baik model memprediksi data yang tidak digunakan dalam fitting.
\[ \text{RMSE} = \sqrt{\frac{1}{n} \sum_{i=1}^{n} (\hat{Z}(s_i) - Z(s_i))^2} \]
Metrik lain yang umum:
| Metrik | Interpretasi | Nilai Ideal |
|---|---|---|
| RMSE | Akurasi keseluruhan | Sekecil mungkin |
| MAE | Stabilitas prediksi | Sekecil mungkin |
| ME | Bias rata-rata | Mendekati 0 |
Asumsi-asumsi di atas tidak hanya formalitas, tetapi komponen
kunci keberhasilan interpolasi spasial.
Memahami autokorelasi, tren, anisotropi, dan distribusi data membantu
memastikan bahwa hasil interpolasi tidak hanya halus secara visual,
tetapi juga valid secara ilmiah.
“A map is only as good as the assumptions behind it.” — Adapted from Cressie (1993)
Berikut kanonik metode yang sering dipakai (dari yang non-parametrik hingga berbasis model stokastik):
fields).Pada modul ini, contoh kode difokuskan pada IDW dan Kriging dengan
gstat, karena keduanya populer dan tanpa dependensi tambahan.
Definisi
Metode Nearest Neighbor (NN) atau Thiessen interpolation adalah teknik paling sederhana dalam interpolasi spasial. Untuk suatu lokasi target \(s_0\), kita cari satu titik pengamatan terdekat \(s_{(1)}\), lalu nilai prediksinya langsung diambil dari titik itu:
\[ \hat{Z}(s_0) = Z\big(s_{(1)}\big). \]
Dengan kata lain, titik yang paling dekat “memenangkan” wilayahnya. Secara geometris, seluruh ruang terbagi menjadi poligon-poligon yang disebut Voronoi cells — setiap sel mencakup semua lokasi yang lebih dekat ke satu titik pengamatan dibandingkan ke titik lain.
Contoh Manual
Misalkan kita punya tiga titik pengamatan suhu udara (°C):
| Lokasi | Koordinat (x, y) | Nilai Z |
|---|---|---|
| A | (0, 0) | 28 |
| B | (2, 0) | 30 |
| C | (0, 3) | 25 |
Kita ingin memperkirakan suhu di titik baru \(s_0 = (1, 1)\).
Langkah Perhitungan
Hitung jarak Euclidean ke tiap titik:
\[ \begin{aligned} d(A, s_0) &= \sqrt{(1-0)^2 + (1-0)^2} = \sqrt{2} = 1.414, \\ d(B, s_0) &= \sqrt{(1-2)^2 + (1-0)^2} = \sqrt{2} = 1.414, \\ d(C, s_0) &= \sqrt{(1-0)^2 + (1-3)^2} = \sqrt{10} = 3.162. \end{aligned} \]
Titik A dan B sama-sama paling dekat.
Jika ada jarak sama (tie), ambil salah satu secara deterministik (misalnya yang pertama dalam urutan data), atau gunakan rata-rata dari kandidat terdekat jika ingin hasil lebih halus. Di sini kita ambil A.
Prediksi nilai di \(s_0\):
\[ \hat{Z}(s_0) = Z(A) = 28. \]
Implementasi Ringkas di R
Kode berikut mengilustrasikan perhitungan jarak, pemilihan tetangga terdekat, dan (opsional) sketsa mosaik Voronoi untuk tiga titik tersebut.
# Data titik pengamatan
pts <- data.frame(
id = c("A", "B", "C"),
x = c(0, 2, 0),
y = c(0, 0, 3),
Z = c(28, 30, 25)
)
# Titik target
s0 <- data.frame(x = 1, y = 1)
# Fungsi jarak Euclidean
edist <- function(x1, y1, x2, y2) sqrt((x1 - x2)^2 + (y1 - y2)^2)
# Hitung jarak ke setiap titik pengamatan
pts$dist_s0 <- with(pts, edist(x, y, s0$x, s0$y))
# Urutkan berdasarkan jarak
pts_ord <- pts[order(pts$dist_s0), ]
pts_ord
## id x y Z dist_s0
## 1 A 0 0 28 1.414214
## 2 B 2 0 30 1.414214
## 3 C 0 3 25 2.236068
# Ambil tetangga terdekat (tie-breaker: urutan data)
nearest <- pts_ord[1, ]
cat(sprintf("Nearest to s0=(%.1f,%.1f) is %s at distance %.3f with Z=%g\n",
s0$x, s0$y, nearest$id, nearest$dist_s0, nearest$Z))
## Nearest to s0=(1.0,1.0) is A at distance 1.414 with Z=28
Zhat <- nearest$Z
Zhat
## [1] 28
# Visualisasi Voronoi (opsional)
# Memerlukan paket deldir dan ggplot2
if (requireNamespace("deldir", quietly = TRUE) && requireNamespace("ggplot2", quietly = TRUE)) {
library(deldir)
library(ggplot2)
# Batas plot
xlim <- c(-0.5, 2.5)
ylim <- c(-0.5, 3.5)
# Delaunay/Voronoi tessellation
dd <- deldir::deldir(pts$x, pts$y, rw = c(xlim, ylim))
tiles <- deldir::tile.list(dd)
# Konversi tile ke data.frame untuk ggplot
poly_df <- do.call(rbind, lapply(seq_along(tiles), function(i) {
data.frame(
id = pts$id[i],
x = tiles[[i]]$x,
y = tiles[[i]]$y
)
}))
ggplot() +
geom_polygon(data = poly_df, aes(x = x, y = y, group = id),
fill = NA, color = "grey40") +
geom_point(data = pts, aes(x = x, y = y), size = 3) +
geom_text(data = pts, aes(x = x, y = y, label = id), vjust = -1) +
geom_point(data = s0, aes(x = x, y = y), shape = 4, size = 3, stroke = 1.2) +
coord_equal(xlim = xlim, ylim = ylim, expand = FALSE) +
labs(title = "Sketsa Voronoi untuk Nearest Neighbor",
subtitle = "Titik s0 ditandai dengan silang (×)",
x = "x", y = "y") +
theme_minimal(base_size = 12)
} else {
message("Lewati plot: paket 'deldir' dan/atau 'ggplot2' belum terpasang.")
}
Sifat, Kelebihan, dan Kelemahan
Metode ini sering dipakai untuk visualisasi cepat (misalnya Thiessen polygons pada data curah hujan) sebelum beralih ke metode berbobot seperti IDW atau Kriging.
Contoh2
# Data meuse
data(meuse, package = "sp")
coordinates(meuse) <- ~x+y
meuse <- set_crs(meuse)
meuse$z <- log(meuse$zinc)
data(meuse.grid, package = "sp")
coordinates(meuse.grid) <- ~x+y
gridded(meuse.grid) <- TRUE
proj4string(meuse.grid) <- CRS(proj4string(meuse))
# Sanity checks
stopifnot(!is.na(proj4string(meuse)), !is.na(proj4string(meuse.grid)))
# Cek ringkas
head(meuse@data[,c("zinc","copper")])
## zinc copper
## 1 1022 85
## 2 1141 81
## 3 640 68
## 4 257 81
## 5 269 48
## 6 281 61
# 1) Ambil koordinat observasi & grid (sebagai SpatialPoints)
Xobs <- coordinates(meuse)
grid_sp <- as(meuse.grid, "SpatialPoints")
# 2) Cari indeks tetangga terdekat untuk setiap titik grid
knn <- FNN::get.knnx(data = Xobs, query = coordinates(grid_sp), k = 1)
nn_ix <- knn$nn.index[,1]
# 3) Prediksi NN dan bangun SpatialPixelsDataFrame baru
pred_nn <- meuse$z[nn_ix]
stopifnot(length(pred_nn) == nrow(as.data.frame(meuse.grid)))
nn_grid <- SpatialPixelsDataFrame(points = grid_sp,
data = data.frame(z_nn = pred_nn),
proj4string = CRS(proj4string(meuse.grid)))
# 4) Plot aman — kolom 'z_nn' dijamin ada
spplot(nn_grid, "z_nn", main = "Nearest Neighbor (1-NN) — Prediksi log(Zinc)")
Metode Natural Neighbor (atau Sibson interpolation) bekerja berdasarkan Voronoi diagram juga, namun dengan gagasan yang lebih halus. Jika Nearest Neighbor (NN) hanya mengambil satu titik terdekat, Natural Neighbor mempertimbangkan beberapa titik yang “terkait” dengan lokasi baru \(s_0\).
Langkah pikirannya:
Secara konseptual:
\[ \hat{Z}(s_0) = \sum_i w_i \, Z(s_i), \quad \text{dengan } w_i \ge 0, \; \sum_i w_i = 1. \]
Bobot \(w_i\) sebanding dengan proporsi luas Voronoi yang “diambil alih” oleh \(s_0\). Karena bobot positif dan menjumlah ke 1, hasil interpolasi bersifat halus dan kontinu.
Implementasi Sibson interpolation yang eksak cukup kompleks dan jarang tersedia langsung di R. Alternatif praktis adalah TIN linear interpolation: interpolasi linier di dalam Delaunay triangulation (dual dari Voronoi).
Intinya:
Misalkan tiga titik pengamatan membentuk satu segitiga:
| Lokasi | (x, y) | Nilai Z |
|---|---|---|
| A | (0, 0) | 10 |
| B | (4, 0) | 30 |
| C | (0, 4) | 20 |
Kita ingin menghitung nilai di \(s_0 = (1, 1)\).
1) Cek posisi \(s_0\)
\(s_0\) berada di dalam segitiga ABC karena koordinatnya positif dan \(1 + 1 < 4\).
2) Luas segitiga utama (ABC)
Gunakan rumus determinan (setengah dari determinan):
\[ L_{ABC} = \tfrac{1}{2} \big| x_A(y_B - y_C) + x_B(y_C - y_A) + x_C(y_A - y_B) \big|. \]
Substitusi koordinat menghasilkan \(L_{ABC} = 8\).
3) Luas tiga sub-segitiga yang melibatkan \(s_0\)
Total luas sub-segitiga = \(4 + 2 + 2 = 8\), konsisten dengan \(L_{ABC}\).
4) Bobot barycentric
\[ w_A = \frac{L_{s_0BC}}{L_{ABC}} = \frac{4}{8} = 0.5, \quad w_B = \frac{L_{As_0C}}{L_{ABC}} = \frac{2}{8} = 0.25, \quad w_C = \frac{L_{ABs_0}}{L_{ABC}} = \frac{2}{8} = 0.25. \]
5) Interpolasi nilai
\[ \hat{Z}(s_0) = 0.5\cdot 10 + 0.25\cdot 30 + 0.25\cdot 20 = 17.5. \]
Implementasi Ringkas di R
Contoh fungsi kecil untuk menghitung bobot barycentric dan nilai interpolasi pada \(s_0\):
tri_barycentric <- function(A, B, C, s0, Z) {
area <- function(P, Q, R) 0.5 * abs(P[1]*(Q[2]-R[2]) + Q[1]*(R[2]-P[2]) + R[1]*(P[2]-Q[2]))
L_ABC <- area(A, B, C)
L_s0BC <- area(s0, B, C)
L_As0C <- area(A, s0, C)
L_ABs0 <- area(A, B, s0)
wA <- L_s0BC / L_ABC
wB <- L_As0C / L_ABC
wC <- L_ABs0 / L_ABC
Zhat <- wA*Z[1] + wB*Z[2] + wC*Z[3]
list(weights = c(A = wA, B = wB, C = wC), Zhat = Zhat,
areas = c(ABC = L_ABC, s0BC = L_s0BC, As0C = L_As0C, ABs0 = L_ABs0))
}
A <- c(0, 0); B <- c(4, 0); C <- c(0, 4)
s0 <- c(1, 1)
Z <- c(10, 30, 20) # Z_A, Z_B, Z_C
res <- tri_barycentric(A, B, C, s0, Z)
res
## $weights
## A B C
## 0.50 0.25 0.25
##
## $Zhat
## [1] 17.5
##
## $areas
## ABC s0BC As0C ABs0
## 8 4 2 2
Visualisasi Voronoi Diagram
Visualisasi berikut memperlihatkan sel Voronoi untuk titik A, B, dan C, dengan \(s_0 = (1,1)\) ditandai silang (×).
if (requireNamespace("deldir", quietly = TRUE) && requireNamespace("ggplot2", quietly = TRUE)) {
library(deldir)
library(ggplot2)
pts <- data.frame(id = c("A","B","C"), x = c(0,4,0), y = c(0,0,4))
s0 <- data.frame(x = 1, y = 1)
dd <- deldir::deldir(pts$x, pts$y, rw = c(-0.5,4.5,-0.5,4.5))
tiles <- deldir::tile.list(dd)
poly_df <- do.call(rbind, lapply(seq_along(tiles), function(i) {
data.frame(id = pts$id[i], x = tiles[[i]]$x, y = tiles[[i]]$y)
}))
ggplot() +
geom_polygon(data = poly_df, aes(x=x, y=y, group=id), fill=NA, color="grey40") +
geom_point(data = pts, aes(x=x, y=y), size=3) +
geom_text(data = pts, aes(x=x, y=y, label=id), vjust=-1) +
geom_point(data = s0, aes(x=x, y=y), shape=4, size=3, stroke=1.2) +
coord_equal(xlim=c(-0.5,4.5), ylim=c(-0.5,4.5)) +
labs(title="Voronoi Diagram untuk A(0,0), B(4,0), C(0,4)",
subtitle="Titik s0=(1,1) ditandai dengan silang (×)",
x="x", y="y") +
theme_minimal(base_size = 12)
}
Catatan: Untuk implementasi TIN skala lebih besar beserta triangulasi Delaunay, Anda dapat menggunakan paket seperti
RTriangle,geometry(fungsidelaunayn), ataudeldir(untuk Voronoi/Delaunay 2D), lalu menerapkan interpolasi linier di dalam setiap segitiga.
Contoh 2
Xobs <- coordinates(meuse)
xg <- sort(unique(meuse.grid@coords[,1]))
yg <- sort(unique(meuse.grid@coords[,2]))
tin_out <- interp::interp(x = Xobs[,1], y = Xobs[,2], z = meuse$z,
xo = xg, yo = yg, duplicate = "mean", linear = TRUE)
zmat <- tin_out$z
grd <- expand.grid(x = tin_out$x, y = tin_out$y)
tin_sgdf <- SpatialPixelsDataFrame(points = SpatialPoints(grd),
data = data.frame(z_tin = as.vector(zmat)),
tolerance = 0.5)
proj4string(tin_sgdf) <- CRS(proj4string(meuse))
spplot(tin_sgdf, "z_tin", main = "TIN (Linear) — Perkiraan log(Zinc)")
xg <- sort(unique(meuse.grid@coords[,1]))
yg <- sort(unique(meuse.grid@coords[,2]))
tin_out <- interp::interp(x = Xobs[,1], y = Xobs[,2], z = meuse$z,
xo = xg, yo = yg, duplicate = "mean", linear = TRUE)
zmat <- tin_out$z
grd <- expand.grid(x = tin_out$x, y = tin_out$y)
tin_sgdf <- SpatialPixelsDataFrame(points = SpatialPoints(grd),
data = data.frame(z_tin = as.vector(zmat)),
tolerance = 0.5)
proj4string(tin_sgdf) <- CRS(proj4string(meuse))
spplot(tin_sgdf["z_tin"], main = "TIN (Linear Barycentric) — Perkiraan log(Zinc)")
Inverse Distance Weighting (IDW) adalah metode interpolasi deterministik yang memperkirakan nilai di lokasi target \(s_0\) sebagai rata-rata tertimbang dari nilai-nilai di titik pengamatan \(s_i\), dengan bobot menurun terhadap jarak.
\[ w_i(s_0) \propto d(s_0, s_i)^{-p}, \qquad p > 0, \]
\[ \hat{Z}(s_0) = \frac{\sum_i w_i(s_0)\, Z(s_i)}{\sum_i w_i(s_0)}. \]
Umumnya kita gunakan jarak Euclidean \(d(\cdot,\cdot)\). Parameter power \(p\) mengontrol tingkat pengaruh jarak: makin besar \(p\), makin tajam penurunan bobot.
Sifat & Intuisi Parameter \(p\)
IDW tidak memerlukan variogram dan tidak memodelkan struktur kovariansi. Ia lokal, cepat, dan deterministik; namun tidak optimal secara statistik (tidak BLUE seperti kriging ketika asumsi terpenuhi).
Kebijakan Tetangga (Neighborhood)
Catatan tepi (edge cases): - Jika ada titik tepat di \(s_0\) (\(d=0\)), definisikan \(\hat{Z}(s_0) = Z(s_i)\) untuk menghindari pembagian nol. - Titik duplikat/kolokasi sebaiknya diagregasi (mis. rata-rata) atau ditangani sebagai pengamatan terpisah dengan jarak \(>0\) sangat kecil. - Anisotropi bisa dicapai dengan metrik jarak berbobot/ter-skala (mis. skala sumbu x,y berbeda) atau rotasi sumbu.
Contoh Manual (Data Segitiga)
Tiga titik pengamatan:
| Lokasi | (x, y) | Z |
|---|---|---|
| A | (0, 0) | 10 |
| B | (4, 0) | 30 |
| C | (0, 4) | 20 |
Target: \(s_0 = (1, 1)\). Jarak Euclidean:
\[ d(A,s_0)=\sqrt{2}=1.4142,\quad d(B,s_0)=d(C,s_0)=\sqrt{10}=3.1623. \]
Perhitungan untuk \(p=2\) Bobot tak ternormalisasi: \(w_A=1/2=0.5,\; w_B=w_C=1/10=0.1\). Total = 0.7. Bobot normalisasi: \(w_A=0.7143,\; w_B=0.1429,\; w_C=0.1429\).
\[ \hat{Z}(s_0)=0.7143\cdot 10 + 0.1429\cdot 30 + 0.1429\cdot 20 = 7.143 + 4.286 + 2.857 \approx 14.29. \]
Perhitungan untuk \(p=1\)
Bobot tak ternormalisasi: \(w_A=1/1.4142=0.7071,\; w_B=w_C=1/3.1623=0.3162\). Total = 1.3395. Bobot normalisasi: \(w_A=0.528,\; w_B=0.236,\; w_C=0.236\).
\[ \hat{Z}(s_0)=0.528\cdot 10 + 0.236\cdot 30 + 0.236\cdot 20 = 5.28 + 7.08 + 4.72 = 17.08. \]
Terlihat: semakin besar \(p\), prediksi makin “menempel” pada titik terdekat (A), sehingga turun dari 17.08 (\(p=1\)) menjadi 14.29 (\(p=2\)).
Implementasi Ringkas di R
Fungsi IDW sederhana (dengan pilihan \(k\) tetangga terdekat dan penanganan \(d=0\)):
# x,y: koordinat pengamatan; z: nilai; x0,y0: target; p: power; k: k-NN (opsional)
idw_predict <- function(x, y, z, x0, y0, p = 2, k = NULL) {
d <- sqrt((x - x0)^2 + (y - y0)^2)
# Jika ada titik tepat di lokasi target
if (any(d == 0)) return(z[which.min(d)])
# Pilih k-NN jika diminta
if (!is.null(k) && k < length(d)) {
idx <- order(d)[1:k]
d <- d[idx]; z <- z[idx]
}
w <- 1 / (d^p)
sum(w * z) / sum(w)
}
# Contoh data
df <- data.frame(id = c("A","B","C"), x = c(0,4,0), y = c(0,0,4), z = c(10,30,20))
# Prediksi di s0 = (1,1)
idw_p2 <- idw_predict(df$x, df$y, df$z, 1, 1, p = 2)
idw_p1 <- idw_predict(df$x, df$y, df$z, 1, 1, p = 1)
c(p2 = idw_p2, p1 = idw_p1)
## p2 p1
## 14.28571 17.08204
Peta Permukaan IDW (Grid) — Visualisasi
Contoh kecil membuat permukaan IDW pada grid, lalu divisualisasikan.
library(ggplot2)
# Grid
xg <- seq(-0.5, 4.5, by = 0.1)
yg <- seq(-0.5, 4.5, by = 0.1)
G <- expand.grid(x = xg, y = yg)
# Prediksi untuk dua nilai p
G$z_p2 <- mapply(function(x0, y0) idw_predict(df$x, df$y, df$z, x0, y0, p = 2), G$x, G$y)
G$z_p1 <- mapply(function(x0, y0) idw_predict(df$x, df$y, df$z, x0, y0, p = 1), G$x, G$y)
# Plot p=2 (lebih menempel ke titik terdekat)
plt2 <- ggplot(G, aes(x, y, fill = z_p2)) +
geom_raster(interpolate = TRUE) +
geom_contour(aes(z = z_p2), color = "white", alpha = 0.6) +
geom_point(data = df, aes(x, y), inherit.aes = FALSE, size = 2) +
geom_text(data = df, aes(x, y, label = id), inherit.aes = FALSE, vjust = -1) +
coord_equal(xlim = c(-0.5, 4.5), ylim = c(-0.5, 4.5)) +
labs(title = "Permukaan IDW (p = 2)", x = "x", y = "y", fill = "Ẑ") +
theme_minimal(base_size = 12)
# Plot p=1 (lebih halus)
plt1 <- ggplot(G, aes(x, y, fill = z_p1)) +
geom_raster(interpolate = TRUE) +
geom_contour(aes(z = z_p1), color = "white", alpha = 0.6) +
geom_point(data = df, aes(x, y), inherit.aes = FALSE, size = 2) +
geom_text(data = df, aes(x, y, label = id), inherit.aes = FALSE, vjust = -1) +
coord_equal(xlim = c(-0.5, 4.5), ylim = c(-0.5, 4.5)) +
labs(title = "Permukaan IDW (p = 1)", x = "x", y = "y", fill = "Ẑ") +
theme_minimal(base_size = 12)
plt1
plt2
Diskusi Singkat: IDW vs NN vs Kriging
Praktik: mulai dengan IDW untuk baseline cepat; cek sensitivitas terhadap \(p\), \(k\), dan radius; jika pola spasial kuat dan data cukup, pertimbangkan kriging.
idw_p2 <- idw(z ~ 1, meuse, meuse.grid, idp = 2)
## [inverse distance weighted interpolation]
spplot(idw_p2["var1.pred"], main = "IDW (p=2) — Prediksi log(Zinc)")
Trend Surface Analysis (TSA) atau Polynomial Regression Surface adalah pendekatan global interpolation yang merepresentasikan variasi spasial suatu variabel (misalnya ketinggian, suhu, curah hujan) menggunakan fungsi polinomial terhadap koordinat spasial \(x\) dan \(y\):
\[ Z(x, y) = \beta_0 + \beta_1 x + \beta_2 y + \beta_3 x^2 + \beta_4 xy + \beta_5 y^2 + \cdots + \varepsilon. \]
Semakin tinggi orde polinomialnya, semakin kompleks bentuk permukaan yang bisa diwakili (misal gelombang, lengkungan, atau gradien kompleks).
Intuisi & Tujuan
Model Polinomial
1) Polinomial orde-1 (Linear) \[ Z(x, y) = \beta_0 + \beta_1 x + \beta_2 y + \varepsilon. \] Menunjukkan permukaan bidang miring (gradien konstan).
2) Polinomial orde-2 (Kuadratik) \[ Z(x, y) = \beta_0 + \beta_1 x + \beta_2 y + \beta_3 x^2 + \beta_4 xy + \beta_5 y^2 + \varepsilon. \] Menunjukkan permukaan paraboloid (melengkung); bisa menangkap cekungan, punggungan, atau lembah.
3) Polinomial orde-n (umum) \[ Z(x, y) = \sum_{i=0}^{n}\sum_{j=0}^{n-i} \beta_{ij} x^i y^j + \varepsilon. \] Makin tinggi orde, makin fleksibel, tetapi risiko overfitting juga meningkat.
Estimasi Parameter
Parameter \(\beta\) diestimasi menggunakan Ordinary Least Squares (OLS):
\[ \hat{\boldsymbol{\beta}} = (X^T X)^{-1} X^T Z, \]
Contoh Manual
Misalkan terdapat 4 titik pengamatan:
| Lokasi | x | y | Z |
|---|---|---|---|
| A | 0 | 0 | 10 |
| B | 1 | 0 | 15 |
| C | 0 | 1 | 12 |
| D | 1 | 1 | 20 |
Kita gunakan trend surface linear (orde-1): \[ Z = \beta_0 + \beta_1 x + \beta_2 y. \]
Bentuk matriksnya: \[ \begin{bmatrix} 10 \\ 15 \\ 12 \\ 20 \end{bmatrix} = \begin{bmatrix} 1 & 0 & 0 \\ 1 & 1 & 0 \\ 1 & 0 & 1 \\ 1 & 1 & 1 \end{bmatrix} \begin{bmatrix} \beta_0 \\ \beta_1 \\ \beta_2 \end{bmatrix}. \]
Kesimpulan: Trend surface membentuk fondasi bagi pendekatan universal kriging,
df_obs <- cbind(as.data.frame(meuse), x = coordinates(meuse)[,1], y = coordinates(meuse)[,2])
fit_trend <- lm(z ~ poly(x,2,raw=TRUE) + poly(y,2,raw=TRUE) + I(x*y), data = df_obs)
df_grd <- cbind(as.data.frame(meuse.grid), x = coordinates(meuse.grid)[,1], y = coordinates(meuse.grid)[,2])
pred_trend <- predict(fit_trend, newdata = df_grd)
trend_grid <- meuse.grid
trend_grid$z_trend <- pred_trend
spplot(trend_grid, "z_trend", main = "Trend Surface (Quadratic) — Prediksi log(Zinc)")
Thin Plate Splines (TPS) adalah metode interpolasi smooth surface yang meminimalkan kelengkungan total permukaan — analogi matematisnya seperti membengkokkan lembaran logam tipis yang melewati semua titik data dengan gaya minimum.
TPS mencari fungsi \(f(x, y)\) yang:
\[ J(f) = \iint \left[ \left(\frac{\partial^2 f}{\partial x^2}\right)^2 + 2\left(\frac{\partial^2 f}{\partial x \partial y}\right)^2 + \left(\frac{\partial^2 f}{\partial y^2}\right)^2 \right] dx\,dy. \]
Model Matematis
TPS dapat ditulis dalam bentuk:
\[ f(x, y) = a_0 + a_1 x + a_2 y + \sum_{i=1}^N w_i U(r_i), \]
dengan:
\[ U(r_i) = r_i^2 \log(r_i), \quad r_i = \sqrt{(x - x_i)^2 + (y - y_i)^2}. \]
Koefisien \(a_0, a_1, a_2, w_i\) diperoleh dengan menyelesaikan sistem persamaan linear yang meminimalkan bending energy sambil tetap memenuhi constraint interpolasi \(f(x_i, y_i) = z_i\).
Intuisi
TPS termasuk dalam kelas Radial Basis Function (RBF) interpolators, dengan basis kernel \(\phi(r) = r^2\log(r)\).
Implementasi di R
R menyediakan fungsi Tps() dari paket
fields atau interp::interp() untuk TPS.
Contoh berikut menggunakan paket fields.
if (requireNamespace("fields", quietly = TRUE)) {
library(fields)
# Data contoh
set.seed(123)
x <- runif(10, 0, 1)
y <- runif(10, 0, 1)
z <- 5 + 2*x + 3*y + rnorm(10, 0, 0.2)
# Fit TPS model
tps_model <- fields::Tps(cbind(x, y), z)
summary(tps_model)
# Prediksi grid
grid <- expand.grid(x = seq(0, 1, length.out = 50), y = seq(0, 1, length.out = 50))
grid$z_hat <- predict(tps_model, grid)
# Visualisasi
library(ggplot2)
ggplot(grid, aes(x, y, fill = z_hat)) +
geom_raster(interpolate = TRUE) +
geom_point(data = data.frame(x = x, y = y),
mapping = aes(x = x, y = y),
inherit.aes = FALSE, size = 2, color = "black") +
geom_text(data = data.frame(x = x, y = y, z = z),
mapping = aes(x = x, y = y, label = round(z, 1)),
inherit.aes = FALSE, vjust = -1) +
scale_fill_viridis_c() +
coord_equal() +
labs(title = "Interpolasi Thin Plate Splines (TPS)", fill = "Ẑ") +
theme_minimal(base_size = 12)
}
Parameter Smoothing (λ)
TPS juga mendukung versi smoothing spline, dengan parameter \(\lambda\) yang menyeimbangkan fit dan smoothness:
\[ \text{Minimize } \sum_i [z_i - f(x_i, y_i)]^2 + \lambda J(f). \]
Parameter \(\lambda\) sering dipilih
dengan Generalized Cross Validation (GCV) otomatis di
fungsi Tps().
Contoh Smoothing TPS
if (requireNamespace("fields", quietly = TRUE)) {
library(ggplot2)
# Pastikan grid, x, y, z tersedia; jika 'grid' sudah berisi kolom lain (mis. z_hat),
# gunakan hanya koordinat x,y saat memanggil predict.
if (!exists("x") || !exists("y") || !exists("z")) {
set.seed(123)
x <- runif(10, 0, 1); y <- runif(10, 0, 1); z <- 5 + 2*x + 3*y + rnorm(10, 0, 0.2)
}
if (!exists("grid")) {
grid <- expand.grid(x = seq(0, 1, length.out = 50), y = seq(0, 1, length.out = 50))
}
tps_smooth <- fields::Tps(cbind(x, y), z, lambda = 0.1)
coords <- grid[, c("x", "y")] # <- hanya kolom koordinat
grid$z_smooth <- predict(tps_smooth, coords)
ggplot(grid, aes(x, y, fill = z_smooth)) +
geom_raster(interpolate = TRUE) +
geom_point(data = data.frame(x = x, y = y),
mapping = aes(x = x, y = y),
inherit.aes = FALSE, size = 2, color = 'black') +
coord_equal() +
scale_fill_viridis_c() +
labs(title = "Thin Plate Splines dengan λ = 0.1 (Smoothed)", fill = "Ẑ") +
theme_minimal(base_size = 12)
}
Kelebihan & Keterbatasan
| Aspek | Penjelasan |
|---|---|
| Kelebihan | Permukaan sangat halus (hingga turunan kedua); tidak perlu parameter jarak atau tetangga; cocok untuk permukaan kontinyu. |
| Keterbatasan | Komputasi mahal untuk data besar (O(N³)); sulit mengatur anisotropy; hasil bisa oversmooth untuk gradien tajam. |
Hubungan dengan Metode Lain
# Aktifkan bila paket fields tersedia: install.packages("fields")
library(fields)
X <- coordinates(meuse)
tps_fit <- fields::Tps(X, meuse$z) # smoothing via GCV
pred_tps <- predict(tps_fit, coordinates(as(meuse.grid, "SpatialPoints")))
tps_grid <- meuse.grid
tps_grid$z_tps <- as.numeric(pred_tps)
spplot(tps_grid, "z_tps", main = "Thin Plate Splines (fields::Tps) — Prediksi log(Zinc)")
Kriging adalah metode spatial interpolation berbasis teori proses stokastik yang mencari penduga linier tak bias dengan variansi minimum (BLUE) untuk nilai suatu peubah spasial \(Z(s)\) pada lokasi yang belum diobservasi \(s_0\). Intuisi singkatnya: gunakan tetangga yang informatif—dengan bobot optimal berbasis struktur autokorelasi—untuk menebak nilai di lokasi target.
Secara umum, penduga Kriging ditulis: \[ \hat{Z}(s_0) = \sum_{i=1}^n \lambda_i Z(s_i), \] dengan bobot \(\lambda_i\) dipilih agar tak bias dan meminimalkan varian galat prediksi.
Kekuatan Kriging ada pada variogram/kovarians: informasi jarak dan arah memengaruhi seberapa besar kontribusi tetangga terhadap prediksi.
Data spasial adalah realisasi dari suatu bidang acak \(Z(s)\), \(s \in \mathbb{R}^2\). Untuk dua lokasi \(s_i, s_j\), kovarians didefinisikan \[ \operatorname{Cov}[Z(s_i), Z(s_j)] = C(h), \quad h = s_i - s_j. \]
Variogram mengukur ketidaksamaan rata-rata kuadrat pada jarak \(h\): \[ \gamma(h) = \tfrac{1}{2}\operatorname{Var}[Z(s) - Z(s+h)]. \] Untuk proses stasioner orde-2, relasi dengan kovarians: \[ \gamma(h) = C(0) - C(h). \]
Tuliskan \(Z(s) = \mu(s) + \varepsilon(s)\) dengan \(E[\varepsilon(s)]=0\).
Untuk OK, syarat tak bias: \(\sum_i \lambda_i = 1\), diberlakukan via pengali Lagrange \(\mu\): \[ \begin{bmatrix} \Sigma & \mathbf{1} \\\\ \mathbf{1}^\top & 0 \end{bmatrix} \begin{bmatrix} \lambda \\\\ \mu \end{bmatrix} = \begin{bmatrix} \sigma_0 \\\\ 1 \end{bmatrix}, \quad \sigma_K^2(s_0) = C(0) - 2\lambda^\top \sigma_0 + \lambda^\top \Sigma \lambda. \] Di mana \(\Sigma_{ij}=C(s_i-s_j)\), \(\sigma_{0,i}=C(s_i-s_0)\). Dalam bentuk variogram gunakan \(C(0)-C(h)=\gamma(h)\).
Bagian ini memberikan contoh perhitungan manual Ordinary
Kriging dengan dataset kecil (3 titik), lalu
memverifikasi hasilnya menggunakan paket
gstat di R.
Data & Target
Tiga titik pengamatan \(Z\) dan satu lokasi target \(s_0=(1,1)\):
| Titik | x | y | Z |
|---|---|---|---|
| A | 0 | 0 | 10 |
| B | 2 | 0 | 20 |
| C | 0 | 2 | 30 |
Target: \(s_0 = (1,1)\).
Gunakan spherical variogram dengan parameter: - Nugget \(c_0=0\) - Sill parsial \(c=1\) - Range \(a=2\)
Bentuk fungsi variogram: \[ \gamma(h) = \begin{cases} c_0 + c\left[\tfrac{3h}{2a} - \tfrac{1}{2}\left(\tfrac{h}{a}\right)^3\right], & h \le a, \\ c_0 + c, & h > a. \end{cases} \]
Perhitungan Manual
1) Jarak antar titik & ke target
A <- c(0,0); B <- c(2,0); C <- c(0,2); s0 <- c(1,1)
edist <- function(p,q) sqrt(sum((p-q)^2))
h_AB <- edist(A,B)
h_AC <- edist(A,C)
h_BC <- edist(B,C)
h_As0 <- edist(A,s0)
h_Bs0 <- edist(B,s0)
h_Cs0 <- edist(C,s0)
c(h_AB=h_AB, h_AC=h_AC, h_BC=h_BC, h_As0=h_As0, h_Bs0=h_Bs0, h_Cs0=h_Cs0)
## h_AB h_AC h_BC h_As0 h_Bs0 h_Cs0
## 2.000000 2.000000 2.828427 1.414214 1.414214 1.414214
Hasil: \(h_{AB}=h_{AC}=2\); \(h_{BC}=2.828\); \(h_{A,s_0}=h_{B,s_0}=h_{C,s_0}=1.414\).
2) Fungsi variogram \(\gamma(h)\)
# Spherical variogram with c0=0, c=1, a=2
vgm_sph <- function(h, c0=0, c=1, a=2) {
out <- ifelse(h <= a, c0 + c*(1.5*(h/a) - 0.5*(h/a)^3), c0 + c)
as.numeric(out)
}
c(g_2 = vgm_sph(2), g_2_828 = vgm_sph(sqrt(8)), g_1_414 = vgm_sph(sqrt(2)))
## g_2 g_2_828 g_1_414
## 1.0000000 1.0000000 0.8838835
Untuk \(h=1.414\): \(\gamma \approx 1.038\); untuk \(h\ge a\), \(\gamma=1\).
3) Sistem Persamaan Kriging (Ordinary)
Sistem OK untuk 3 titik:
\[ \begin{bmatrix} 0 & \gamma_{AB} & \gamma_{AC} & 1 \\ \gamma_{BA} & 0 & \gamma_{BC} & 1 \\ \gamma_{CA} & \gamma_{CB} & 0 & 1 \\ 1 & 1 & 1 & 0 \end{bmatrix} \begin{bmatrix} \lambda_A \\ \lambda_B \\ \lambda_C \\ \mu \end{bmatrix} = \begin{bmatrix} \gamma_{A,s_0} \\ \gamma_{B,s_0} \\ \gamma_{C,s_0} \\ 1 \end{bmatrix}. \]
Dengan \(\gamma_{AB}=\gamma_{AC}=1\), \(\gamma_{BC}=1\), dan \(\gamma_{A,s_0}=\gamma_{B,s_0}=\gamma_{C,s_0}=1.038\).
G <- matrix(c(
0, 1, 1, 1,
1, 0, 1, 1,
1, 1, 0, 1,
1, 1, 1, 0
), nrow=4, byrow=TRUE)
rhs <- c(1.038, 1.038, 1.038, 1)
sol <- solve(G, rhs)
sol
## [1] 0.3333333 0.3333333 0.3333333 0.3713333
Komponen solusi: \(\lambda_A, \lambda_B, \lambda_C, \mu\). Periksa penjumlahan bobot = 1.
lambda <- sol[1:3]; mu <- sol[4]
sum_lambda <- sum(lambda)
Z <- c(A=10, B=20, C=30)
Zhat <- sum(lambda * Z)
list(weights=lambda, sum_lambda=sum_lambda, Zhat=Zhat, mu=mu)
## $weights
## [1] 0.3333333 0.3333333 0.3333333
##
## $sum_lambda
## [1] 1
##
## $Zhat
## [1] 20
##
## $mu
## [1] 0.3713333
Hasil manual: \(\lambda_A=\lambda_B=\lambda_C=1/3\), \(\hat Z(s_0)=20\).
\[ \sigma_k^2 = \sum_i \lambda_i\, \gamma(s_i, s_0) + \mu. \]
g_As0 <- vgm_sph(sqrt(2))
var_krig <- sum(lambda * c(g_As0, g_As0, g_As0)) + mu
var_krig
## [1] 1.255217
Varian kriging \(\approx 1.41\).
Verifikasi dengan gstat
library(sp)
library(gstat)
# Observasi sebagai SpatialPointsDataFrame
df <- data.frame(x=c(0,2,0), y=c(0,0,2), Z=c(10,20,30))
coordinates(df) <- ~x+y
# Lokasi prediksi (s0)
newd <- data.frame(x=1, y=1)
coordinates(newd) <- ~x+y
# Variogram model: Spherical, psill=1, range=2, nugget=0
vgm_model <- vgm(psill=1, model="Sph", range=2, nugget=0)
# Ordinary kriging
ok <- gstat(formula = Z~1, data=df, model=vgm_model)
kr <- predict(ok, newd, nsim=0)
## [using ordinary kriging]
kr
## class : SpatialPointsDataFrame
## features : 1
## extent : 1, 1, 1, 1 (xmin, xmax, ymin, ymax)
## crs : NA
## variables : 2
## names : var1.pred, var1.var
## value : 20, 1.1011002862997
Kolom var1.pred adalah \(\hat
Z(s_0)\) dan var1.var adalah varian kriging. Nilai
seharusnya sangat dekat dengan hasil manual (20 dan ~1.41).
Peta Permukaan Prediksi & Varian
# Grid untuk peta
xg <- seq(-0.5, 2.5, by=0.05)
yg <- seq(-0.5, 2.5, by=0.05)
newgrid <- expand.grid(x=xg, y=yg)
coordinates(newgrid) <- ~x+y
krg <- predict(ok, newgrid)
## [using ordinary kriging]
kr_df <- as.data.frame(krg)
library(ggplot2)
p1 <- ggplot(kr_df, aes(x, y, fill = var1.pred)) +
geom_raster(interpolate = TRUE) +
geom_contour(aes(z = var1.pred), color = "white", alpha = 0.6) +
geom_point(data = as.data.frame(df), aes(x, y), inherit.aes = FALSE, size = 2) +
coord_equal() +
labs(title = "Ordinary Kriging — Prediksi", fill = "Ẑ") +
theme_minimal(base_size = 12)
p2 <- ggplot(kr_df, aes(x, y, fill = var1.var)) +
geom_raster(interpolate = TRUE) +
geom_contour(aes(z = var1.var), color = "white", alpha = 0.6) +
geom_point(data = as.data.frame(df), aes(x, y), inherit.aes = FALSE, size = 2) +
coord_equal() +
labs(title = "Ordinary Kriging — Varian Prediksi", fill = "Var") +
theme_minimal(base_size = 12)
p1
p2
Catatan Praktis
sp + gstat# Fungsi bantu: set CRS aman ke EPSG:28992 (Amersfoort / RD New)
set_crs <- function(obj){
ok <- TRUE
tryCatch({
proj4string(obj) <- CRS("+init=epsg:28992")
}, error = function(e) ok <<- FALSE)
if(!ok){
proj4string(obj) <- CRS(SRS_string = "EPSG:28992")
}
obj
}
# Data meuse
data(meuse, package = "sp")
coordinates(meuse) <- ~x+y
meuse <- set_crs(meuse)
# Grid prediksi
data(meuse.grid, package = "sp")
coordinates(meuse.grid) <- ~x+y
gridded(meuse.grid) <- TRUE
proj4string(meuse.grid) <- CRS(proj4string(meuse)) # samakan CRS
# Cek ringkas
head(meuse@data[,c("zinc","copper")])
## zinc copper
## 1 1022 85
## 2 1141 81
## 3 640 68
## 4 257 81
## 5 269 48
## 6 281 61
v.emp <- variogram(log(zinc) ~ 1, meuse)
plot(v.emp, main = "Variogram Empirik log(Zinc)")
# Fit model Spherical (tebakan awal; silakan eksplorasi model lain)
v.fit <- fit.variogram(v.emp, vgm(psill = 1, model = "Sph", range = 900, nugget = 1))
v.fit
## model psill range
## 1 Nug 0.05066243 0.0000
## 2 Sph 0.59060780 897.0209
plot(v.emp, v.fit, main = "Fitting Variogram: Spherical")
ok <- krige(log(zinc) ~ 1, meuse, meuse.grid, model = v.fit)
## [using ordinary kriging]
spplot(ok["var1.pred"], main = "Prediksi log(Zinc) — Ordinary Kriging")
spplot(ok["var1.var"], main = "Kriging Variance — Ordinary Kriging")
set.seed(1)
cv <- krige.cv(log(zinc) ~ 1, meuse, model = v.fit, nfold = 10)
summary(cv$residual)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.927351 -0.209674 -0.007915 0.013349 0.212593 1.373407
ggplot(cv@data, aes(x = observed, y = var1.pred)) +
geom_point() +
geom_abline(slope = 1, intercept = 0, linetype = "dashed") +
labs(x = "Observed log(Zinc)", y = "Predicted", title = "10-fold Cross-Validation (OK)")
Jika ada tren global, mis. \(\mu(s)=\beta_0+\beta_1 x + \beta_2 y\).
uk <- krige(log(zinc) ~ x + y, meuse, meuse.grid, model = v.fit)
## [using universal kriging]
spplot(uk["var1.pred"], main = "Universal Kriging (x + y) — Prediksi log(Zinc)")
Tips praktis: tambahkan polinomial atau kovariat lain (jarak ke sungai, elevasi) bila relevan.
Kita punya peubah target \(Z_1\) (zinc) dan peubah sekunder \(Z_2\) (copper) yang berkorelasi spasial. Bangun LMC yang memodelkan variogram masing-masing dan cross-variogram.
# Definisikan dua proses
gs <- gstat(NULL, id = "zinc", formula = log(zinc) ~ 1, data = meuse)
gs <- gstat(gs, id = "copper", formula = log(copper) ~ 1, data = meuse)
# Variogram & cross-variogram
v.cross <- variogram(gs)
plot(v.cross, main = "Variogram & Cross-Variogram (zinc, copper)")
# Fit LMC (seed Spherical)
vm <- vgm(psill = 1, model = "Sph", range = 900, nugget = 1)
lmc.fit <- fit.lmc(v.cross, gs, model = vm)
plot(v.cross, lmc.fit, main = "Fitting LMC (Spherical seed)")
# Prediksi co-kriging pada grid
ck.pred <- predict(lmc.fit, meuse.grid) # kolom: zinc.pred, copper.pred, dst.
## Linear Model of Coregionalization found. Good.
## [using ordinary cokriging]
spplot(ck.pred["zinc.pred"], main = "Prediksi Zinc — Co-Kriging")
Catatan: Co-Kriging efektif bila peubah sekunder informatif (korelasi spasial & cross variogram jelas), serta tersedia dengan cakupan spasial baik.
Untuk \(Z(s,t)\), gunakan \(C(h,u)\) dengan lag ruang \(h\) dan waktu \(u\). Model separabel: \(C(h,u)=C_s(h)C_t(u)\). Implementasi dapat
memakai gstat (variogram spatio-temporal) atau pendekatan
Bayesian (INLA) dengan efek acak ruang–waktu.
SPDE mengaitkan GRF kontinu dan GMRF pada mesh triangulasi melalui \[ (\kappa^2 - \Delta)^{\alpha/2} x(s) = W(s). \] Keuntungan: komputasi efisien (matriks presisi sparse) dan inferensi probabilistik penuh.
eval=FALSE)suppressPackageStartupMessages(library(INLA))
# Mesh
mesh <- inla.mesh.2d(loc = coordinates(meuse), max.edge = c(200, 400))
plot(mesh); points(meuse, col = "red", pch = 19)
# SPDE Matérn dengan prior PC
spde <- inla.spde2.pcmatern(
mesh, alpha = 2,
prior.range = c(1000, 0.5), # P(range < 1000) = 0.5
prior.sigma = c(1, 0.01) # P(sigma > 1) = 0.01
)
# Index & proyeksi
iset <- inla.spde.make.index("spatial", n.spde = spde$n.spde)
A <- inla.spde.make.A(mesh, loc = coordinates(meuse))
# Stack
stk <- inla.stack(
data = list(y = log(meuse$zinc)),
A = list(A, 1),
effects = list(iset, data.frame(Intercept = 1)),
tag = "est"
)
# Fitting
formula <- y ~ 1 + f(spatial, model = spde)
res <- inla(
formula,
data = inla.stack.data(stk),
family = "gaussian",
control.predictor = list(A = inla.stack.A(stk), compute = TRUE),
control.compute = list(dic = TRUE, waic = TRUE, cpo = TRUE)
)
summary(res)
# Posterior mean pada mesh
mean.field <- res$summary.random$spatial$mean
plot(mesh, main = "Posterior Mean Field (SPDE)"); points(meuse, pch = 20, cex = .5)
Rangkuman: Variogram adalah jantung Kriging; OK/UK menangani mean lokal vs tren; Co-Kriging memanfaatkan peubah sekunder; SPDE memberi skala besar dan ketidakpastian penuh.
Latihan:
meuse?lead,
cadmium) untuk Co-Kriging; bandingkan peta.Berikut perbandingan ringkas beberapa metode interpolasi spasial yang umum digunakan, termasuk Kriging sebagai pendekatan berbasis model stokastik yang paling kuat secara statistik.
Kelebihan:
- Super cepat dan mudah diimplementasikan.
- Cocok untuk baseline awal atau data dengan sebaran sangat
jarang.
Keterbatasan:
- Hasilnya “bloky” (diskontinu di batas Voronoi).
- Tidak menangkap transisi spasial yang halus.
Kelebihan:
- Menghasilkan permukaan halus di dalam setiap segitiga Delaunay.
- Konservatif: tidak memprediksi di luar convex hull data.
Keterbatasan:
- Sensitif terhadap kualitas dan distribusi triangulasi.
- Sulit diterapkan jika data sangat tidak merata.
Kelebihan:
- Intuitif, parameter sederhana (pangkat jarak \(p\)).
- Memberikan hasil halus tanpa perlu model variogram.
Keterbatasan:
- Tidak menyediakan varian prediksi (ketidakpastian).
- Sensitif terhadap nilai ekstrem di sekitar lokasi target.
- Tidak mempertimbangkan struktur autokorelasi spasial.
Kelebihan:
- Mudah dan cepat untuk menangkap pola global (misal gradien
timur–barat).
- Cocok untuk fenomena dengan variasi deterministik besar.
Keterbatasan:
- Mengabaikan autokorelasi residu.
- Tidak cocok untuk pola lokal yang kompleks.
Kelebihan:
- Sangat halus dan fleksibel; parameter halus (\(\lambda\)) dapat dipilih otomatis lewat
GCV.
- Cocok untuk fenomena kontinu dan permukaan lembut.
Keterbatasan:
- Tidak menyediakan peta ketidakpastian.
- Dapat over-smooth jika \(\lambda\) tidak diatur dengan tepat.
- Komputasi cukup berat untuk dataset besar.
Kelebihan:
- Penduga linier tak bias terbaik (BLUE).
- Mempertimbangkan struktur autokorelasi melalui
variogram/kovarians.
- Menghasilkan peta prediksi dan peta ketidakpastian
(varian) secara bersamaan.
- Dapat diperluas menjadi Co-Kriging, Universal Kriging, maupun Kriging
spasio-temporal.
Keterbatasan:
- Membutuhkan pemodelan variogram yang tepat dan validasi model.
- Asumsi stasioneritas sering sulit terpenuhi.
- Komputasi intensif untuk data besar (meskipun dapat diatasi dengan
pendekatan Bayesian/INLA-SPDE).
| Metode | Sifat | Keunggulan | Keterbatasan |
|---|---|---|---|
| NN | Non-parametrik | Cepat, sederhana | Bloky, tanpa transisi halus |
| TIN | Geometrik | Halus dalam segitiga | Sensitif terhadap triangulasi |
| IDW | Deterministik | Intuitif, parameter sederhana | Tidak ada varian prediksi |
| Trend | Regresi | Menangkap pola global | Abaikan korelasi spasial |
| TPS | Smoothing | Halus, fleksibel | Tidak sediakan varian prediksi |
| Kriging | Stokastik | Optimal, sediakan ketidakpastian | Butuh variogram, berat komputasi |
Spatial interpolation adalah prosedur memperkirakan nilai variabel pada lokasi tidak teramati berdasarkan nilai di lokasi teramati di sekitarnya. Tujuannya membuat permukaan kontinu (surface) dari data titik, misalnya peta curah hujan, kualitas udara, kandungan logam tanah, atau ketinggian.
Intuisi: lokasi yang berdekatan cenderung memiliki nilai yang mirip (Tobler’s first law). Perbedaannya ada pada cara memberi bobot dan asumsi model yang digunakan untuk “menjahit” titik-titik menjadi peta kontinu.
Interpolasi spasial bukan sekadar masalah matematis — ia juga
memerlukan pemahaman mendalam tentang struktur spasial
data, asumsi model, dan implikasi
praktis dari setiap pendekatan.
Bagian ini menguraikan secara rinci asumsi-asumsi utama yang mendasari
sebagian besar metode interpolasi.
Autokorelasi spasial merupakan fondasi utama dari
semua metode interpolasi. Prinsip dasarnya dikenal sebagai Hukum
Pertama Geografi (Tobler, 1970):
> “Everything is related to everything else, but near things are more
related than distant things.”
Autokorelasi spasial menyatakan bahwa nilai suatu variabel di
lokasi tertentu cenderung mirip dengan nilai di lokasi lain yang
berdekatan secara geografis.
Jika \(Z(s)\) adalah nilai variabel di
lokasi \(s\), maka untuk dua lokasi
berdekatan \(s_i\) dan \(s_j\):
\[ \text{Cov}(Z(s_i), Z(s_j)) = C(h) \quad \text{dengan } h = \|s_i - s_j\| \]
Artinya, semakin kecil jarak \(h\), semakin besar korelasi antar nilai.
Metode geostatistik klasik, terutama Kriging, mengasumsikan bahwa data berasal dari proses spasial stasioner, yakni:
Namun dalam kenyataannya, banyak fenomena memiliki tren global (misal: ketinggian yang meningkat dari barat ke timur). Dalam kasus ini, asumsi stasioneritas ketat tidak terpenuhi.
Jika terdapat pola sistematik, misalnya perubahan rata-rata secara
spasial, pendekatan seperti Universal Kriging (UK) atau
Trend Surface Analysis lebih sesuai.
Keduanya mengizinkan mean yang bervariasi dengan lokasi:
\[ E[Z(s)] = \beta_0 + \beta_1 x + \beta_2 y + \varepsilon(s) \]
Di mana \(\varepsilon(s)\) tetap dianggap stasioner secara lokal.
Hubungan spasial bisa berbeda pada berbagai skala observasi. Misalnya, variabilitas suhu pada skala 1 km bisa berbeda drastis dengan skala 100 km. Oleh karena itu, pemilihan resolusi grid dan parameter variogram harus sesuai dengan skala analisis.
\[ C(h) = \sigma^2 \exp\left(-\frac{h}{a}\right) \]
Parameter \(a\) (range) mengatur seberapa jauh pengaruh spasial berlaku. Jika skala salah dipilih, interpolasi bisa terlalu halus atau terlalu kasar.
Anisotropi terjadi ketika korelasi spasial bergantung pada arah. Misalnya, penyebaran polutan bisa lebih cepat ke arah angin dibanding arah tegak lurusnya.
Secara matematis, anisotropi dapat dimodelkan dengan transformasi jarak arah-spesifik:
\[ h' = \sqrt{ \left(\frac{x}{a_x}\right)^2 + \left(\frac{y}{a_y}\right)^2 } \]
di mana \(a_x\) dan \(a_y\) menunjukkan jangkauan korelasi yang berbeda menurut arah.
vgm() di R
bisa mendeteksi lewat alpha).Interpolasi membutuhkan titik pengamatan yang cukup rapat dan merata agar hasil representatif.
Distribusi titik menentukan pilihan metode:
Tidak ada model interpolasi yang sempurna; karena itu validasi sangat penting.
Gunakan Leave-One-Out (LOO) atau k-fold cross-validation untuk menguji seberapa baik model memprediksi data yang tidak digunakan dalam fitting.
\[ \text{RMSE} = \sqrt{\frac{1}{n} \sum_{i=1}^{n} (\hat{Z}(s_i) - Z(s_i))^2} \]
Metrik lain yang umum:
| Metrik | Interpretasi | Nilai Ideal |
|---|---|---|
| RMSE | Akurasi keseluruhan | Sekecil mungkin |
| MAE | Stabilitas prediksi | Sekecil mungkin |
| ME | Bias rata-rata | Mendekati 0 |
Asumsi-asumsi di atas tidak hanya formalitas, tetapi komponen
kunci keberhasilan interpolasi spasial.
Memahami autokorelasi, tren, anisotropi, dan distribusi data membantu
memastikan bahwa hasil interpolasi tidak hanya halus secara visual,
tetapi juga valid secara ilmiah.
“A map is only as good as the assumptions behind it.” — Adapted from Cressie (1993)
Berikut kanonik metode yang sering dipakai (dari yang non-parametrik hingga berbasis model stokastik):
fields).Pada modul ini, contoh kode difokuskan pada IDW dan Kriging dengan
gstat, karena keduanya populer dan tanpa dependensi tambahan.
Definisi
Metode Nearest Neighbor (NN) atau Thiessen interpolation adalah teknik paling sederhana dalam interpolasi spasial. Untuk suatu lokasi target \(s_0\), kita cari satu titik pengamatan terdekat \(s_{(1)}\), lalu nilai prediksinya langsung diambil dari titik itu:
\[ \hat{Z}(s_0) = Z\big(s_{(1)}\big). \]
Dengan kata lain, titik yang paling dekat “memenangkan” wilayahnya. Secara geometris, seluruh ruang terbagi menjadi poligon-poligon yang disebut Voronoi cells — setiap sel mencakup semua lokasi yang lebih dekat ke satu titik pengamatan dibandingkan ke titik lain.
Contoh Manual
Misalkan kita punya tiga titik pengamatan suhu udara (°C):
| Lokasi | Koordinat (x, y) | Nilai Z |
|---|---|---|
| A | (0, 0) | 28 |
| B | (2, 0) | 30 |
| C | (0, 3) | 25 |
Kita ingin memperkirakan suhu di titik baru \(s_0 = (1, 1)\).
Langkah Perhitungan
Hitung jarak Euclidean ke tiap titik:
\[ \begin{aligned} d(A, s_0) &= \sqrt{(1-0)^2 + (1-0)^2} = \sqrt{2} = 1.414, \\ d(B, s_0) &= \sqrt{(1-2)^2 + (1-0)^2} = \sqrt{2} = 1.414, \\ d(C, s_0) &= \sqrt{(1-0)^2 + (1-3)^2} = \sqrt{10} = 3.162. \end{aligned} \]
Titik A dan B sama-sama paling dekat.
Jika ada jarak sama (tie), ambil salah satu secara deterministik (misalnya yang pertama dalam urutan data), atau gunakan rata-rata dari kandidat terdekat jika ingin hasil lebih halus. Di sini kita ambil A.
Prediksi nilai di \(s_0\):
\[ \hat{Z}(s_0) = Z(A) = 28. \]
Implementasi Ringkas di R
Kode berikut mengilustrasikan perhitungan jarak, pemilihan tetangga terdekat, dan (opsional) sketsa mosaik Voronoi untuk tiga titik tersebut.
# Data titik pengamatan
pts <- data.frame(
id = c("A", "B", "C"),
x = c(0, 2, 0),
y = c(0, 0, 3),
Z = c(28, 30, 25)
)
# Titik target
s0 <- data.frame(x = 1, y = 1)
# Fungsi jarak Euclidean
edist <- function(x1, y1, x2, y2) sqrt((x1 - x2)^2 + (y1 - y2)^2)
# Hitung jarak ke setiap titik pengamatan
pts$dist_s0 <- with(pts, edist(x, y, s0$x, s0$y))
# Urutkan berdasarkan jarak
pts_ord <- pts[order(pts$dist_s0), ]
pts_ord
## id x y Z dist_s0
## 1 A 0 0 28 1.414214
## 2 B 2 0 30 1.414214
## 3 C 0 3 25 2.236068
# Ambil tetangga terdekat (tie-breaker: urutan data)
nearest <- pts_ord[1, ]
cat(sprintf("Nearest to s0=(%.1f,%.1f) is %s at distance %.3f with Z=%g\n",
s0$x, s0$y, nearest$id, nearest$dist_s0, nearest$Z))
## Nearest to s0=(1.0,1.0) is A at distance 1.414 with Z=28
Zhat <- nearest$Z
Zhat
## [1] 28
# Visualisasi Voronoi (opsional)
# Memerlukan paket deldir dan ggplot2
if (requireNamespace("deldir", quietly = TRUE) && requireNamespace("ggplot2", quietly = TRUE)) {
library(deldir)
library(ggplot2)
# Batas plot
xlim <- c(-0.5, 2.5)
ylim <- c(-0.5, 3.5)
# Delaunay/Voronoi tessellation
dd <- deldir::deldir(pts$x, pts$y, rw = c(xlim, ylim))
tiles <- deldir::tile.list(dd)
# Konversi tile ke data.frame untuk ggplot
poly_df <- do.call(rbind, lapply(seq_along(tiles), function(i) {
data.frame(
id = pts$id[i],
x = tiles[[i]]$x,
y = tiles[[i]]$y
)
}))
ggplot() +
geom_polygon(data = poly_df, aes(x = x, y = y, group = id),
fill = NA, color = "grey40") +
geom_point(data = pts, aes(x = x, y = y), size = 3) +
geom_text(data = pts, aes(x = x, y = y, label = id), vjust = -1) +
geom_point(data = s0, aes(x = x, y = y), shape = 4, size = 3, stroke = 1.2) +
coord_equal(xlim = xlim, ylim = ylim, expand = FALSE) +
labs(title = "Sketsa Voronoi untuk Nearest Neighbor",
subtitle = "Titik s0 ditandai dengan silang (×)",
x = "x", y = "y") +
theme_minimal(base_size = 12)
} else {
message("Lewati plot: paket 'deldir' dan/atau 'ggplot2' belum terpasang.")
}
Sifat, Kelebihan, dan Kelemahan
Metode ini sering dipakai untuk visualisasi cepat (misalnya Thiessen polygons pada data curah hujan) sebelum beralih ke metode berbobot seperti IDW atau Kriging.
Contoh2
# Data meuse
data(meuse, package = "sp")
coordinates(meuse) <- ~x+y
meuse <- set_crs(meuse)
meuse$z <- log(meuse$zinc)
data(meuse.grid, package = "sp")
coordinates(meuse.grid) <- ~x+y
gridded(meuse.grid) <- TRUE
proj4string(meuse.grid) <- CRS(proj4string(meuse))
# Sanity checks
stopifnot(!is.na(proj4string(meuse)), !is.na(proj4string(meuse.grid)))
# Cek ringkas
head(meuse@data[,c("zinc","copper")])
## zinc copper
## 1 1022 85
## 2 1141 81
## 3 640 68
## 4 257 81
## 5 269 48
## 6 281 61
# 1) Ambil koordinat observasi & grid (sebagai SpatialPoints)
Xobs <- coordinates(meuse)
grid_sp <- as(meuse.grid, "SpatialPoints")
# 2) Cari indeks tetangga terdekat untuk setiap titik grid
knn <- FNN::get.knnx(data = Xobs, query = coordinates(grid_sp), k = 1)
nn_ix <- knn$nn.index[,1]
# 3) Prediksi NN dan bangun SpatialPixelsDataFrame baru
pred_nn <- meuse$z[nn_ix]
stopifnot(length(pred_nn) == nrow(as.data.frame(meuse.grid)))
nn_grid <- SpatialPixelsDataFrame(points = grid_sp,
data = data.frame(z_nn = pred_nn),
proj4string = CRS(proj4string(meuse.grid)))
# 4) Plot aman — kolom 'z_nn' dijamin ada
spplot(nn_grid, "z_nn", main = "Nearest Neighbor (1-NN) — Prediksi log(Zinc)")
Metode Natural Neighbor (atau Sibson interpolation) bekerja berdasarkan Voronoi diagram juga, namun dengan gagasan yang lebih halus. Jika Nearest Neighbor (NN) hanya mengambil satu titik terdekat, Natural Neighbor mempertimbangkan beberapa titik yang “terkait” dengan lokasi baru \(s_0\).
Langkah pikirannya:
Secara konseptual:
\[ \hat{Z}(s_0) = \sum_i w_i \, Z(s_i), \quad \text{dengan } w_i \ge 0, \; \sum_i w_i = 1. \]
Bobot \(w_i\) sebanding dengan proporsi luas Voronoi yang “diambil alih” oleh \(s_0\). Karena bobot positif dan menjumlah ke 1, hasil interpolasi bersifat halus dan kontinu.
Implementasi Sibson interpolation yang eksak cukup kompleks dan jarang tersedia langsung di R. Alternatif praktis adalah TIN linear interpolation: interpolasi linier di dalam Delaunay triangulation (dual dari Voronoi).
Intinya:
Misalkan tiga titik pengamatan membentuk satu segitiga:
| Lokasi | (x, y) | Nilai Z |
|---|---|---|
| A | (0, 0) | 10 |
| B | (4, 0) | 30 |
| C | (0, 4) | 20 |
Kita ingin menghitung nilai di \(s_0 = (1, 1)\).
1) Cek posisi \(s_0\)
\(s_0\) berada di dalam segitiga ABC karena koordinatnya positif dan \(1 + 1 < 4\).
2) Luas segitiga utama (ABC)
Gunakan rumus determinan (setengah dari determinan):
\[ L_{ABC} = \tfrac{1}{2} \big| x_A(y_B - y_C) + x_B(y_C - y_A) + x_C(y_A - y_B) \big|. \]
Substitusi koordinat menghasilkan \(L_{ABC} = 8\).
3) Luas tiga sub-segitiga yang melibatkan \(s_0\)
Total luas sub-segitiga = \(4 + 2 + 2 = 8\), konsisten dengan \(L_{ABC}\).
4) Bobot barycentric
\[ w_A = \frac{L_{s_0BC}}{L_{ABC}} = \frac{4}{8} = 0.5, \quad w_B = \frac{L_{As_0C}}{L_{ABC}} = \frac{2}{8} = 0.25, \quad w_C = \frac{L_{ABs_0}}{L_{ABC}} = \frac{2}{8} = 0.25. \]
5) Interpolasi nilai
\[ \hat{Z}(s_0) = 0.5\cdot 10 + 0.25\cdot 30 + 0.25\cdot 20 = 17.5. \]
Implementasi Ringkas di R
Contoh fungsi kecil untuk menghitung bobot barycentric dan nilai interpolasi pada \(s_0\):
tri_barycentric <- function(A, B, C, s0, Z) {
area <- function(P, Q, R) 0.5 * abs(P[1]*(Q[2]-R[2]) + Q[1]*(R[2]-P[2]) + R[1]*(P[2]-Q[2]))
L_ABC <- area(A, B, C)
L_s0BC <- area(s0, B, C)
L_As0C <- area(A, s0, C)
L_ABs0 <- area(A, B, s0)
wA <- L_s0BC / L_ABC
wB <- L_As0C / L_ABC
wC <- L_ABs0 / L_ABC
Zhat <- wA*Z[1] + wB*Z[2] + wC*Z[3]
list(weights = c(A = wA, B = wB, C = wC), Zhat = Zhat,
areas = c(ABC = L_ABC, s0BC = L_s0BC, As0C = L_As0C, ABs0 = L_ABs0))
}
A <- c(0, 0); B <- c(4, 0); C <- c(0, 4)
s0 <- c(1, 1)
Z <- c(10, 30, 20) # Z_A, Z_B, Z_C
res <- tri_barycentric(A, B, C, s0, Z)
res
## $weights
## A B C
## 0.50 0.25 0.25
##
## $Zhat
## [1] 17.5
##
## $areas
## ABC s0BC As0C ABs0
## 8 4 2 2
Visualisasi Voronoi Diagram
Visualisasi berikut memperlihatkan sel Voronoi untuk titik A, B, dan C, dengan \(s_0 = (1,1)\) ditandai silang (×).
if (requireNamespace("deldir", quietly = TRUE) && requireNamespace("ggplot2", quietly = TRUE)) {
library(deldir)
library(ggplot2)
pts <- data.frame(id = c("A","B","C"), x = c(0,4,0), y = c(0,0,4))
s0 <- data.frame(x = 1, y = 1)
dd <- deldir::deldir(pts$x, pts$y, rw = c(-0.5,4.5,-0.5,4.5))
tiles <- deldir::tile.list(dd)
poly_df <- do.call(rbind, lapply(seq_along(tiles), function(i) {
data.frame(id = pts$id[i], x = tiles[[i]]$x, y = tiles[[i]]$y)
}))
ggplot() +
geom_polygon(data = poly_df, aes(x=x, y=y, group=id), fill=NA, color="grey40") +
geom_point(data = pts, aes(x=x, y=y), size=3) +
geom_text(data = pts, aes(x=x, y=y, label=id), vjust=-1) +
geom_point(data = s0, aes(x=x, y=y), shape=4, size=3, stroke=1.2) +
coord_equal(xlim=c(-0.5,4.5), ylim=c(-0.5,4.5)) +
labs(title="Voronoi Diagram untuk A(0,0), B(4,0), C(0,4)",
subtitle="Titik s0=(1,1) ditandai dengan silang (×)",
x="x", y="y") +
theme_minimal(base_size = 12)
}
Catatan: Untuk implementasi TIN skala lebih besar beserta triangulasi Delaunay, Anda dapat menggunakan paket seperti
RTriangle,geometry(fungsidelaunayn), ataudeldir(untuk Voronoi/Delaunay 2D), lalu menerapkan interpolasi linier di dalam setiap segitiga.
Contoh 2
Xobs <- coordinates(meuse)
xg <- sort(unique(meuse.grid@coords[,1]))
yg <- sort(unique(meuse.grid@coords[,2]))
tin_out <- interp::interp(x = Xobs[,1], y = Xobs[,2], z = meuse$z,
xo = xg, yo = yg, duplicate = "mean", linear = TRUE)
zmat <- tin_out$z
grd <- expand.grid(x = tin_out$x, y = tin_out$y)
tin_sgdf <- SpatialPixelsDataFrame(points = SpatialPoints(grd),
data = data.frame(z_tin = as.vector(zmat)),
tolerance = 0.5)
proj4string(tin_sgdf) <- CRS(proj4string(meuse))
spplot(tin_sgdf, "z_tin", main = "TIN (Linear) — Perkiraan log(Zinc)")
xg <- sort(unique(meuse.grid@coords[,1]))
yg <- sort(unique(meuse.grid@coords[,2]))
tin_out <- interp::interp(x = Xobs[,1], y = Xobs[,2], z = meuse$z,
xo = xg, yo = yg, duplicate = "mean", linear = TRUE)
zmat <- tin_out$z
grd <- expand.grid(x = tin_out$x, y = tin_out$y)
tin_sgdf <- SpatialPixelsDataFrame(points = SpatialPoints(grd),
data = data.frame(z_tin = as.vector(zmat)),
tolerance = 0.5)
proj4string(tin_sgdf) <- CRS(proj4string(meuse))
spplot(tin_sgdf["z_tin"], main = "TIN (Linear Barycentric) — Perkiraan log(Zinc)")
Inverse Distance Weighting (IDW) adalah metode interpolasi deterministik yang memperkirakan nilai di lokasi target \(s_0\) sebagai rata-rata tertimbang dari nilai-nilai di titik pengamatan \(s_i\), dengan bobot menurun terhadap jarak.
\[ w_i(s_0) \propto d(s_0, s_i)^{-p}, \qquad p > 0, \]
\[ \hat{Z}(s_0) = \frac{\sum_i w_i(s_0)\, Z(s_i)}{\sum_i w_i(s_0)}. \]
Umumnya kita gunakan jarak Euclidean \(d(\cdot,\cdot)\). Parameter power \(p\) mengontrol tingkat pengaruh jarak: makin besar \(p\), makin tajam penurunan bobot.
Sifat & Intuisi Parameter \(p\)
IDW tidak memerlukan variogram dan tidak memodelkan struktur kovariansi. Ia lokal, cepat, dan deterministik; namun tidak optimal secara statistik (tidak BLUE seperti kriging ketika asumsi terpenuhi).
Kebijakan Tetangga (Neighborhood)
Catatan tepi (edge cases): - Jika ada titik tepat di \(s_0\) (\(d=0\)), definisikan \(\hat{Z}(s_0) = Z(s_i)\) untuk menghindari pembagian nol. - Titik duplikat/kolokasi sebaiknya diagregasi (mis. rata-rata) atau ditangani sebagai pengamatan terpisah dengan jarak \(>0\) sangat kecil. - Anisotropi bisa dicapai dengan metrik jarak berbobot/ter-skala (mis. skala sumbu x,y berbeda) atau rotasi sumbu.
Contoh Manual (Data Segitiga)
Tiga titik pengamatan:
| Lokasi | (x, y) | Z |
|---|---|---|
| A | (0, 0) | 10 |
| B | (4, 0) | 30 |
| C | (0, 4) | 20 |
Target: \(s_0 = (1, 1)\). Jarak Euclidean:
\[ d(A,s_0)=\sqrt{2}=1.4142,\quad d(B,s_0)=d(C,s_0)=\sqrt{10}=3.1623. \]
Perhitungan untuk \(p=2\) Bobot tak ternormalisasi: \(w_A=1/2=0.5,\; w_B=w_C=1/10=0.1\). Total = 0.7. Bobot normalisasi: \(w_A=0.7143,\; w_B=0.1429,\; w_C=0.1429\).
\[ \hat{Z}(s_0)=0.7143\cdot 10 + 0.1429\cdot 30 + 0.1429\cdot 20 = 7.143 + 4.286 + 2.857 \approx 14.29. \]
Perhitungan untuk \(p=1\)
Bobot tak ternormalisasi: \(w_A=1/1.4142=0.7071,\; w_B=w_C=1/3.1623=0.3162\). Total = 1.3395. Bobot normalisasi: \(w_A=0.528,\; w_B=0.236,\; w_C=0.236\).
\[ \hat{Z}(s_0)=0.528\cdot 10 + 0.236\cdot 30 + 0.236\cdot 20 = 5.28 + 7.08 + 4.72 = 17.08. \]
Terlihat: semakin besar \(p\), prediksi makin “menempel” pada titik terdekat (A), sehingga turun dari 17.08 (\(p=1\)) menjadi 14.29 (\(p=2\)).
Implementasi Ringkas di R
Fungsi IDW sederhana (dengan pilihan \(k\) tetangga terdekat dan penanganan \(d=0\)):
# x,y: koordinat pengamatan; z: nilai; x0,y0: target; p: power; k: k-NN (opsional)
idw_predict <- function(x, y, z, x0, y0, p = 2, k = NULL) {
d <- sqrt((x - x0)^2 + (y - y0)^2)
# Jika ada titik tepat di lokasi target
if (any(d == 0)) return(z[which.min(d)])
# Pilih k-NN jika diminta
if (!is.null(k) && k < length(d)) {
idx <- order(d)[1:k]
d <- d[idx]; z <- z[idx]
}
w <- 1 / (d^p)
sum(w * z) / sum(w)
}
# Contoh data
df <- data.frame(id = c("A","B","C"), x = c(0,4,0), y = c(0,0,4), z = c(10,30,20))
# Prediksi di s0 = (1,1)
idw_p2 <- idw_predict(df$x, df$y, df$z, 1, 1, p = 2)
idw_p1 <- idw_predict(df$x, df$y, df$z, 1, 1, p = 1)
c(p2 = idw_p2, p1 = idw_p1)
## p2 p1
## 14.28571 17.08204
Peta Permukaan IDW (Grid) — Visualisasi
Contoh kecil membuat permukaan IDW pada grid, lalu divisualisasikan.
library(ggplot2)
# Grid
xg <- seq(-0.5, 4.5, by = 0.1)
yg <- seq(-0.5, 4.5, by = 0.1)
G <- expand.grid(x = xg, y = yg)
# Prediksi untuk dua nilai p
G$z_p2 <- mapply(function(x0, y0) idw_predict(df$x, df$y, df$z, x0, y0, p = 2), G$x, G$y)
G$z_p1 <- mapply(function(x0, y0) idw_predict(df$x, df$y, df$z, x0, y0, p = 1), G$x, G$y)
# Plot p=2 (lebih menempel ke titik terdekat)
plt2 <- ggplot(G, aes(x, y, fill = z_p2)) +
geom_raster(interpolate = TRUE) +
geom_contour(aes(z = z_p2), color = "white", alpha = 0.6) +
geom_point(data = df, aes(x, y), inherit.aes = FALSE, size = 2) +
geom_text(data = df, aes(x, y, label = id), inherit.aes = FALSE, vjust = -1) +
coord_equal(xlim = c(-0.5, 4.5), ylim = c(-0.5, 4.5)) +
labs(title = "Permukaan IDW (p = 2)", x = "x", y = "y", fill = "Ẑ") +
theme_minimal(base_size = 12)
# Plot p=1 (lebih halus)
plt1 <- ggplot(G, aes(x, y, fill = z_p1)) +
geom_raster(interpolate = TRUE) +
geom_contour(aes(z = z_p1), color = "white", alpha = 0.6) +
geom_point(data = df, aes(x, y), inherit.aes = FALSE, size = 2) +
geom_text(data = df, aes(x, y, label = id), inherit.aes = FALSE, vjust = -1) +
coord_equal(xlim = c(-0.5, 4.5), ylim = c(-0.5, 4.5)) +
labs(title = "Permukaan IDW (p = 1)", x = "x", y = "y", fill = "Ẑ") +
theme_minimal(base_size = 12)
plt1
plt2
Diskusi Singkat: IDW vs NN vs Kriging
Praktik: mulai dengan IDW untuk baseline cepat; cek sensitivitas terhadap \(p\), \(k\), dan radius; jika pola spasial kuat dan data cukup, pertimbangkan kriging.
idw_p2 <- idw(z ~ 1, meuse, meuse.grid, idp = 2)
## [inverse distance weighted interpolation]
spplot(idw_p2["var1.pred"], main = "IDW (p=2) — Prediksi log(Zinc)")
Trend Surface Analysis (TSA) atau Polynomial Regression Surface adalah pendekatan global interpolation yang merepresentasikan variasi spasial suatu variabel (misalnya ketinggian, suhu, curah hujan) menggunakan fungsi polinomial terhadap koordinat spasial \(x\) dan \(y\):
\[ Z(x, y) = \beta_0 + \beta_1 x + \beta_2 y + \beta_3 x^2 + \beta_4 xy + \beta_5 y^2 + \cdots + \varepsilon. \]
Semakin tinggi orde polinomialnya, semakin kompleks bentuk permukaan yang bisa diwakili (misal gelombang, lengkungan, atau gradien kompleks).
Intuisi & Tujuan
Model Polinomial
1) Polinomial orde-1 (Linear) \[ Z(x, y) = \beta_0 + \beta_1 x + \beta_2 y + \varepsilon. \] Menunjukkan permukaan bidang miring (gradien konstan).
2) Polinomial orde-2 (Kuadratik) \[ Z(x, y) = \beta_0 + \beta_1 x + \beta_2 y + \beta_3 x^2 + \beta_4 xy + \beta_5 y^2 + \varepsilon. \] Menunjukkan permukaan paraboloid (melengkung); bisa menangkap cekungan, punggungan, atau lembah.
3) Polinomial orde-n (umum) \[ Z(x, y) = \sum_{i=0}^{n}\sum_{j=0}^{n-i} \beta_{ij} x^i y^j + \varepsilon. \] Makin tinggi orde, makin fleksibel, tetapi risiko overfitting juga meningkat.
Estimasi Parameter
Parameter \(\beta\) diestimasi menggunakan Ordinary Least Squares (OLS):
\[ \hat{\boldsymbol{\beta}} = (X^T X)^{-1} X^T Z, \]
Contoh Manual
Misalkan terdapat 4 titik pengamatan:
| Lokasi | x | y | Z |
|---|---|---|---|
| A | 0 | 0 | 10 |
| B | 1 | 0 | 15 |
| C | 0 | 1 | 12 |
| D | 1 | 1 | 20 |
Kita gunakan trend surface linear (orde-1): \[ Z = \beta_0 + \beta_1 x + \beta_2 y. \]
Bentuk matriksnya: \[ \begin{bmatrix} 10 \\ 15 \\ 12 \\ 20 \end{bmatrix} = \begin{bmatrix} 1 & 0 & 0 \\ 1 & 1 & 0 \\ 1 & 0 & 1 \\ 1 & 1 & 1 \end{bmatrix} \begin{bmatrix} \beta_0 \\ \beta_1 \\ \beta_2 \end{bmatrix}. \]
Kesimpulan: Trend surface membentuk fondasi bagi pendekatan universal kriging,
df_obs <- cbind(as.data.frame(meuse), x = coordinates(meuse)[,1], y = coordinates(meuse)[,2])
fit_trend <- lm(z ~ poly(x,2,raw=TRUE) + poly(y,2,raw=TRUE) + I(x*y), data = df_obs)
df_grd <- cbind(as.data.frame(meuse.grid), x = coordinates(meuse.grid)[,1], y = coordinates(meuse.grid)[,2])
pred_trend <- predict(fit_trend, newdata = df_grd)
trend_grid <- meuse.grid
trend_grid$z_trend <- pred_trend
spplot(trend_grid, "z_trend", main = "Trend Surface (Quadratic) — Prediksi log(Zinc)")
Thin Plate Splines (TPS) adalah metode interpolasi smooth surface yang meminimalkan kelengkungan total permukaan — analogi matematisnya seperti membengkokkan lembaran logam tipis yang melewati semua titik data dengan gaya minimum.
TPS mencari fungsi \(f(x, y)\) yang:
\[ J(f) = \iint \left[ \left(\frac{\partial^2 f}{\partial x^2}\right)^2 + 2\left(\frac{\partial^2 f}{\partial x \partial y}\right)^2 + \left(\frac{\partial^2 f}{\partial y^2}\right)^2 \right] dx\,dy. \]
Model Matematis
TPS dapat ditulis dalam bentuk:
\[ f(x, y) = a_0 + a_1 x + a_2 y + \sum_{i=1}^N w_i U(r_i), \]
dengan:
\[ U(r_i) = r_i^2 \log(r_i), \quad r_i = \sqrt{(x - x_i)^2 + (y - y_i)^2}. \]
Koefisien \(a_0, a_1, a_2, w_i\) diperoleh dengan menyelesaikan sistem persamaan linear yang meminimalkan bending energy sambil tetap memenuhi constraint interpolasi \(f(x_i, y_i) = z_i\).
Intuisi
TPS termasuk dalam kelas Radial Basis Function (RBF) interpolators, dengan basis kernel \(\phi(r) = r^2\log(r)\).
Implementasi di R
R menyediakan fungsi Tps() dari paket
fields atau interp::interp() untuk TPS.
Contoh berikut menggunakan paket fields.
if (requireNamespace("fields", quietly = TRUE)) {
library(fields)
# Data contoh
set.seed(123)
x <- runif(10, 0, 1)
y <- runif(10, 0, 1)
z <- 5 + 2*x + 3*y + rnorm(10, 0, 0.2)
# Fit TPS model
tps_model <- fields::Tps(cbind(x, y), z)
summary(tps_model)
# Prediksi grid
grid <- expand.grid(x = seq(0, 1, length.out = 50), y = seq(0, 1, length.out = 50))
grid$z_hat <- predict(tps_model, grid)
# Visualisasi
library(ggplot2)
ggplot(grid, aes(x, y, fill = z_hat)) +
geom_raster(interpolate = TRUE) +
geom_point(data = data.frame(x = x, y = y),
mapping = aes(x = x, y = y),
inherit.aes = FALSE, size = 2, color = "black") +
geom_text(data = data.frame(x = x, y = y, z = z),
mapping = aes(x = x, y = y, label = round(z, 1)),
inherit.aes = FALSE, vjust = -1) +
scale_fill_viridis_c() +
coord_equal() +
labs(title = "Interpolasi Thin Plate Splines (TPS)", fill = "Ẑ") +
theme_minimal(base_size = 12)
}
Parameter Smoothing (λ)
TPS juga mendukung versi smoothing spline, dengan parameter \(\lambda\) yang menyeimbangkan fit dan smoothness:
\[ \text{Minimize } \sum_i [z_i - f(x_i, y_i)]^2 + \lambda J(f). \]
Parameter \(\lambda\) sering dipilih
dengan Generalized Cross Validation (GCV) otomatis di
fungsi Tps().
Contoh Smoothing TPS
if (requireNamespace("fields", quietly = TRUE)) {
library(ggplot2)
# Pastikan grid, x, y, z tersedia; jika 'grid' sudah berisi kolom lain (mis. z_hat),
# gunakan hanya koordinat x,y saat memanggil predict.
if (!exists("x") || !exists("y") || !exists("z")) {
set.seed(123)
x <- runif(10, 0, 1); y <- runif(10, 0, 1); z <- 5 + 2*x + 3*y + rnorm(10, 0, 0.2)
}
if (!exists("grid")) {
grid <- expand.grid(x = seq(0, 1, length.out = 50), y = seq(0, 1, length.out = 50))
}
tps_smooth <- fields::Tps(cbind(x, y), z, lambda = 0.1)
coords <- grid[, c("x", "y")] # <- hanya kolom koordinat
grid$z_smooth <- predict(tps_smooth, coords)
ggplot(grid, aes(x, y, fill = z_smooth)) +
geom_raster(interpolate = TRUE) +
geom_point(data = data.frame(x = x, y = y),
mapping = aes(x = x, y = y),
inherit.aes = FALSE, size = 2, color = 'black') +
coord_equal() +
scale_fill_viridis_c() +
labs(title = "Thin Plate Splines dengan λ = 0.1 (Smoothed)", fill = "Ẑ") +
theme_minimal(base_size = 12)
}
Kelebihan & Keterbatasan
| Aspek | Penjelasan |
|---|---|
| Kelebihan | Permukaan sangat halus (hingga turunan kedua); tidak perlu parameter jarak atau tetangga; cocok untuk permukaan kontinyu. |
| Keterbatasan | Komputasi mahal untuk data besar (O(N³)); sulit mengatur anisotropy; hasil bisa oversmooth untuk gradien tajam. |
Hubungan dengan Metode Lain
# Aktifkan bila paket fields tersedia: install.packages("fields")
library(fields)
X <- coordinates(meuse)
tps_fit <- fields::Tps(X, meuse$z) # smoothing via GCV
pred_tps <- predict(tps_fit, coordinates(as(meuse.grid, "SpatialPoints")))
tps_grid <- meuse.grid
tps_grid$z_tps <- as.numeric(pred_tps)
spplot(tps_grid, "z_tps", main = "Thin Plate Splines (fields::Tps) — Prediksi log(Zinc)")
Kriging adalah metode spatial interpolation berbasis teori proses stokastik yang mencari penduga linier tak bias dengan variansi minimum (BLUE) untuk nilai suatu peubah spasial \(Z(s)\) pada lokasi yang belum diobservasi \(s_0\). Intuisi singkatnya: gunakan tetangga yang informatif—dengan bobot optimal berbasis struktur autokorelasi—untuk menebak nilai di lokasi target.
Secara umum, penduga Kriging ditulis: \[ \hat{Z}(s_0) = \sum_{i=1}^n \lambda_i Z(s_i), \] dengan bobot \(\lambda_i\) dipilih agar tak bias dan meminimalkan varian galat prediksi.
Kekuatan Kriging ada pada variogram/kovarians: informasi jarak dan arah memengaruhi seberapa besar kontribusi tetangga terhadap prediksi.
Data spasial adalah realisasi dari suatu bidang acak \(Z(s)\), \(s \in \mathbb{R}^2\). Untuk dua lokasi \(s_i, s_j\), kovarians didefinisikan \[ \operatorname{Cov}[Z(s_i), Z(s_j)] = C(h), \quad h = s_i - s_j. \]
Variogram mengukur ketidaksamaan rata-rata kuadrat pada jarak \(h\): \[ \gamma(h) = \tfrac{1}{2}\operatorname{Var}[Z(s) - Z(s+h)]. \] Untuk proses stasioner orde-2, relasi dengan kovarians: \[ \gamma(h) = C(0) - C(h). \]
Tuliskan \(Z(s) = \mu(s) + \varepsilon(s)\) dengan \(E[\varepsilon(s)]=0\).
Untuk OK, syarat tak bias: \(\sum_i \lambda_i = 1\), diberlakukan via pengali Lagrange \(\mu\): \[ \begin{bmatrix} \Sigma & \mathbf{1} \\\\ \mathbf{1}^\top & 0 \end{bmatrix} \begin{bmatrix} \lambda \\\\ \mu \end{bmatrix} = \begin{bmatrix} \sigma_0 \\\\ 1 \end{bmatrix}, \quad \sigma_K^2(s_0) = C(0) - 2\lambda^\top \sigma_0 + \lambda^\top \Sigma \lambda. \] Di mana \(\Sigma_{ij}=C(s_i-s_j)\), \(\sigma_{0,i}=C(s_i-s_0)\). Dalam bentuk variogram gunakan \(C(0)-C(h)=\gamma(h)\).
Bagian ini memberikan contoh perhitungan manual Ordinary
Kriging dengan dataset kecil (3 titik), lalu
memverifikasi hasilnya menggunakan paket
gstat di R.
Data & Target
Tiga titik pengamatan \(Z\) dan satu lokasi target \(s_0=(1,1)\):
| Titik | x | y | Z |
|---|---|---|---|
| A | 0 | 0 | 10 |
| B | 2 | 0 | 20 |
| C | 0 | 2 | 30 |
Target: \(s_0 = (1,1)\).
Gunakan spherical variogram dengan parameter: - Nugget \(c_0=0\) - Sill parsial \(c=1\) - Range \(a=2\)
Bentuk fungsi variogram: \[ \gamma(h) = \begin{cases} c_0 + c\left[\tfrac{3h}{2a} - \tfrac{1}{2}\left(\tfrac{h}{a}\right)^3\right], & h \le a, \\ c_0 + c, & h > a. \end{cases} \]
Perhitungan Manual
1) Jarak antar titik & ke target
A <- c(0,0); B <- c(2,0); C <- c(0,2); s0 <- c(1,1)
edist <- function(p,q) sqrt(sum((p-q)^2))
h_AB <- edist(A,B)
h_AC <- edist(A,C)
h_BC <- edist(B,C)
h_As0 <- edist(A,s0)
h_Bs0 <- edist(B,s0)
h_Cs0 <- edist(C,s0)
c(h_AB=h_AB, h_AC=h_AC, h_BC=h_BC, h_As0=h_As0, h_Bs0=h_Bs0, h_Cs0=h_Cs0)
## h_AB h_AC h_BC h_As0 h_Bs0 h_Cs0
## 2.000000 2.000000 2.828427 1.414214 1.414214 1.414214
Hasil: \(h_{AB}=h_{AC}=2\); \(h_{BC}=2.828\); \(h_{A,s_0}=h_{B,s_0}=h_{C,s_0}=1.414\).
2) Fungsi variogram \(\gamma(h)\)
# Spherical variogram with c0=0, c=1, a=2
vgm_sph <- function(h, c0=0, c=1, a=2) {
out <- ifelse(h <= a, c0 + c*(1.5*(h/a) - 0.5*(h/a)^3), c0 + c)
as.numeric(out)
}
c(g_2 = vgm_sph(2), g_2_828 = vgm_sph(sqrt(8)), g_1_414 = vgm_sph(sqrt(2)))
## g_2 g_2_828 g_1_414
## 1.0000000 1.0000000 0.8838835
Untuk \(h=1.414\): \(\gamma \approx 1.038\); untuk \(h\ge a\), \(\gamma=1\).
3) Sistem Persamaan Kriging (Ordinary)
Sistem OK untuk 3 titik:
\[ \begin{bmatrix} 0 & \gamma_{AB} & \gamma_{AC} & 1 \\ \gamma_{BA} & 0 & \gamma_{BC} & 1 \\ \gamma_{CA} & \gamma_{CB} & 0 & 1 \\ 1 & 1 & 1 & 0 \end{bmatrix} \begin{bmatrix} \lambda_A \\ \lambda_B \\ \lambda_C \\ \mu \end{bmatrix} = \begin{bmatrix} \gamma_{A,s_0} \\ \gamma_{B,s_0} \\ \gamma_{C,s_0} \\ 1 \end{bmatrix}. \]
Dengan \(\gamma_{AB}=\gamma_{AC}=1\), \(\gamma_{BC}=1\), dan \(\gamma_{A,s_0}=\gamma_{B,s_0}=\gamma_{C,s_0}=1.038\).
G <- matrix(c(
0, 1, 1, 1,
1, 0, 1, 1,
1, 1, 0, 1,
1, 1, 1, 0
), nrow=4, byrow=TRUE)
rhs <- c(1.038, 1.038, 1.038, 1)
sol <- solve(G, rhs)
sol
## [1] 0.3333333 0.3333333 0.3333333 0.3713333
Komponen solusi: \(\lambda_A, \lambda_B, \lambda_C, \mu\). Periksa penjumlahan bobot = 1.
lambda <- sol[1:3]; mu <- sol[4]
sum_lambda <- sum(lambda)
Z <- c(A=10, B=20, C=30)
Zhat <- sum(lambda * Z)
list(weights=lambda, sum_lambda=sum_lambda, Zhat=Zhat, mu=mu)
## $weights
## [1] 0.3333333 0.3333333 0.3333333
##
## $sum_lambda
## [1] 1
##
## $Zhat
## [1] 20
##
## $mu
## [1] 0.3713333
Hasil manual: \(\lambda_A=\lambda_B=\lambda_C=1/3\), \(\hat Z(s_0)=20\).
\[ \sigma_k^2 = \sum_i \lambda_i\, \gamma(s_i, s_0) + \mu. \]
g_As0 <- vgm_sph(sqrt(2))
var_krig <- sum(lambda * c(g_As0, g_As0, g_As0)) + mu
var_krig
## [1] 1.255217
Varian kriging \(\approx 1.41\).
Verifikasi dengan gstat
library(sp)
library(gstat)
# Observasi sebagai SpatialPointsDataFrame
df <- data.frame(x=c(0,2,0), y=c(0,0,2), Z=c(10,20,30))
coordinates(df) <- ~x+y
# Lokasi prediksi (s0)
newd <- data.frame(x=1, y=1)
coordinates(newd) <- ~x+y
# Variogram model: Spherical, psill=1, range=2, nugget=0
vgm_model <- vgm(psill=1, model="Sph", range=2, nugget=0)
# Ordinary kriging
ok <- gstat(formula = Z~1, data=df, model=vgm_model)
kr <- predict(ok, newd, nsim=0)
## [using ordinary kriging]
kr
## class : SpatialPointsDataFrame
## features : 1
## extent : 1, 1, 1, 1 (xmin, xmax, ymin, ymax)
## crs : NA
## variables : 2
## names : var1.pred, var1.var
## value : 20, 1.1011002862997
Kolom var1.pred adalah \(\hat
Z(s_0)\) dan var1.var adalah varian kriging. Nilai
seharusnya sangat dekat dengan hasil manual (20 dan ~1.41).
Peta Permukaan Prediksi & Varian
# Grid untuk peta
xg <- seq(-0.5, 2.5, by=0.05)
yg <- seq(-0.5, 2.5, by=0.05)
newgrid <- expand.grid(x=xg, y=yg)
coordinates(newgrid) <- ~x+y
krg <- predict(ok, newgrid)
## [using ordinary kriging]
kr_df <- as.data.frame(krg)
library(ggplot2)
p1 <- ggplot(kr_df, aes(x, y, fill = var1.pred)) +
geom_raster(interpolate = TRUE) +
geom_contour(aes(z = var1.pred), color = "white", alpha = 0.6) +
geom_point(data = as.data.frame(df), aes(x, y), inherit.aes = FALSE, size = 2) +
coord_equal() +
labs(title = "Ordinary Kriging — Prediksi", fill = "Ẑ") +
theme_minimal(base_size = 12)
p2 <- ggplot(kr_df, aes(x, y, fill = var1.var)) +
geom_raster(interpolate = TRUE) +
geom_contour(aes(z = var1.var), color = "white", alpha = 0.6) +
geom_point(data = as.data.frame(df), aes(x, y), inherit.aes = FALSE, size = 2) +
coord_equal() +
labs(title = "Ordinary Kriging — Varian Prediksi", fill = "Var") +
theme_minimal(base_size = 12)
p1
p2
Catatan Praktis
sp + gstat# Fungsi bantu: set CRS aman ke EPSG:28992 (Amersfoort / RD New)
set_crs <- function(obj){
ok <- TRUE
tryCatch({
proj4string(obj) <- CRS("+init=epsg:28992")
}, error = function(e) ok <<- FALSE)
if(!ok){
proj4string(obj) <- CRS(SRS_string = "EPSG:28992")
}
obj
}
# Data meuse
data(meuse, package = "sp")
coordinates(meuse) <- ~x+y
meuse <- set_crs(meuse)
# Grid prediksi
data(meuse.grid, package = "sp")
coordinates(meuse.grid) <- ~x+y
gridded(meuse.grid) <- TRUE
proj4string(meuse.grid) <- CRS(proj4string(meuse)) # samakan CRS
# Cek ringkas
head(meuse@data[,c("zinc","copper")])
## zinc copper
## 1 1022 85
## 2 1141 81
## 3 640 68
## 4 257 81
## 5 269 48
## 6 281 61
v.emp <- variogram(log(zinc) ~ 1, meuse)
plot(v.emp, main = "Variogram Empirik log(Zinc)")
# Fit model Spherical (tebakan awal; silakan eksplorasi model lain)
v.fit <- fit.variogram(v.emp, vgm(psill = 1, model = "Sph", range = 900, nugget = 1))
v.fit
## model psill range
## 1 Nug 0.05066243 0.0000
## 2 Sph 0.59060780 897.0209
plot(v.emp, v.fit, main = "Fitting Variogram: Spherical")
ok <- krige(log(zinc) ~ 1, meuse, meuse.grid, model = v.fit)
## [using ordinary kriging]
spplot(ok["var1.pred"], main = "Prediksi log(Zinc) — Ordinary Kriging")
spplot(ok["var1.var"], main = "Kriging Variance — Ordinary Kriging")
set.seed(1)
cv <- krige.cv(log(zinc) ~ 1, meuse, model = v.fit, nfold = 10)
summary(cv$residual)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.927351 -0.209674 -0.007915 0.013349 0.212593 1.373407
ggplot(cv@data, aes(x = observed, y = var1.pred)) +
geom_point() +
geom_abline(slope = 1, intercept = 0, linetype = "dashed") +
labs(x = "Observed log(Zinc)", y = "Predicted", title = "10-fold Cross-Validation (OK)")
Jika ada tren global, mis. \(\mu(s)=\beta_0+\beta_1 x + \beta_2 y\).
uk <- krige(log(zinc) ~ x + y, meuse, meuse.grid, model = v.fit)
## [using universal kriging]
spplot(uk["var1.pred"], main = "Universal Kriging (x + y) — Prediksi log(Zinc)")
Tips praktis: tambahkan polinomial atau kovariat lain (jarak ke sungai, elevasi) bila relevan.
Kita punya peubah target \(Z_1\) (zinc) dan peubah sekunder \(Z_2\) (copper) yang berkorelasi spasial. Bangun LMC yang memodelkan variogram masing-masing dan cross-variogram.
# Definisikan dua proses
gs <- gstat(NULL, id = "zinc", formula = log(zinc) ~ 1, data = meuse)
gs <- gstat(gs, id = "copper", formula = log(copper) ~ 1, data = meuse)
# Variogram & cross-variogram
v.cross <- variogram(gs)
plot(v.cross, main = "Variogram & Cross-Variogram (zinc, copper)")
# Fit LMC (seed Spherical)
vm <- vgm(psill = 1, model = "Sph", range = 900, nugget = 1)
lmc.fit <- fit.lmc(v.cross, gs, model = vm)
plot(v.cross, lmc.fit, main = "Fitting LMC (Spherical seed)")
# Prediksi co-kriging pada grid
ck.pred <- predict(lmc.fit, meuse.grid) # kolom: zinc.pred, copper.pred, dst.
## Linear Model of Coregionalization found. Good.
## [using ordinary cokriging]
spplot(ck.pred["zinc.pred"], main = "Prediksi Zinc — Co-Kriging")
Catatan: Co-Kriging efektif bila peubah sekunder informatif (korelasi spasial & cross variogram jelas), serta tersedia dengan cakupan spasial baik.
Untuk \(Z(s,t)\), gunakan \(C(h,u)\) dengan lag ruang \(h\) dan waktu \(u\). Model separabel: \(C(h,u)=C_s(h)C_t(u)\). Implementasi dapat
memakai gstat (variogram spatio-temporal) atau pendekatan
Bayesian (INLA) dengan efek acak ruang–waktu.
SPDE mengaitkan GRF kontinu dan GMRF pada mesh triangulasi melalui \[ (\kappa^2 - \Delta)^{\alpha/2} x(s) = W(s). \] Keuntungan: komputasi efisien (matriks presisi sparse) dan inferensi probabilistik penuh.
eval=FALSE)suppressPackageStartupMessages(library(INLA))
# Mesh
mesh <- inla.mesh.2d(loc = coordinates(meuse), max.edge = c(200, 400))
plot(mesh); points(meuse, col = "red", pch = 19)
# SPDE Matérn dengan prior PC
spde <- inla.spde2.pcmatern(
mesh, alpha = 2,
prior.range = c(1000, 0.5), # P(range < 1000) = 0.5
prior.sigma = c(1, 0.01) # P(sigma > 1) = 0.01
)
# Index & proyeksi
iset <- inla.spde.make.index("spatial", n.spde = spde$n.spde)
A <- inla.spde.make.A(mesh, loc = coordinates(meuse))
# Stack
stk <- inla.stack(
data = list(y = log(meuse$zinc)),
A = list(A, 1),
effects = list(iset, data.frame(Intercept = 1)),
tag = "est"
)
# Fitting
formula <- y ~ 1 + f(spatial, model = spde)
res <- inla(
formula,
data = inla.stack.data(stk),
family = "gaussian",
control.predictor = list(A = inla.stack.A(stk), compute = TRUE),
control.compute = list(dic = TRUE, waic = TRUE, cpo = TRUE)
)
summary(res)
# Posterior mean pada mesh
mean.field <- res$summary.random$spatial$mean
plot(mesh, main = "Posterior Mean Field (SPDE)"); points(meuse, pch = 20, cex = .5)
Rangkuman: Variogram adalah jantung Kriging; OK/UK menangani mean lokal vs tren; Co-Kriging memanfaatkan peubah sekunder; SPDE memberi skala besar dan ketidakpastian penuh.
Latihan:
meuse?lead,
cadmium) untuk Co-Kriging; bandingkan peta.Berikut perbandingan ringkas beberapa metode interpolasi spasial yang umum digunakan, termasuk Kriging sebagai pendekatan berbasis model stokastik yang paling kuat secara statistik.
Kelebihan:
- Super cepat dan mudah diimplementasikan.
- Cocok untuk baseline awal atau data dengan sebaran sangat
jarang.
Keterbatasan:
- Hasilnya “bloky” (diskontinu di batas Voronoi).
- Tidak menangkap transisi spasial yang halus.
Kelebihan:
- Menghasilkan permukaan halus di dalam setiap segitiga Delaunay.
- Konservatif: tidak memprediksi di luar convex hull data.
Keterbatasan:
- Sensitif terhadap kualitas dan distribusi triangulasi.
- Sulit diterapkan jika data sangat tidak merata.
Kelebihan:
- Intuitif, parameter sederhana (pangkat jarak \(p\)).
- Memberikan hasil halus tanpa perlu model variogram.
Keterbatasan:
- Tidak menyediakan varian prediksi (ketidakpastian).
- Sensitif terhadap nilai ekstrem di sekitar lokasi target.
- Tidak mempertimbangkan struktur autokorelasi spasial.
Kelebihan:
- Mudah dan cepat untuk menangkap pola global (misal gradien
timur–barat).
- Cocok untuk fenomena dengan variasi deterministik besar.
Keterbatasan:
- Mengabaikan autokorelasi residu.
- Tidak cocok untuk pola lokal yang kompleks.
Kelebihan:
- Sangat halus dan fleksibel; parameter halus (\(\lambda\)) dapat dipilih otomatis lewat
GCV.
- Cocok untuk fenomena kontinu dan permukaan lembut.
Keterbatasan:
- Tidak menyediakan peta ketidakpastian.
- Dapat over-smooth jika \(\lambda\) tidak diatur dengan tepat.
- Komputasi cukup berat untuk dataset besar.
Kelebihan:
- Penduga linier tak bias terbaik (BLUE).
- Mempertimbangkan struktur autokorelasi melalui
variogram/kovarians.
- Menghasilkan peta prediksi dan peta ketidakpastian
(varian) secara bersamaan.
- Dapat diperluas menjadi Co-Kriging, Universal Kriging, maupun Kriging
spasio-temporal.
Keterbatasan:
- Membutuhkan pemodelan variogram yang tepat dan validasi model.
- Asumsi stasioneritas sering sulit terpenuhi.
- Komputasi intensif untuk data besar (meskipun dapat diatasi dengan
pendekatan Bayesian/INLA-SPDE).
| Metode | Sifat | Keunggulan | Keterbatasan |
|---|---|---|---|
| NN | Non-parametrik | Cepat, sederhana | Bloky, tanpa transisi halus |
| TIN | Geometrik | Halus dalam segitiga | Sensitif terhadap triangulasi |
| IDW | Deterministik | Intuitif, parameter sederhana | Tidak ada varian prediksi |
| Trend | Regresi | Menangkap pola global | Abaikan korelasi spasial |
| TPS | Smoothing | Halus, fleksibel | Tidak sediakan varian prediksi |
| Kriging | Stokastik | Optimal, sediakan ketidakpastian | Butuh variogram, berat komputasi |