83 lines
2.3 KiB
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)
|
||
|
|
}
|