Pendahuluan

Dokumen ini berisi script analisis tren encounter rate dari data Google Spreadsheet. Analisis dilakukan untuk mengevaluasi dinamika aktivitas (perburuan, penggunaan kawasan, dan pembalakan) berdasarkan encounter rate dari hasil patroli.

Tujuan

Script R

# Set Working Directory
setwd("C:/Users/darma/Downloads/SMART_BKSDA/trend_analysist/CAGN")  # Menentukan folder kerja

# Cek versi R dan update packages
R.version.string   # Menampilkan versi R yang digunakan
## [1] "R version 4.5.0 (2025-04-11 ucrt)"
options(repos = c(CRAN = "https://cloud.r-project.org")) # Set CRAN mirror secara manual
update.packages(ask = FALSE, checkBuilt = TRUE)  # Update semua paket agar sesuai versi R terbaru
## Warning: package 'boot' in library 'C:/Program Files/R/R-4.5.0/library' will
## not be updated
## Warning: package 'lattice' in library 'C:/Program Files/R/R-4.5.0/library' will
## not be updated
## Warning: package 'Matrix' in library 'C:/Program Files/R/R-4.5.0/library' will
## not be updated
## Warning: package 'mgcv' in library 'C:/Program Files/R/R-4.5.0/library' will
## not be updated
## 
##   There are binary versions available but the source versions are later:
##               binary source needs_compilation
## ragg           1.4.0  1.5.0              TRUE
## robustbase  0.99-4-1 0.99-6              TRUE
## textshaping    1.0.2  1.0.3              TRUE
## xfun            0.52   0.53              TRUE
## 
##   Binaries will be installed
## package 'ragg' successfully unpacked and MD5 sums checked
## Warning: cannot remove prior installation of package 'ragg'
## Warning in file.copy(savedcopy, lib, recursive = TRUE): problem copying
## C:\Users\darma\AppData\Local\R\win-library\4.5\00LOCK\ragg\libs\x64\ragg.dll to
## C:\Users\darma\AppData\Local\R\win-library\4.5\ragg\libs\x64\ragg.dll:
## Permission denied
## Warning: restored 'ragg'
## package 'robustbase' successfully unpacked and MD5 sums checked
## package 'textshaping' successfully unpacked and MD5 sums checked
## Warning: cannot remove prior installation of package 'textshaping'
## Warning in file.copy(savedcopy, lib, recursive = TRUE): problem copying
## C:\Users\darma\AppData\Local\R\win-library\4.5\00LOCK\textshaping\libs\x64\textshaping.dll
## to
## C:\Users\darma\AppData\Local\R\win-library\4.5\textshaping\libs\x64\textshaping.dll:
## Permission denied
## Warning: restored 'textshaping'
## package 'xfun' successfully unpacked and MD5 sums checked
## Warning: cannot remove prior installation of package 'xfun'
## Warning in file.copy(savedcopy, lib, recursive = TRUE): problem copying
## C:\Users\darma\AppData\Local\R\win-library\4.5\00LOCK\xfun\libs\x64\xfun.dll to
## C:\Users\darma\AppData\Local\R\win-library\4.5\xfun\libs\x64\xfun.dll:
## Permission denied
## Warning: restored 'xfun'
## 
## The downloaded binary packages are in
##  C:\Users\darma\AppData\Local\Temp\RtmpkBaUZh\downloaded_packages
# Daftar paket yang dibutuhkan
packages <- c("googlesheets4", "dplyr", "ggplot2", "broom", "writexl", "tidyr")  # Paket utama analisis

# Fungsi untuk cek dan instal paket yang belum ada
install_if_missing <- function(pkg) {
  if (!requireNamespace(pkg, quietly = TRUE)) {
    install.packages(pkg)  # Instal paket jika belum terpasang
  }
}

