Penelitian ini bertujuan untuk: 1. Menganalisis pengaruh variabel rumah ber-PHBS dan kepadatan penduduk terhadap jumlah kasus tuberkulosis (TB). 2. Mengukur sensitivitas jumlah kasus TB terhadap perubahan variabel rumah ber-PHBS dan kepadatan penduduk. 3. Mengidentifikasi faktor yang paling berpengaruh untuk mendukung upaya pengendalian TB.
library(readxl)
## Warning: package 'readxl' was built under R version 4.3.3
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.3.3
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.3.3
library(reshape2)
## Warning: package 'reshape2' was built under R version 4.3.2
# Membaca dataset
file_path <- "data krpa.xlsx"
data <- read_excel(file_path)
# Melihat struktur data
glimpse(data)
## Rows: 27
## Columns: 4
## $ Kab_Kota <chr> "KABUPATEN BOGOR", "KABUPATEN SUKABUMI", "KABUPATEN…
## $ Jumlah_Kasus <dbl> 27690, 10950, 9327, 12697, 8615, 3528, 3042, 3705, …
## $ Persentase_BerPHBS <dbl> 50.35, 61.49, 75.18, 63.07, 60.86, 44.49, 63.53, 60…
## $ Kepadatan_penduduk <dbl> 1858, 670, 698, 2154, 888, 724, 803, 1033, 2264, 10…
# Statistik deskriptif
data %>% summary()
## Kab_Kota Jumlah_Kasus Persentase_BerPHBS Kepadatan_penduduk
## Length:27 Min. : 954 Min. :41.00 Min. : 392.0
## Class :character 1st Qu.: 3916 1st Qu.:59.20 1st Qu.: 845.5
## Mode :character Median : 5607 Median :63.53 Median : 1439.0
## Mean : 7850 Mean :64.26 Mean : 3856.8
## 3rd Qu.:10652 3rd Qu.:72.42 3rd Qu.: 5836.5
## Max. :27690 Max. :83.24 Max. :15421.0
# Scatter plot hubungan antar variabel
ggplot(data, aes(x = Persentase_BerPHBS, y = Jumlah_Kasus)) +
geom_point() +
geom_smooth(method = "lm") +
labs(title = "Hubungan PHBS dengan Jumlah Kasus TB",
x = "Persentase Rumah Ber-PHBS",
y = "Jumlah Kasus TB")
## `geom_smooth()` using formula = 'y ~ x'
ggplot(data, aes(x = Kepadatan_penduduk, y = Jumlah_Kasus)) +
geom_point() +
geom_smooth(method = "lm") +
labs(title = "Hubungan Kepadatan Penduduk dengan Jumlah Kasus TB",
x = "Kepadatan Penduduk",
y = "Jumlah Kasus TB")
## `geom_smooth()` using formula = 'y ~ x'
# Membuat model regresi linier
model <- lm(Jumlah_Kasus ~ Persentase_BerPHBS + Kepadatan_penduduk, data = data)
# Ringkasan model
summary(model)
##
## Call:
## lm(formula = Jumlah_Kasus ~ Persentase_BerPHBS + Kepadatan_penduduk,
## data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6618 -3868 -1313 3437 19897
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 9295.6522 7127.4679 1.304 0.205
## Persentase_BerPHBS -41.5993 109.7084 -0.379 0.708
## Kepadatan_penduduk 0.3183 0.2572 1.238 0.228
##
## Residual standard error: 5979 on 24 degrees of freedom
## Multiple R-squared: 0.06273, Adjusted R-squared: -0.01537
## F-statistic: 0.8032 on 2 and 24 DF, p-value: 0.4596
# Simulasi sensitivitas
data_sensitivity <- data %>%
mutate(
PHBS_plus10 = Persentase_BerPHBS * 1.1,
PHBS_minus10 = Persentase_BerPHBS * 0.9,
Kepadatan_plus10 = Kepadatan_penduduk * 1.1,
Kepadatan_minus10 = Kepadatan_penduduk * 0.9
)
# Menyiapkan newdata dengan semua kolom yang dibutuhkan
sensitivity_results <- data_sensitivity %>%
mutate(
Predicted_plus_PHBS = predict(model, newdata = data_sensitivity %>% mutate(Persentase_BerPHBS = PHBS_plus10, Kepadatan_penduduk = Kepadatan_penduduk)),
Predicted_minus_PHBS = predict(model, newdata = data_sensitivity %>% mutate(Persentase_BerPHBS = PHBS_minus10, Kepadatan_penduduk = Kepadatan_penduduk)),
Predicted_plus_Kepadatan = predict(model, newdata = data_sensitivity %>% mutate(Kepadatan_penduduk = Kepadatan_plus10, Persentase_BerPHBS = Persentase_BerPHBS)),
Predicted_minus_Kepadatan = predict(model, newdata = data_sensitivity %>% mutate(Kepadatan_penduduk = Kepadatan_minus10, Persentase_BerPHBS = Persentase_BerPHBS))
)
# Menampilkan tabel hasil simulasi
sensitivity_results %>%
select(Kab_Kota, Predicted_plus_PHBS, Predicted_minus_PHBS, Predicted_plus_Kepadatan, Predicted_minus_Kepadatan) %>%
head()
## # A tibble: 6 × 5
## Kab_Kota Predicted_plus_PHBS Predicted_minus_PHBS Predicted_plus_Kepad…¹
## <chr> <dbl> <dbl> <dbl>
## 1 KABUPATEN BOG… 7583. 8002. 7852.
## 2 KABUPATEN SUK… 6695. 7207. 6972.
## 3 KABUPATEN CIA… 6078. 6703. 6413.
## 4 KABUPATEN BAN… 7095. 7620. 7426.
## 5 KABUPATEN GAR… 6793. 7300. 7075.
## 6 KABUPATEN TAS… 7490. 7860. 7698.
## # ℹ abbreviated name: ¹Predicted_plus_Kepadatan
## # ℹ 1 more variable: Predicted_minus_Kepadatan <dbl>
# Membuat grafik sensitivitas
sensitivity_melt <- sensitivity_results %>%
select(Kab_Kota, Predicted_plus_PHBS, Predicted_minus_PHBS, Predicted_plus_Kepadatan, Predicted_minus_Kepadatan) %>%
melt(id.vars = "Kab_Kota")
# Plot sensitivitas
ggplot(sensitivity_melt, aes(x = Kab_Kota, y = value, color = variable)) +
geom_point() +
labs(title = "Hasil Analisis Sensitivitas",
x = "Kabupaten/Kota",
y = "Jumlah Kasus TB (Prediksi)") +
theme(axis.text.x = element_text(angle = 90, hjust = 1))
Hasil analisis menunjukkan bahwa: - Sensitivitas jumlah kasus TB terhadap perubahan PHBS dan kepadatan penduduk terlihat signifikan dalam beberapa daerah. - Faktor yang paling berpengaruh dapat diidentifikasi lebih lanjut untuk prioritas pengendalian TB.