transfer from old repo

1 PA Decline/dst import.R

@@ -0,0 +1,83 @@
+#' Reads docx file and splits each table into list
+#'
+#' @param path file path
+#' @param data.type character vector. Could be "paragraph" or "table cell".
+#'
+#' @return
+#' @export
+#'
+#' @examples
+docx2ds <- function(path = here::here("data-raw/Deltagerliste Skirva 2024.docx"),
+                    data.type = "table cell", verbose = TRUE) {
+  # Ref: https://www.r-bloggers.com/2020/07/how-to-read-and-create-word-documents-in-r/
+  doc <- officer::read_docx(path)
+
+  content <- doc |> officer::docx_summary()
+
+  if (verbose) {
+    message("Content types in the current document are as follows:")
+    print(content$content_type |> unique())
+  }
+
+  table_cells <- content |> dplyr::filter(content_type %in% data.type)
+
+  # .x <- split(table_cells, table_cells$doc_index)[[4]]
+
+  split(table_cells, table_cells$doc_index) |> purrr::map(function(.x) {
+    table_data <- .x |>
+      dplyr::filter(!is_header) |>
+      dplyr::select(row_id, cell_id, text)
+
+    # split data into individual columns
+    splits <- split(table_data, table_data$cell_id)
+    splits <- lapply(splits, function(.y) .y$text)
+    splits <- splits |> 
+      purrr::keep(function(.y) length(.y)>1) 
+
+    # If a footer has been added, it is considered part of the first column,
+    # and will result in unequal col lengths.
+    # This solution does not handle merged cells
+    col_lengths <- lengths(splits)
+    
+    if (col_lengths[1] > col_lengths[2]){
+      splits[[1]] <- splits[[1]][seq_len(col_lengths[2])]
+    }
+    
+    # combine columns back together in wide format
+    table_result <- splits |> 
+      dplyr::bind_cols()
+    
+    # get table headers
+    cols <- .x |> dplyr::filter(is_header)
+    names(table_result) <- cols$text
+    table_result
+  })
+}
+
+get_coefs <- function(path, 
+                      index.table = 1) {
+  data = docx2ds(
+    path = path
+  )
+  
+  data |>
+    purrr::pluck(index.table) |>
+    setNames(c(
+      "variable",
+      lapply(c("drop", "hop"),
+        paste,
+        c("median", "mean"),
+        sep = "_"
+      ) |>
+        purrr::list_c()
+    )) |>
+    dplyr::select(variable, tidyselect::ends_with("median")) #|>
+  # dplyr::mutate(dplyr::across(tidyselect::ends_with("median"),~as.numeric))
+  # setNames(c("variable","decrease","increase"))
+}
+
+gtsummary2docx <- function(data, path) {
+  data |>
+    gtsummary::as_flex_table() |>
+    flextable::save_as_docx(path = path)
+}