Tackling Formatted Tabular Data from Excel

sample_excel_attempt_1 <- readxl::read_excel(
  path = here::here("content",
                    "blog",
                    "2024-02-15-Tackling-Formatted-Cell-Data",
                    "sample_excel.xlsx"),
  sheet = "Sheet1"
)
 Copy Code

sample_excel_attempt_2 <- readxl::read_excel(
  path = here::here("content",
                    "blog",
                    "2024-02-15-Tackling-Formatted-Cell-Data",
                    "sample_excel.xlsx"),
  sheet = "Sheet1",
  col_types = c("text" , "date", 
                "numeric", "numeric", "numeric", "numeric", "numeric")
)
 Copy Code

sample_excel_attempt_3 <- readxl::read_excel(
  path = here::here("content",
                    "blog",
                    "2024-02-15-Tackling-Formatted-Cell-Data",
                    "sample_excel.xlsx"),
  sheet = "Sheet1",
  col_types = c("text" , "list", 
                "text", "text", "text", "numeric", "numeric")
  ) |> 
  janitor::clean_names() |> 
  # Check if cohort id is unique
  pointblank::rows_distinct(
    columns = "id",
  )
 Copy Code

convert_dmy_text_to_date <- function(input) {
  if (length(class(input)) == 1) {
    if (class(input) == "character") {
      return(as.Date.character(lubridate::dmy(input)))
    } else if (class(input) == "logical") {
      return(NA)
    }
  }
  return(as.Date.character(lubridate::ymd(input)))
}
 Copy Code

fixed_date <- sample_excel_attempt_3 |>
  dplyr::select(c("id","date_issue")) |> 
  dplyr::mutate(
    converted_date_log = collateral::map_peacefully(
      .x = .data[["date_issue"]],
      .f = convert_dmy_text_to_date
    ),
    converted_date = purrr::map_vec(
      .x = .data[["converted_date_log"]], 
      .f = "result"
    ),
    warning_check = collateral::has_warnings(.data[["converted_date_log"]]),
    error_check = collateral::has_errors(.data[["converted_date_log"]]),

  )
 Copy Code

no_issue <- fixed_date |>
  pointblank::test_col_vals_in_set(
    columns = c("warning_check", "error_check"),
    set = c(FALSE)    
  )
 Copy Code

if (!isTRUE(no_issue)) {
  fixed_date |>
    dplyr::filter(
      warning_check == TRUE | error_check == TRUE
    ) |> 
    dplyr::mutate(
      warning_log = purrr::map(.x = .data[["converted_date_log"]],
                               .f = "warnings",
                               .null = NA),
      error_log = purrr::map(.x = .data[["converted_date_log"]],
                             .f = "errors",
                             .null = NA)   
    ) |> 
    reactable::reactable(
      filterable = TRUE,
      defaultPageSize = 5,
      paginationType = "jump",
    )
}
 Copy Code

fixed_date <- sample_excel_attempt_3 |> 
  dplyr::select(c("id","date_issue")) |> 
  dplyr::mutate(
    date_issue = dplyr::case_when(
      (.data[["id"]] == "ID0004" & 
       .data[["date_issue"]] == "32/1/2017"
      ) ~ list(c("31/1/2017")),
      .default = .data[["date_issue"]]
    ) 
  ) |> 
  dplyr::mutate(
    converted_date_log = collateral::map_peacefully(
      .x = .data[["date_issue"]],
      .f = convert_dmy_text_to_date
    ),
    converted_date = purrr::map_vec(
      .x = .data[["converted_date_log"]], 
      .f = "result"
    ),
    warning_check = collateral::has_warnings(.data[["converted_date_log"]]),
    error_check = collateral::has_errors(.data[["converted_date_log"]]),

  ) |>
  pointblank::col_vals_in_set(
    columns = c("warning_check", "error_check"),
    set = c(FALSE)    
  ) |> 
  dplyr::select(
    c("id", "converted_date")
  ) |> 
  dplyr::rename(
    date_fixed_yyyy_mm_dd = "converted_date"
  )
 Copy Code