# Instal dan panggil paket
packages <- c("googlesheets4", "dplyr", "ggplot2", "broom", "writexl", "tidyr")
install_if_missing <- function(pkg) {
  if (!requireNamespace(pkg, quietly = TRUE)) {
    install.packages(pkg)
  }
}
lapply(packages, install_if_missing)  # Instal semua paket yang dibutuhkan
## [[1]]
## NULL
## 
## [[2]]
## NULL
## 
## [[3]]
## NULL
## 
## [[4]]
## NULL
## 
## [[5]]
## NULL
## 
## [[6]]
## NULL
lapply(packages, library, character.only = TRUE)  # Panggil paket agar siap digunakan
## Warning: package 'dplyr' was built under R version 4.5.1
## 
## 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
## Warning: package 'broom' was built under R version 4.5.1
## [[1]]
## [1] "googlesheets4" "stats"         "graphics"      "grDevices"    
## [5] "utils"         "datasets"      "methods"       "base"         
## 
## [[2]]
## [1] "dplyr"         "googlesheets4" "stats"         "graphics"     
## [5] "grDevices"     "utils"         "datasets"      "methods"      
## [9] "base"         
## 
## [[3]]
##  [1] "ggplot2"       "dplyr"         "googlesheets4" "stats"        
##  [5] "graphics"      "grDevices"     "utils"         "datasets"     
##  [9] "methods"       "base"         
## 
## [[4]]
##  [1] "broom"         "ggplot2"       "dplyr"         "googlesheets4"
##  [5] "stats"         "graphics"      "grDevices"     "utils"        
##  [9] "datasets"      "methods"       "base"         
## 
## [[5]]
##  [1] "writexl"       "broom"         "ggplot2"       "dplyr"        
##  [5] "googlesheets4" "stats"         "graphics"      "grDevices"    
##  [9] "utils"         "datasets"      "methods"       "base"         
## 
## [[6]]
##  [1] "tidyr"         "writexl"       "broom"         "ggplot2"      
##  [5] "dplyr"         "googlesheets4" "stats"         "graphics"     
##  [9] "grDevices"     "utils"         "datasets"      "methods"      
## [13] "base"
# URL Google Spreadsheet
gsheet_url <- "https://docs.google.com/spreadsheets/d/1r3Oncp3333BNHhXDJ_VrEaoDY3fYsHJypcEVkFGqylQ/edit#gid=1193404090"  # Link data dari Google Sheets

# Fungsi menghitung slope tren regresi linear
calculate_trend <- function(df) {
  df <- drop_na(df, er)  # Hapus baris NA pada encounter rate
  if (nrow(df) < 2) return(NA)  # Jika data terlalu sedikit, return NA
  lm(er ~ Tahun, data = df) %>% coef() %>% .[2]  # Hitung slope dari regresi linear
}

