Merge pull request #75 from datapartnership/ntl

ntl fixes

notebooks/ntl-analysis/01_clean_data/02_extract_to_polygons.R

@@ -43,7 +43,7 @@ for(roi_name in c("cadaster", "lbn_adm0", "lbn_adm1", "lbn_adm2", "lbn_adm3", "l
   roi_sf$adm_id <- 1:nrow(roi_sf)
 
   # Aggregate annual -------------------------------------------------------------
-  for(year in 1992:2022){
+  for(year in 1992:2023){
 
     ## Only process if file already hasn't been created
     OUT_FILE <- file.path(ntl_dir, "aggregated-to-polygons", roi_name, "individual-annual", paste0("ntl_", year, ".Rds"))
@@ -52,13 +52,19 @@ for(roi_name in c("cadaster", "lbn_adm0", "lbn_adm1", "lbn_adm2", "lbn_adm3", "l
 
       if(year >= 2012){
         bm_r <- raster(file.path(ntl_dir, "ntl-rasters", "blackmarble", "annual", paste0("VNP46A4_NearNadir_Composite_Snow_Free_qflag255_1_t",year,".tif")))
-        viirs_r_r <- raster(file.path(ntl_dir, "ntl-rasters", "viirs", "annual", paste0("LBN_viirs_mean_",year,".tif")))
+
+        if(year <= 2022){
+          viirs_r_r <- raster(file.path(ntl_dir, "ntl-rasters", "viirs", "annual", paste0("LBN_viirs_mean_",year,".tif")))
+        } else{
+          viirs_r_r <- raster()
+        }
+
       } else{
         bm_r     <- raster()
         viirs_r_r <- raster()
       }
 
-      if(year >= 2014){
+      if(year %in% 2014:2022){
         viirs_c_r <- raster(file.path(ntl_dir, "ntl-rasters", "viirs", "annual", paste0("LBN_viirs_corrected_mean_",year,".tif")))
       } else{
         viirs_c_r <- raster()

notebooks/ntl-analysis/02_analysis/annual_trends.R

@@ -4,7 +4,7 @@
 gdp_df <- WDI(country = "LBN",
           indicator = c("NY.GDP.MKTP.KD", "NY.GDP.PCAP.KD"),
           start = 1992,
-          end = 2022,
+          end = 2023,
           extra = TRUE)
 
 gdp_long_df <- gdp_df %>%
@@ -33,7 +33,7 @@ ntl_gdp_df %>%
   labs(x = NULL,
        y = "Nighttime Lights",
        title = "Annual Nighttime Lights and GDP") +
-  scale_x_continuous(breaks = seq(1995, 2022, 4)) +
+  scale_x_continuous(breaks = seq(1995, 2023, 4)) +
   theme_classic2() +
   facet_wrap(~name, scales = "free_y", ncol = 1) +
   theme(strip.background = element_blank(),
@@ -55,7 +55,7 @@ ntl_df %>%
   labs(x = NULL,
        y = "Nighttime Lights",
        title = "Annual Nighttime Lights: Governorate Level") +
-  scale_x_continuous(breaks = seq(1995, 2022, 8)) +
+  scale_x_continuous(breaks = seq(1995, 2023, 8)) +
   theme_classic2() +
   theme(strip.background = element_blank(),
         strip.text = element_text(face = "bold")) +

notebooks/ntl-analysis/02_analysis/compare_viirs_sources.R

@@ -16,8 +16,8 @@ ntl0_df %>%
   ggplot() +
   geom_line(aes(x = year, y = value, color = name),
             linewidth = 1) +
-  scale_x_continuous(breaks = seq(2012,2022,2),
-                     labels = seq(2012,2022,2)) +
+  scale_x_continuous(breaks = seq(2012,2023,2),
+                     labels = seq(2012,2023,2)) +
   labs(title = "VIIRS Nighttime Lights: Different Sources",
        color = "",
        x = "Year",

notebooks/ntl-analysis/02_analysis/monthly_trends.R

@@ -12,8 +12,9 @@ ntl_df %>%
   labs(x = NULL,
        y = "Nighttime Lights",
        title = "Monthly Nighttime Lights: Country Level") +
-  scale_x_date(date_breaks = "24 months", date_labels = "%Y") +  # Set breaks to every 6 months
-  theme_classic2()
+  scale_x_date(date_breaks = "12 months", date_labels = "%Y") +  # Set breaks to every 6 months
+  theme_classic2() +
+  theme(axis.text = element_text(size = 8))
 
 ggsave(filename = file.path(figures_dir, "monthly_trends_adm0.png"),
        height = 2, width = 4.5)
@@ -30,10 +31,11 @@ ntl_df %>%
   labs(x = NULL,
        y = "Nighttime Lights",
        title = "Monthly Nighttime Lights: ADM 1") +
-  scale_x_date(date_breaks = "48 months", date_labels = "%Y") +  # Set breaks to every 6 months
+  scale_x_date(date_breaks = "24 months", date_labels = "%Y") +  # Set breaks to every 6 months
   theme_classic2() +
   theme(strip.background = element_blank(),
-        strip.text = element_text(face = "bold")) +
+        strip.text = element_text(face = "bold"),
+        axis.text = element_text(size = 6)) +
   facet_wrap(~admin1Name,
              scales = "free_y")
 

notebooks/ntl-analysis/02_analysis/percent_change_adm.R

@@ -31,36 +31,41 @@ for(roi_name in c("lbn_adm1", "lbn_adm2", "lbn_adm3", "lbn_adm4")){
 
   # Prep data -------------------------------------------------------------------
   ntl_pc_df <- ntl_df %>%
-    dplyr::filter(year %in% c(2019, 2020, 2021, 2022)) %>%
+    dplyr::filter(year %in% c(2019, 2020, 2021, 2022, 2023)) %>%
     dplyr::select(year, adm_id, ntl_bm_mean) %>%
     mutate(year = paste0("yr", year)) %>%
     pivot_wider(id_cols = adm_id, names_from = year, values_from = "ntl_bm_mean") %>%
-    mutate(pc19 = (yr2022 - yr2019) / yr2019 * 100,
-           pc20 = (yr2022 - yr2020) / yr2020 * 100,
-           pc21 = (yr2022 - yr2021) / yr2021 * 100)
+    mutate(pc19 = (yr2023 - yr2019) / yr2019 * 100,
+           pc20 = (yr2023 - yr2020) / yr2020 * 100,
+           pc21 = (yr2023 - yr2021) / yr2021 * 100,
+           pc22 = (yr2023 - yr2022) / yr2022 * 100)
 
   roi_sf <- roi_sf %>%
     left_join(ntl_pc_df, by = "adm_id")
 
-  roi_sf$pc19[roi_sf$pc19 > 0] <- NA
+  roi_sf$pc19[roi_sf$pc19 > 100] <- 100
   roi_sf$pc19[is.na(roi_sf$pc19)] <- 0
 
-  roi_sf$pc20[roi_sf$pc20 > 0] <- NA
+  roi_sf$pc20[roi_sf$pc20 > 100] <- 100
   roi_sf$pc20[is.na(roi_sf$pc20)] <- 0
 
-  roi_sf$pc21[roi_sf$pc21 > 0] <- NA
+  roi_sf$pc21[roi_sf$pc21 > 100] <- 100
   roi_sf$pc21[is.na(roi_sf$pc21)] <- 0
 
+  roi_sf$pc22[roi_sf$pc22 > 100] <- 100
+  roi_sf$pc22[is.na(roi_sf$pc22)] <- 0
+
   # Map --------------------------------------------------------------------------
   city_df <- data.frame(lat = 33.898316, lon = 35.505696, name = "Beirut")
 
   roi_long_sf <- roi_sf %>%
-    dplyr::select(adm_id, pc19, pc20, pc21) %>%
+    dplyr::select(adm_id, pc19, pc20, pc21, pc22) %>%
     pivot_longer(cols = -c(adm_id, geometry)) %>%
     dplyr::mutate(name_clean = case_when(
-      name == "pc19" ~ "2019 to 2022",
-      name == "pc20" ~ "2020 to 2022",
-      name == "pc21" ~ "2021 to 2022"
+      name == "pc19" ~ "2019 to 2023",
+      name == "pc20" ~ "2020 to 2023",
+      name == "pc21" ~ "2021 to 2023",
+      name == "pc22" ~ "2022 to 2023"
     ))
 
   p <- ggplot() +
@@ -71,8 +76,8 @@ for(roi_name in c("lbn_adm1", "lbn_adm2", "lbn_adm3", "lbn_adm4")){
          color = "% Change\nin NTL") +
     coord_sf() +
     theme_void() +
-    scale_fill_distiller(palette = "YlOrRd", direction = -1) +
-    scale_color_distiller(palette = "YlOrRd", direction = -1) +
+    scale_fill_gradient2(low = "red", high = "forestgreen") +
+    scale_color_gradient2(low = "red", high = "forestgreen") +
     facet_wrap(~name_clean)
 
   if(roi_name != "lbn_adm4"){
@@ -99,31 +104,36 @@ for(roi_name in c("lbn_adm1", "lbn_adm2", "lbn_adm3", "lbn_adm4")){
 
   roi_sf %>%
     st_drop_geometry() %>%
-    dplyr::select(name, yr2019, yr2020, yr2021, yr2022, pc19, pc20, pc21) %>%
+    dplyr::select(name, yr2019, yr2020, yr2021, yr2022, yr2023, pc19, pc20, pc21, pc22) %>%
     #dplyr::filter(pc < 0) %>%
     arrange(-yr2019) %>%
     head(30) %>%
     dplyr::mutate(yr2019 = round(yr2019, 2),
                   yr2020 = round(yr2020, 2),
                   yr2021 = round(yr2021, 2),
                   yr2022 = round(yr2022, 2),
+                  yr2023 = round(yr2023, 2),
                   pc19 = round(pc19,1),
                   pc20 = round(pc20,1),
-                  pc21 = round(pc21,1)) %>%
+                  pc21 = round(pc21,1),
+                  pc22 = round(pc22,1)) %>%
     dplyr::rename("Name" = name,
                   "NTL: 2019" = yr2019,
                   "NTL: 2020" = yr2020,
                   "NTL: 2021" = yr2021,
                   "NTL: 2022" = yr2022,
-                  "PC: 19 to 22" = pc19,
-                  "PC: 20 to 22" = pc20,
-                  "PC: 21 to 22" = pc21) %>%
+                  "NTL: 2023" = yr2023,
+                  "19 to 22" = pc19,
+                  "20 to 22" = pc20,
+                  "21 to 22" = pc21,
+                  "22 to 23" = pc22) %>%
     gt() %>%
     #gt_hulk_col_numeric(`NTL: 2019`, trim = TRUE) %>%
     #gt_hulk_col_numeric(`NTL: 2022`, trim = TRUE)  %>%
-    gt_color_rows(c(`PC: 19 to 22`,
-                    `PC: 20 to 22`,
-                    `PC: 21 to 22`),
+    gt_color_rows(c(`19 to 22`,
+                    `20 to 22`,
+                    `21 to 22`,
+                    `22 to 23`),
                   palette = "Reds",
                   reverse = T) %>%
     gtsave(filename = file.path(figures_dir, paste0("pc_table_",roi_name,".png")))