cells <- tidyxl::xlsx_cells(
  path = here::here("content",
                    "blog",
                    "2024-02-15-Tackling-Formatted-Cell-Data",
                    "sample_excel.xlsx"),
  sheet = "Sheet1",
  include_blank_cells = TRUE)
 Copy Code

formats <- tidyxl::xlsx_formats(
  path = here::here("content",
                    "blog",
                    "2024-02-15-Tackling-Formatted-Cell-Data",
                    "sample_excel.xlsx")
)
 Copy Code

green_font_local_format_id <- which(formats$local$font$color$rgb == "FF00B050")
black_font_local_format_id <- which(formats$local$font$color$rgb == "FF000000")

green_font_local_format_id
 Copy Code

black_font_local_format_id
 Copy Code

weight_column_index <- which(
  colnames(sample_excel_attempt_3) == "colour_weight_black_in_pounds_green_in_kilograms"
)

weight_column_index
 Copy Code

weight_pounds_converted <- cells |>
  dplyr::filter(.data[["row"]] != 1) |> 
  dplyr::filter(.data[["col"]] == weight_column_index) |> 
  dplyr::filter(.data[["local_format_id"]] %in% black_font_local_format_id) |> 
  pointblank::col_vals_in_set(
    columns = c("data_type"),
    set = c("numeric")    
  ) |>   
  dplyr::filter(.data[["data_type"]] == "numeric") |>  
  dplyr::select(c("row", "numeric")) |> 
  dplyr::rename(weight_pounds_converted = "numeric") |> 
  dplyr::mutate(
    weight_pounds_converted = 
      janitor::round_half_up(.data[["weight_pounds_converted"]] / 2.2046,
                             digits = 0)
  )
 Copy Code

weight_in_kg <- cells |>
  dplyr::filter(.data[["row"]] != 1) |> 
  dplyr::filter(.data[["col"]] == weight_column_index) |> 
  dplyr::filter(.data[["local_format_id"]] %in% green_font_local_format_id) |> 
  pointblank::col_vals_in_set(
    columns = c("data_type"),
    set = c("numeric")    
  ) |>  
  dplyr::filter(.data[["data_type"]] == "numeric") |>  
  dplyr::select(c("row", "numeric")) |> 
  dplyr::rename(weight_kg = "numeric")
 Copy Code

id_column_index <- which(
  colnames(sample_excel_attempt_3) == "id"
)

id_cells <- cells |>
  dplyr::filter(.data[["row"]] != 1) |> 
  dplyr::filter(.data[["col"]] == id_column_index) |>
  pointblank::col_vals_in_set(
    columns = c("data_type"),
    set = c("character")
  ) |> 
  dplyr::select(c("row", "character")) |> 
  dplyr::rename(id = "character")
 Copy Code

fixed_weight <- id_cells |> 
  dplyr::left_join(weight_pounds_converted, 
                   by = dplyr::join_by("row"),
                   unmatched = "error",
                   relationship = "one-to-one") |> 
  dplyr::left_join(weight_in_kg, 
                   by = dplyr::join_by("row"),
                   unmatched = "error",
                   relationship = "one-to-one") |> 
  tidyr::unite(
    col = "weight_fixed_kg",
    c("weight_pounds_converted",
      "weight_kg"),
    remove = TRUE,
    na.rm = TRUE) |> 
  dplyr::select(c("id", "weight_fixed_kg"))
 Copy Code

sample_excel_attempt_4 <- unheadr::annotate_mf_all(
  xlfilepath = here::here("content",
                          "blog", 
                          "2024-02-15-Tackling-Formatted-Cell-Data", 
                          "sample_excel.xlsx")
)
 Copy Code

sample_excel_attempt_4 <- unheadr::annotate_mf_all(
  xlfilepath = here::here("content",
                          "blog", 
                          "2024-02-15-Tackling-Formatted-Cell-Data", 
                          "sample_excel_remove_last.xlsx")
)
 Copy Code