# Fungsi untuk menghitung jumlah Grid ID berdasarkan kategori tren dan membuat visualisasi
calculate_grid_metrics <- function(sheet_name) {
  df <- read_sheet(gsheet_url, sheet = sheet_name)  # Baca data dari Google Sheet
  df <- df %>% mutate(er = as.numeric(er))  # Pastikan encounter rate berupa numeric
  
  total_grid_id <- df %>% distinct(Id) %>% nrow()  # Hitung total Grid ID unik
  
  grid_summary <- df %>%
    group_by(Id) %>%
    summarise(
      slop = calculate_trend(pick(everything())),  # Hitung slope tren tiap Grid ID
      years_with_values = sum(!is.na(er)),  # Hitung jumlah tahun dengan data ER
      .groups = "drop"
    )
  
  # Klasifikasi grid berdasarkan ketersediaan data ER
  tanpa_er <- grid_summary %>% filter(years_with_values == 0)
  lte_4 <- grid_summary %>% filter(years_with_values > 0 & years_with_values <= 4)
  grid_valid <- grid_summary %>% filter(years_with_values >= 5)
  total_grid_gte_5 <- nrow(grid_valid)
  
  # Klasifikasi tren berdasarkan nilai slope
  no_activities <- grid_valid %>% filter(slop == 0)
  trend_up <- grid_valid %>% filter(slop > 0.01)
  trend_stable <- grid_valid %>% filter(slop >= -0.01 & slop <= 0.01 & slop != 0)
  trend_down <- grid_valid %>% filter(slop < -0.01)
  
  # Validasi jumlah grid
  calculated_total <- nrow(tanpa_er) + nrow(lte_4) + total_grid_gte_5
  classified_total <- nrow(no_activities) + nrow(trend_up) + nrow(trend_stable) + nrow(trend_down)
  
  if (calculated_total != total_grid_id) {
    stop("Kesalahan perhitungan: Tanpa ER + LTE_4 + GTE_5 tidak sama dengan Total Grid ID")
  }
  if (classified_total != total_grid_gte_5) {
    stop("Kesalahan perhitungan: No Activities + Meningkat + Stabil + Menurun tidak sama dengan GTE_5")
  }
  
  # Tampilkan ringkasan ke konsol
  cat("\nSheet:", sheet_name,
      "\nTotal Grid ID:", total_grid_id,
      "\nTotal Grid ID tanpa er:", nrow(tanpa_er),
      "\nTotal Grid ID dengan er ≤ 4 tahun:", nrow(lte_4),
      "\nTotal Grid ID dengan er ≥ 5 tahun:", total_grid_gte_5,
      "\nTotal Grid ID dengan tren Meningkat:", nrow(trend_up),
      "\nTotal Grid ID dengan tren Stabil:", nrow(trend_stable),
      "\nTotal Grid ID dengan tren Menurun:", nrow(trend_down),
      "\nTotal Grid ID dengan kategori No Activities:", nrow(no_activities), "\n")
  
  # Fungsi untuk membuat visualisasi tren
  plot_trend <- function(data, title, filename, color) {
    if (nrow(data) == 0) return()  # Skip jika tidak ada data
    
    data_plot <- df %>% semi_join(data, by = "Id") %>% drop_na(er)  # Pilih subset data
    plot_title <- paste0("Grafik ", gsub("er_", "", sheet_name), " ", title, " - Total Grid:", nrow(data))
    
    plot <- ggplot(data_plot, aes(x = Tahun, y = er, group = Id)) +
      geom_point(color = color, size = 2) +
      geom_line(color = color, linewidth = 1) +
      geom_smooth(method = "lm", color = "red", se = FALSE, linetype = "dashed") +
      facet_wrap(~ Id, scales = "free_y") +
      labs(title = plot_title, x = "Tahun", y = "Encounter Rate") +
      theme_minimal()
    
    print(plot)  # Tampilkan plot
    
    ggsave(filename, plot, width = 15, height = 10, dpi = 500)  # Simpan plot
  }
  
  # Panggil fungsi plot_trend untuk setiap kategori tren
  plot_trend(trend_up, "Meningkat", paste0(sheet_name, "_meningkat.png"), "blue")
  plot_trend(trend_stable, "Stabil", paste0(sheet_name, "_stabil.png"), "blue")
  plot_trend(trend_down, "Menurun", paste0(sheet_name, "_menurun.png"), "blue")
  
  return(list(summary = data.frame(
    Sheet = sheet_name,
    Total_Grid_ID = total_grid_id,
    Tanpa_er = nrow(tanpa_er),
    LTE_4 = nrow(lte_4),
    Total_Grid_ID_GTE_5 = total_grid_gte_5,
    Trend_Up = nrow(trend_up),
    Trend_Stable = nrow(trend_stable),
    Trend_Down = nrow(trend_down),
    No_Activities = nrow(no_activities)
  ), details = list(
    Tanpa_er = tanpa_er,
    LTE_4 = lte_4,
    GTE_5 = grid_valid,
    No_Activities = no_activities,
    Trend_Up = trend_up,
    Trend_Stable = trend_stable,
    Trend_Down = trend_down
  )))
}

