_targets.R

library(targets)
library(tarchetypes)
source("R/functions.R")

Sys.setenv(QUARTO_DENO_EXTRA_OPTIONS = "--v8flags=--max-old-space-size=8192")
Sys.setenv(TAR_ASK = "false")

tar_option_set(packages = c(
  "readr",
  "dplyr",
  "ggplot2",
  "readxl",
  "gt",
  "gtExtras",
  "mice",
  "cluster",
  "plotly",
  "sf",
  "tidyr",
  "leaflet"
), seed = 45)




list(
  # Read raw data from Excel and clean column names
  tar_target(number_of_clusters, 6),
  tar_target(pc_to_include, 12),
  tar_target(n_cluster, 10),
  tar_target(
    df_raw,
    read_excel_custom(path = "data/Analisis_Tipologi_NTT.xlsx", sheet = "summary_all_editMN")
  ),
  
  tar_target(df_subset,
             prepare_data_subset(
               df_raw,
               c(
                 "tnp2k_rt",
                 "tnp2k_indv",
                 "wetmonths_mean",
                 "rasio_elektrifikasi",
                 "total_kk",
                 "poverty_ratio"
               )
             )),
  tar_target(imputed_data,
             perform_data_imputation(df_subset)),
  
  # Remove specific columns from raw data
  tar_target(df_gt, remove_columns(
    df_raw,
    c(
      "id",
      "nmprov",
      "nmkab",
      "nmkec",
      "idkec",
      "tnp2k_rt",
      "tnp2k_indv",
      "wetmonths_mean",
      "rasio_elektrifikasi",
      "poverty_ratio",
      "total_kk"
    )
  ) |> bind_cols(imputed_data)),
  
  # Select specific columns for further analysis
  tar_target(df_gt_exclude, select_columns(
    df_gt,
    c(
      "annual_temperature_c_change",
      "precipitation_change",
      "ndwi_2020",
      "ndmi_2020"
    )
  )),
  
  # Remove selected columns and apply logarithmic transformation
  tar_target(
    unscaled_df,
    (remove_columns(
      df_gt,
      c(
        "annual_temperature_c_change",
        "precipitation_change",
        "ndwi_2020",
        "ndmi_2020"
      )
    ) + 0.001) |> as_tibble() |> mutate_all(.funs = log10)
  ),
  
  # Scale the combined dataset for PCA
  tar_target(scaled_df, bind_cols(unscaled_df, df_gt_exclude) |>  scale()),
  
  # Combine the scaled data with the selected raw data columns
  tar_target(
    scaled_df_complete,
    select_columns(df_raw, c("id", "nmprov", "nmkab", "nmkec", "idkec")) |> bind_cols(scaled_df)
  ),
  
  # Filter rows with missing data in the complete dataset
  tar_target(missing_data, filter_na_rows(scaled_df_complete)),
  tar_target(list_of_excluded_var, c(
    "korban_kebakaran_hutan_dan_lahan_2018_2019",
    "korban_banjir_bandang_2018_2019",
    #"korban_banjir_2018_2019",
    "korban_tanah_longsor_2018_2019",
    "kejadian_tanah_longsor_2018_2019",
    "korban_kekeringan_lahan_2018_2019",
    "kejadian_kekeringan_lahan_2018_2019",
    "annual_temperature_c_change",
    "precipitation_change",
    "luas_ha",
    "idm_2021",
    #"minimarket",
    "distance_to_forest",
    "distance_to_lake",
    #"jumlah_sistem_peringatan_dini_bencana_alam",
    "tnp2k_rt",
    "tnp2k_indv",
    "total_kk",
    "distance_to_irigation",
    "distance_daerah_irigasi",
    #"percentage_of_forested_area",
    #"slope",
    #"elevasi",
    "pop_dens",
    #"distance_to_port",
    "distance_to_coast_line",
    "ndvi_2020"
  )),
  
  # Prepare data for PCA by removing specific columns
  tar_target(df_pre_pca, remove_columns(
    scaled_df_complete,
    c(
      "id",
      "nmprov",
      "nmkab",
      "nmkec",
      "idkec",
      list_of_excluded_var
    )
  )),
  
  # Pivot the data for statistical analysis, grouped by 'variable'
  tar_target(
    df_long,
    pivot_dataframe(
      scaled_df_complete,
      cols_to_exclude  = c("id", "nmprov", "nmkab", "nmkec", "idkec"),
      name_variable  = "variable",
      name_value  = "value"
    ) |> group_by(variable)
  ),
  
  # Calculate summary statistics for each group in the pivoted data
  tar_target(gt_stat, calculate_summary_stats(df_long)),
  
  # Create a gt table with density plots from the summary statistics
  tar_target(plot_gt_summary, create_gt_plot(gt_stat)),
  
  # Conduct Principal Component Analysis on the prepared data
  tar_target(pca_result, prcomp(df_pre_pca)),
  
  # Visualize the PCA result using a scree plot to see the variance explained by each principal component
  # tar_target(plot_pca_scree, plot(pca_result, type = "l"))
  
  tar_target(
    loadings_plots,
    generate_pca_loadings_plots(pca_result,
                                num_pcs = 5)
  ),
  
  tar_target(var_explained, pca_result$sdev ^ 2 / sum(pca_result$sdev ^
                                                        2)),
  tar_target(input_kmean, pca_result$x[, 1:pc_to_include]),
  tar_target(wss_data,
             compute_wss(input_kmean, max_clusters = n_cluster)),
  tar_target(
    elbow_plot,
    ggplot(wss_data, aes(x = Clusters, y = WSS)) +
      geom_line() +
      geom_point() +
      xlab("Number of Clusters") +
      ylab("Total Within-Cluster Sum of Squares") +
      ggtitle("Elbow Method for K-Means Clustering") + theme_classic()
  ),
  tar_target(
    silhouette_data,
    compute_silhouette_scores(input_kmean,  max_clusters = n_cluster)
  ),
  tar_target(
    silhouette_plot,
    ggplot(silhouette_data, aes(x = Clusters, y = Silhouette)) +
      geom_line() +
      geom_point() +
      xlab("Number of Clusters") +
      ylab("Average Silhouette Width") +
      ggtitle("Silhouette Analysis for K-Means Clustering") + 
      theme_classic()
  ),
  # Perform k-means clustering
  tar_target(
    kmeans_result, kmeans(input_kmean, centers = number_of_clusters)),
  tar_target(
    plot_pc1_pc2,
    plot_kmeans_clusters(input_kmean, kmeans_result, "PC1", "PC2")
  ),
  tar_target(
    plot_pc1_pc3,
    plot_kmeans_clusters(input_kmean, kmeans_result, "PC1", "PC3")
  ),
  tar_target(
    plot_3d_scatter,
    create_3d_scatter_plot(scaled_df_complete, input_kmean, kmeans_result)
  ),
  tar_target(
    clusters_kec,
    process_and_join_geo_cluster("data/INDO_DESA_2019/INDO_DESA_2019.shp", "NUSA TENGGARA TIMUR", scaled_df_complete, kmeans_result)
  ),
  tar_target(
    shp_cluster, clusters_kec |>
      dplyr::select(idkec , nmkec, nmkab, cluster) |>
      mutate_at(.vars = c("idkec" , "nmkec", "nmkab", "cluster"), as.character()) |>
      st_simplify() |> 
      st_write("output/tipologi_ntt_.shp", append = TRUE)
  ),
  tar_target(
    clusters_kec_tbl, st_drop_geometry(clusters_kec)
  ),
  # tar_target(
  #   leaflet_map,
  #   create_leaflet_map(clusters_kec = "output/tipologi_ntt_.shp", cluster_lookup = "data/cluster_names.csv")
  # )
  tar_target(cluster_lookup, readr::read_csv("data/cluster_names.csv")),
  tar_target(summary_table_kec, {
    clusters_kec_tbl |> ungroup() |>  
      select("cluster") |> bind_cols(df_gt) |> 
      #transform(idkec = as.factor(idkec), nmkec = as.factor(nmkec)) |> 
      pivot_longer(cols = -cluster,
                   names_to = "variable",
                   values_to = "value") |> 
      left_join(cluster_lookup, by = "cluster") |> 
      relocate(name, .after = cluster) |> 
      dplyr::select(-cluster) |> 
      group_by(name, variable) |>
      summarise(mean = mean(value, na.rm = TRUE),
                std_dev = sd(value, na.rm = TRUE)) |> ungroup() |> 
      mutate(across(where(is.numeric), ~ round(., digits = 2))) |> 
      mutate(value_combined = paste0(mean, " (", std_dev, ")")) |> 
      select(-mean, -std_dev)  |> 
      pivot_wider(
        names_from = name, 
        values_from = value_combined,
        id_cols = variable
      )
  }),
  tar_target(
    numeric_values, 
    apply(summary_table_kec[2:7], 2, function(row) {
      sapply(row, extract_numeric)
    })
  ),
  tar_target(
    tibble_numeric, 
    { numeric_values |> 
        as_tibble()
    }
  ),
  tar_target(ranked_data, {
    tibble_numeric %>%
      rowwise() %>%
      transmute(rank = list(rank(-c_across(cols = everything()), ties.method = "first"))) %>%
      unnest_wider(rank, names_sep = "_tmp") %>%
      setNames(names(tibble_numeric)) %>%
      ungroup() %>%
      bind_cols(summary_table_kec[1],.)
  }),
  tar_target(
    ranking_tables,
    create_ranking_tables(summary_table_kec, ranked_data)
  ),
  tar_target(
    save_ranking_output,
    save_ranking_tables(ranking_tables)
  ),
  tar_target(
    summary_table_color, 
    summary_table_kec[1] |> bind_cols(tibble_numeric) |> 
      gt(rowname_col = "variable") |> data_color(
        direction = "row",
        palette = "RdYlBu",
        na_color = "white"
      )
  ),
  tar_quarto(report, "draft_fgd_tipologi_kerentanan_ntt.qmd") 
  
  
)