#' Apply Formats to a Data Frame
#'
#' @description
#' Used to apply formats to a data frame. Handles single labels with a simple join
#' and also multilabels by computing the cartesian product.
#'
#' @param data_frame The data frame to which formats should be joined.
#' @param formats A list in which is specified which formats should be applied
#' to which variables.
#' @param group_vars A vector containing all grouping variables.
#'
#' @return
#' Returns a data table to which a format data frame was joined.
#'
#' @noRd
apply_format <- function(data_frame, formats, group_vars = NULL, print_miss = TRUE){
    if (length(formats) == 0){
        return(data_frame)
    }

    arguments     <- formats

    # See comment above about numeric conversion
    inverse_group <- group_vars[!group_vars %in% names(arguments)]
    temp_data     <- data_frame |> convert_numeric(inverse_group)

    #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    # Loop through all given variables and join each format with the data frame
    # at a time
    #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

    for (current_var in names(arguments)){
        format_df <- arguments[[current_var]]

        if (is.null(format_df)){
            print_message("WARNING", "Format for '[current_var]' not found. Formatting for variable '[current_var]' will be omitted.",
                          current_var = current_var, always_print = TRUE)
            next
        }

        if (is.factor(temp_data[[current_var]])){
            print_message("NOTE", c("'[current_var]' is a factor variable. Formats only work if the visible character values",
									"are specified as input values and not the factor levels."), current_var = current_var,
									always_print = TRUE)
        }

        # Security checks to ensure types are right
        if (!is.null(group_vars)){
            if (!current_var %in% group_vars){
                # No Warning because this exit is used to omit missing group variables
                next
            }
        }

        if (!current_var %in% names(temp_data)){
            print_message("WARNING", "Variable '[current_var]' not found in the input data frame. No Format will be applied.",
                          current_var = current_var)
            next
        }

        # Look up variable names in format data frame to check whether it is an
        # interval or discrete format
        interval_variables <- c("from", "to")
        actual_variables <- names(format_df)[1:2]

        #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        # In case of interval format
        #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

        if (identical(interval_variables, actual_variables)){
            # Separate NAs from rest of the data frame because the used join
            # can't handle them
            na_positions <- is.na(temp_data[[current_var]])
            temp_na      <- temp_data |> collapse::fsubset(na_positions)
            temp_data    <- temp_data |> collapse::fsubset(!na_positions)

            # Generate pseudo variables for range merging
            temp_data[["qol_from"]] <- temp_data[[current_var]]
            temp_data[["qol_to"]]   <- temp_data[[current_var]]

            data_frame[["qol_ID"]] <- seq_len(collapse::fnrow(data_frame))

            # Make a copy of format data frame or otherwise the original will be
            # altered by the following key sorting
            format_dt <- data.table::copy(format_df)

            # Set key variables
            data.table::setkey(format_dt, from, to)

            # Merge data frame with format by range
            temp_data <- data.table::foverlaps(temp_data, format_dt,
                                               by.x = c("qol_from", "qol_to"),
                                               by.y = c("from", "to"))

            temp_data |> collapse::fselect(current_var, "qol_from", "qol_to", "from", "to") <- NULL
            temp_data <- temp_data |> collapse::frename("label" = current_var, .nse = FALSE)

            # Put NAs back into full data frame
            temp_data <- data.table::rbindlist(list(temp_data, temp_na), fill = TRUE)

            all_levels <- format_df[3] |>
                unlist(use.names = FALSE) |>
                collapse::funique() |>
                collapse::na_omit()
        }

        #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        # In case of discrete format
        #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

        else{
            # Rename label column to be specific to the variable
            format_df <- format_df |> collapse::frename("value" = current_var, .nse = FALSE)

            # Perform a cartesian join which joins all possibilities together, meaning it doubles observations
            temp_data <- collapse::join(temp_data, format_df,
                                        on       = current_var,
                                        how      = "left",
                                        multiple = TRUE,
                                        verbose  = FALSE,
										overid   = 2)

            # If not all values are represented in the format container, check where there are gaps
            # and fill them at the affected positions. This implements the "other" keyword in formats.
            na_positions <- which(is.na(temp_data[["label"]]) & !is.na(temp_data[[current_var]]))
            if (length(na_positions) > 0){
                if (as.character(.Machine[["integer.max"]]) %in% tolower(format_df[[current_var]])){
                    temp_data[["label"]][na_positions] <- format_df[["label"]][tolower(format_df[[current_var]]) == as.character(.Machine[["integer.max"]])]
                }
                else if(.Machine[["integer.max"]] %in% format_df[[current_var]]){
                    temp_data[["label"]][na_positions] <- format_df[["label"]][format_df[[current_var]] == .Machine[["integer.max"]]]
                }
                else{
                    temp_data[["label"]][na_positions] <- temp_data[[current_var]][na_positions]
                }
            }

            # Drop current variable and rename newly joined label to current variable name
            temp_data |> collapse::fselect(current_var) <- NULL
            temp_data <- temp_data |> collapse::frename("label" = current_var, .nse = FALSE)

            # Extract the number of labels from format
            all_levels <- format_df[-1] |>
                unlist(use.names = FALSE) |>
                collapse::funique() |>
                collapse::na_omit()
        }

        # Make sure that the labels will appear in order of the format when
        # applied to a variable in a data frame
        temp_data[[current_var]] <- factor(
            temp_data[[current_var]],
            levels  = all_levels,
            ordered = TRUE)
    }

    temp_data
}
