PAaSO/1 PA Decline/dst import.R

83 lines
2.3 KiB
R

#' 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)
}