More changes and tests for the inters in transform wider

dtacled · Dec 18, 2024 · dbdc8a3 · dbdc8a3
1 parent 2ea52da
commit dbdc8a3
Show file tree

Hide file tree

Showing 3 changed files with 64 additions and 23 deletions.
diff --git a/R/acled_transform_wider.R b/R/acled_transform_wider.R
@@ -39,6 +39,10 @@ acled_transform_wider <- function(data, type = "full_actors") {
     stop(paste0("Error: ", type, " is not a valid option. Please select a valid option:\"full_actors\", \"main_actors\", \"assoc_actors\", \"source\", \"api_monadic\""))
   }
 
+  if(type %in% c("full_actors", "main_actors")) {
+    inter_numeric <- any(1:8 %in% unique(data$inter))
+  }
+
   if (type == "full_actors") {
     columns_present <- function(df, cols) {
       all(sapply(cols, function(x) !is.na(match(x, names(df)))))
@@ -51,6 +55,8 @@ acled_transform_wider <- function(data, type = "full_actors") {
       stop("Some columns are missing. Please make sure your data frame includes: actor,type_of_actor,inter_type, and inter.")
     }
 
+
+
     reverse_data <- data %>%
       # Pivot actor firsts, flattening joint actors such as assoc actors
       pivot_wider(names_from = type_of_actor, values_from = actor, values_fn = function(x) str_flatten(x, collapse = "; "), values_fill = "") %>%
@@ -60,7 +66,6 @@ acled_transform_wider <- function(data, type = "full_actors") {
       ) %>%
 
       # Pivot inters next, adding a fill 9999 to those that do not apply, as a way of removing. inters from different types of actors
-      # Coerced to character to account for inters being text or numeric
       pivot_wider(names_from = inter_type, values_from = inter, values_fill = as.character(9999)) %>%
       mutate(inter1 = replace_na(inter1, "")) %>%
       mutate(inter2 = replace_na(inter2, "")) %>%
@@ -79,20 +84,27 @@ acled_transform_wider <- function(data, type = "full_actors") {
         actor2 = na_if(actor2, ""),
         actor1 = na_if(actor1, ""),
         assoc_actor_1 = na_if(assoc_actor_1, ""),
-        assoc_actor_2 = na_if(assoc_actor_2, ""),
-        inter1 = replace_na(inter1, 0),
-        inter2 = replace_na(inter2, 0)
+        assoc_actor_2 = na_if(assoc_actor_2, "")
       ) %>%
       # Match column structure for an acled dataset
-      select(names(acledR::acled_old_dummy))
+      dplyr::select(names(acledR::acled_old_dummy))
 
     # Coerce to numeric if inter were originally numeric
-    if(max(length(reverse_data$inter1)) == 1) {
+    if(inter_numeric == TRUE) {
       reverse_data <-
         reverse_data %>%
         mutate(
           inter1 = as.numeric(inter1),
-          inter2 = as.numeric(inter2)
+          inter2 = as.numeric(inter2),
+          inter1 = replace_na(inter1, 0),
+          inter2 = replace_na(inter2, 0)
+        )
+    } else {
+      reverse_data <-
+        reverse_data %>%
+        mutate(
+          inter1 = case_when(inter1 == "" ~ NA_character_, TRUE ~ inter1),
+          inter2 = case_when(inter2 == "" ~ NA_character_, TRUE ~ inter2)
         )
     }
 
@@ -136,21 +148,28 @@ acled_transform_wider <- function(data, type = "full_actors") {
         actor2 = na_if(actor2, ""),
         actor1 = na_if(actor1, ""),
         assoc_actor_1 = na_if(assoc_actor_1, ""),
-        assoc_actor_2 = na_if(assoc_actor_2, ""),
-        inter1 = replace_na(inter1, 0),
-        inter2 = replace_na(inter2, 0)
+        assoc_actor_2 = na_if(assoc_actor_2, "")
       ) %>%
       # Match column structure for an acled dataset
-      select(names(acledR::acled_old_dummy))
+      dplyr::select(names(acledR::acled_old_dummy))
 
     # Coerce to numeric if inter were originally numeric
-    if(max(length(reverse_data$inter1)) == 1) {
+    if(inter_numeric == TRUE) {
       reverse_data <-
         reverse_data %>%
         mutate(
         inter1 = as.numeric(inter1),
-        inter2 = as.numeric(inter2)
+        inter2 = as.numeric(inter2),
+        inter1 = replace_na(inter1, 0),
+        inter2 = replace_na(inter2, 0)
       )
+    } else {
+      reverse_data <-
+        reverse_data %>%
+        mutate(
+          inter1 = case_when(inter1 == "" ~ NA_character_, TRUE ~ inter1),
+          inter2 = case_when(inter2 == "" ~ NA_character_, TRUE ~ inter2)
+        )
     }
 
   } else if (type == "assoc_actors") {
@@ -180,12 +199,30 @@ acled_transform_wider <- function(data, type = "full_actors") {
         actor2 = na_if(actor2, ""),
         actor1 = na_if(actor1, ""),
         assoc_actor_1 = na_if(assoc_actor_1, ""),
-        assoc_actor_2 = na_if(assoc_actor_2, ""),
-        inter1 = replace_na(inter1, 0),
-        inter2 = replace_na(inter2, 0)
+        assoc_actor_2 = na_if(assoc_actor_2, "")
       ) %>%
       # Match column structure for an acled dataset
-      select(names(acledR::acled_old_dummy))
+      dplyr::select(names(acledR::acled_old_dummy))
+
+    # Coerce to numeric if inter were originally numeric
+    # if(inter_numeric == TRUE) {
+    #   reverse_data <-
+    #     reverse_data %>%
+    #     mutate(
+    #       inter1 = as.numeric(inter1),
+    #       inter2 = as.numeric(inter2),
+    #       inter1 = replace_na(inter1, 0),
+    #       inter2 = replace_na(inter2, 0)
+    #     )
+    # } else {
+    #   reverse_data <-
+    #     reverse_data %>%
+    #     mutate(
+    #       inter1 = case_when(inter1 == "" ~ NA_character_, TRUE ~ inter1),
+    #       inter2 = case_when(inter2 == "" ~ NA_character_, TRUE ~ inter2)
+    #     )
+    # }
+
   } else if (type == "source") {
     columns_present <- function(df, cols) {
       all(sapply(cols, function(x) !is.na(match(x, names(df)))))
@@ -204,7 +241,7 @@ acled_transform_wider <- function(data, type = "full_actors") {
       summarise(source = str_c(source, collapse = "; ")) %>%
       ungroup() %>%
       # Match column structure for an acled dataset
-      select(names(acledR::acled_old_dummy))
+      dplyr::select(names(acledR::acled_old_dummy))
   } else if (type == "api_monadic") {
     df1 <- data %>%
       group_by(event_id_cnty) %>%

diff --git a/R/acled_update.R b/R/acled_update.R
@@ -77,7 +77,7 @@ acled_update <- function(df,
     warning("Warning: End date is earlier than the latest event date in your dataframe.")
   }
 
-  if (inter_numeric == FALSE & length(df$inter1[[1]]) == 1) {
+  if (inter_numeric == FALSE & any(1:8 %in% unique(df$inter1))) {
     stop("The data frame provided appears to have numeric interaction values (inter1, inter2, and interaction variables). Set inter_numeric = TRUE in the acled_update() call to update data with numeric interaction values.")
   }
 

diff --git a/tests/testthat/test-acled_transform_wider.R b/tests/testthat/test-acled_transform_wider.R
@@ -12,7 +12,8 @@ test_that("acled_transform_wider returns expected results for type = 'full_actor
     mutate(actor2 = na_if(actor2, ""))
 
   # Test if the original acledR::acled_old_dummy and the reversed acledR::acled_old_dummy are the same
-  expect_equal(dplyr::arrange(acledR::acled_old_dummy,event_id_cnty), dplyr::arrange(reversed_data, event_id_cnty))
+  expect_equal(dplyr::arrange(acledR::acled_old_dummy,event_id_cnty), dplyr::arrange(reversed_data, event_id_cnty),
+               ignore_attr = TRUE)
 })
 
 test_that("acled_transform_wider returns expected results for type = 'main_actors'", {
@@ -26,7 +27,8 @@ test_that("acled_transform_wider returns expected results for type = 'main_actor
   reversed_data <- acled_transform_wider(transformed_data, type = "main_actors")
 
   # Test if the original acledR::acled_old_dummy and the reversed acledR::acled_old_dummy are the same
-  expect_equal(dplyr::arrange(acledR::acled_old_dummy,event_id_cnty), dplyr::arrange(reversed_data, event_id_cnty))
+  expect_equal(dplyr::arrange(acledR::acled_old_dummy,event_id_cnty), dplyr::arrange(reversed_data, event_id_cnty),
+               ignore_attr = TRUE)
 })
 
 test_that("acled_transform_wider returns expected results for type = 'assoc_actors'", {
@@ -38,7 +40,8 @@ test_that("acled_transform_wider returns expected results for type = 'assoc_acto
   reversed_data <- acled_transform_wider(transformed_data, type = "assoc_actors")
 
   # Test if the original acledR::acled_old_dummy and the reversed acledR::acled_old_dummy are the same
-  expect_equal(dplyr::arrange(acledR::acled_old_dummy,event_id_cnty), dplyr::arrange(reversed_data, event_id_cnty))
+  expect_equal(dplyr::arrange(acledR::acled_old_dummy,event_id_cnty), dplyr::arrange(reversed_data, event_id_cnty),
+               ignore_attr = TRUE)
 })
 
 test_that("acled_transform_wider returns expected results for type = 'source'", {
@@ -50,7 +53,8 @@ test_that("acled_transform_wider returns expected results for type = 'source'",
   reversed_data <- acled_transform_wider(transformed_data, type = "source")
 
   # Test if the original acledR::acled_old_dummy and the reversed acledR::acled_old_dummy are the same
-  expect_equal(dplyr::arrange(acledR::acled_old_dummy,event_id_cnty), dplyr::arrange(reversed_data, event_id_cnty))
+  expect_equal(dplyr::arrange(acledR::acled_old_dummy,event_id_cnty), dplyr::arrange(reversed_data, event_id_cnty),
+               ignore_attr = TRUE)
 })
 
 # Tests for proper errors and messages----