# Daftar sheet yang akan diproses
sheets <- c("er_perburuan", "er_penggunaan_kaw", "er_pembalakan")  # Nama sheet yang dianalisis
results <- lapply(sheets, calculate_grid_metrics)  # Jalankan fungsi untuk tiap sheet
## ℹ Suitable tokens found in the cache, associated with these emails:
## • 'arif@planetindonesia.org'
## • 'arifdarmawannn@gmail.com'
##   Defaulting to the first email.
## ! Using an auto-discovered, cached token.
##   To suppress this message, modify your code or options to clearly consent to
##   the use of a cached token.
##   See gargle's "Non-interactive auth" vignette for more details:
##   <https://gargle.r-lib.org/articles/non-interactive-auth.html>
## ℹ The googlesheets4 package is using a cached token for
##   'arif@planetindonesia.org'.
## ✔ Reading from "Tabel LAPORAN CAGN dan CALK".
## ✔ Range ''er_perburuan''.
## 
## Sheet: er_perburuan 
## Total Grid ID: 285 
## Total Grid ID tanpa er: 102 
## Total Grid ID dengan er ≤ 4 tahun: 86 
## Total Grid ID dengan er ≥ 5 tahun: 97 
## Total Grid ID dengan tren Meningkat: 8 
## Total Grid ID dengan tren Stabil: 20 
## Total Grid ID dengan tren Menurun: 58 
## Total Grid ID dengan kategori No Activities: 11
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'

## ✔ Reading from "Tabel LAPORAN CAGN dan CALK".
## ✔ Range ''er_penggunaan_kaw''.
## 
## Sheet: er_penggunaan_kaw 
## Total Grid ID: 285 
## Total Grid ID tanpa er: 102 
## Total Grid ID dengan er ≤ 4 tahun: 86 
## Total Grid ID dengan er ≥ 5 tahun: 97 
## Total Grid ID dengan tren Meningkat: 11 
## Total Grid ID dengan tren Stabil: 12 
## Total Grid ID dengan tren Menurun: 31 
## Total Grid ID dengan kategori No Activities: 43
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'

## ✔ Reading from "Tabel LAPORAN CAGN dan CALK".
## ✔ Range ''er_pembalakan''.
## 
## Sheet: er_pembalakan 
## Total Grid ID: 285 
## Total Grid ID tanpa er: 102 
## Total Grid ID dengan er ≤ 4 tahun: 86 
## Total Grid ID dengan er ≥ 5 tahun: 97 
## Total Grid ID dengan tren Meningkat: 1 
## Total Grid ID dengan tren Stabil: 18 
## Total Grid ID dengan tren Menurun: 33 
## Total Grid ID dengan kategori No Activities: 45
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'

# Menggabungkan hasil dari semua sheet
final_results <- do.call(rbind, lapply(results, function(x) x$summary))  # Ringkasan hasil
write_xlsx(final_results, "final_results.xlsx")  # Simpan ringkasan ke Excel

grid_summary_all <- data.frame()
trend_analysis_all <- data.frame()

# Loop untuk menyusun detail analisis tiap sheet
for (sheet in sheets) {
  result <- results[[which(sheets == sheet)]]$details
  short_sheet <- gsub("er_", "", sheet)
  
  grid_summary_all <- bind_rows(
    grid_summary_all,
    data.frame(Sheet = short_sheet, Kategori = "Tanpa ER", result$Tanpa_er),
    data.frame(Sheet = short_sheet, Kategori = "LTE ≤ 4 Tahun", result$LTE_4),
    data.frame(Sheet = short_sheet, Kategori = "GTE ≥ 5 Tahun", result$GTE_5)
  )
  
  trend_analysis_all <- bind_rows(
    trend_analysis_all,
    data.frame(Sheet = short_sheet, Kategori = "Trend Up", result$Trend_Up),
    data.frame(Sheet = short_sheet, Kategori = "Trend Stable", result$Trend_Stable),
    data.frame(Sheet = short_sheet, Kategori = "Trend Down", result$Trend_Down),
    data.frame(Sheet = short_sheet, Kategori = "No Activities", result$No_Activities)
  )
}

# Simpan hasil detail analisis ke file Excel
write_xlsx(list("Grid Summary" = grid_summary_all, "Trend Analysis" = trend_analysis_all), "grid_trend_results.xlsx")

cat("\nFile 'grid_trend_results.xlsx' dan 'final_results.xlsx' berhasil diekspor!\n")  # Notifikasi berhasil
## 
## File 'grid_trend_results.xlsx' dan 'final_results.xlsx' berhasil diekspor!