R/data_df.R

In pxmake: Make PX-Files in R

#' Format df for px format
#'
#' Turn all variables, except figures variable, into character and replace NA
#' with dash.
#'
#' @param data_df A data frame with data.
#' @param figures_variable Character. The name of the figures variable.
#'
#' @returns A data frame
#' @keywords internal
format_data_df <- function(data_df, figures_variable) {
  data_df %>%
    dplyr::ungroup() %>%
    dplyr::mutate(across(-one_of(intersect(names(.), figures_variable)),
                         as.character
                         )
                  ) %>%
    dplyr::mutate(dplyr::across(where(is.character),
                                ~ tidyr::replace_na(.x, "-")
                                )
                  )
}

#' Create a minimal px object from a data frame
#'
#' @param df A data frame
#'
#' @returns A px object
#' @keywords internal
px_from_data_df <- function(df) {
  default_language <- NA

  mandatory_table_keywords <-
    px_keywords %>%
    dplyr::filter(.data$mandatory, .data$table_meta)

  table1 <-
    mandatory_table_keywords %>%
    dplyr::filter(!.data$language_dependent) %>%
    dplyr::select("keyword", "value" = "default_value") %>%
    align_data_frames(get_base_table1()) %>%
    sort_table1()

  table2 <-
    mandatory_table_keywords %>%
    dplyr::filter(.data$language_dependent) %>%
    dplyr::select("keyword", "value" = "default_value") %>%
    dplyr::mutate(language = default_language) %>%
    align_data_frames(get_base_table2()) %>%
    sort_table2(languages = default_language)

  variable_names <- names(df)

  stub_variables    <- c()
  heading_variables <- c()
  figures_variable  <- c()

  figures_variable <- tail(variable_names, 1)

  data_df <- format_data_df(df, figures_variable)

  if (length(variable_names) >= 3) {
    heading_variables <- head(tail(variable_names, 2), 1)
    stub_variables    <- head(variable_names, length(variable_names) - 2)
  } else {
    heading_variables <-  NULL
    stub_variables    <- head(variable_names, length(variable_names) - 1)
  }

  variables1 <-
    dplyr::tribble(~`variable-code`, ~pivot,
                   stub_variables,    "STUB",
                   heading_variables, "HEADING",
                   figures_variable,  "FIGURES"
                   ) %>%
    tidyr::unnest("variable-code") %>%
    dplyr::group_by(.data$pivot) %>%
    dplyr::mutate(order = ifelse(.data$pivot == "FIGURES",
                                 NA,
                                 dplyr::row_number()
                                 ),
                  contvariable = FALSE
                  ) %>%
    dplyr::ungroup() %>%
    align_data_frames(get_base_variables1()) %>%
    sort_variables1()

  variables2 <-
    variables1 %>%
    dplyr::select("variable-code") %>%
    dplyr::mutate(language = default_language,
                  `variable-label` = .data$`variable-code`
                  ) %>%
    align_data_frames(get_base_variables2()) %>%
    sort_variables2(data_table_names = names(df),
                    languages = default_language
                    )

  if (length(df) == 0) {
    cells1 <- get_base_cells1()
  } else {
    cells1 <-
      dplyr::tibble(`variable-code` = setdiff(names(data_df), figures_variable)) %>%
      dplyr::rowwise() %>%
      dplyr::mutate(code =
                      df[[.data$`variable-code`]] %>%
                      unique() %>%
                      sort() %>%
                      as.character() %>%
                      list()
                    ) %>%
      dplyr::ungroup() %>%
      dplyr::filter(!is.null(.data$code)) %>%
      tidyr::unnest("code") %>%
      dplyr::group_by(.data$`variable-code`) %>%
      dplyr::mutate(order = as.numeric(dplyr::row_number())) %>%
      dplyr::ungroup() %>%
      align_data_frames(get_base_cells1()) %>%
      sort_cells1(data_table_names = names(data_df))
  }

  cells2 <-
    cells1 %>%
    dplyr::select("variable-code", "code") %>%
    dplyr::mutate(language = default_language,
                  value = .data$code
                  ) %>%
    align_data_frames(get_base_cells2()) %>%
    sort_cells2(data_table_names = names(data_df),
                languages = default_language
                )

  new_px(languages = get_base_languages(),
         table1 = table1,
         table2 = table2,
         variables1 = variables1,
         variables2 = variables2,
         cells1 = cells1,
         cells2 = cells2,
         acrosscells = get_base_acrosscells(c(stub_variables, heading_variables)),
         data = data_df
         ) %>%
    px_title("") %>%
    px_charset('ANSI')
}