integer_check_from_text <- sample_excel_attempt_3 |> 
  dplyr::select(c("id","text_integer_issue")) |> 
  pointblank::col_vals_regex(
    columns = c("text_integer_issue"),
    regex = "^[1-9]([0-9]+)?(.[0]+)?$",
    na_pass = TRUE,
  ) |> 
  dplyr::mutate(
    text_integer_issue = as.integer(.data[["text_integer_issue"]])
  ) |> 
  pointblank::col_vals_gt(
    columns = c("text_integer_issue"),
    value = 0,
    na_pass = TRUE,    
  ) |> 
  dplyr::rename(
    text_integer_fixed = "text_integer_issue"
  )
 Copy Code

numeric_check <- sample_excel_attempt_3 |> 
  dplyr::select(c("id","text_numeric_issue")) |> 
  pointblank::col_vals_regex(
    columns = c("text_numeric_issue"),
    regex = "^[0-9]+((.[0-9]+)?(E(-)?[0-9]+)?)?$",
    na_pass = TRUE,
  ) |> 
  dplyr::mutate(
    text_numeric_issue = as.numeric(.data[["text_numeric_issue"]])
  ) |> 
  pointblank::col_vals_gt(
    columns = c("text_numeric_issue"),
    value = 0,
    na_pass = TRUE,    
  ) |> 
  dplyr::rename(
    text_numeric_fixed = "text_numeric_issue"
  )
 Copy Code

is_integer_value <- function(input_value,
                             allow_na = FALSE) {

  boolean_result <- FALSE

  # When input value is NA
  if (is.na(input_value)) {
    if (isTRUE(allow_na)) {
      boolean_result <- TRUE
      return(boolean_result)
    } else {
      return(boolean_result)
    }
  }

  # When input value is not numeric
  if (isTRUE(!is.numeric(input_value))) {
    return(boolean_result)
  }

  # When input value is numeric
  boolean_result <- isTRUE(input_value %% 1 == 0)

  return(boolean_result)
}


is_integer_vector <- function(input_vector,
                              allow_na = FALSE) {

  boolean_results <- input_vector |>
    purrr::map_lgl(
      .f = is_integer_value,
      allow_na = allow_na
    )
  return(boolean_results)
}
 Copy Code

numeric_check |>
  pointblank::expect_col_vals_expr(
    expr = ~ is_integer_vector(numeric_check[["text_numeric_fixed"]],
                               allow_na = TRUE)
)
 Copy Code

integer_check_from_numeric <- sample_excel_attempt_3 |> 
  dplyr::select(c("id","numeric_integer_issue")) |> 
  pointblank::col_vals_expr(
    expr = ~ is_integer_vector(sample_excel_attempt_3[["numeric_integer_issue"]],
                               allow_na = TRUE)
  ) |> 
  dplyr::mutate(
    numeric_integer_issue = as.integer(.data[["numeric_integer_issue"]]),
  ) |> 
  dplyr::rename(
    numeric_integer_fixed = "numeric_integer_issue"
  )
 Copy Code

one_or_zero_check <- sample_excel_attempt_3 |> 
  dplyr::select(c("id","one_or_zero_issue")) |> 
  pointblank::col_vals_in_set(
    columns = c("one_or_zero_issue"),
    set = c(NA, 0, 1)
  ) |> 
  dplyr::rename(
    one_or_zero_fixed = "one_or_zero_issue"
  )
 Copy Code

cleaned_data <- sample_excel_attempt_3 |> 
  dplyr::select("id") |> 
  dplyr::left_join(fixed_date, 
                   by = dplyr::join_by("id"),
                   unmatched = "error",
                   relationship = "one-to-one") |> 
  dplyr::left_join(fixed_weight, 
                   by = dplyr::join_by("id"),
                   unmatched = "error",
                   relationship = "one-to-one") |> 
  dplyr::left_join(integer_check_from_text, 
                   by = dplyr::join_by("id"),
                   unmatched = "error",
                   relationship = "one-to-one") |> 
  dplyr::left_join(numeric_check, 
                   by = dplyr::join_by("id"),
                   unmatched = "error",
                   relationship = "one-to-one") |> 
  dplyr::left_join(integer_check_from_numeric, 
                   by = dplyr::join_by("id"),
                   unmatched = "error",
                   relationship = "one-to-one") |> 
  dplyr::left_join(one_or_zero_check, 
                   by = dplyr::join_by("id"),
                   unmatched = "error",
                   relationship = "one-to-one")
 Copy Code