#' Recode New Variables With Formats
#'
#' @name recode
#'
#' @description
#' Instead of writing multiple if-clauses to recode values into a new variable,
#' you can use formats to recode a variable into a new one.
#'
#' @param data_frame A data frame which contains the the original variables to recode.
#' @param ... [recode.()] Pass in the original variable name that should be recoded
#' along with the corresponding format container in the form: variable = format.
#'
#' In [recode_multi()] multiple variables can be recoded in one go and multilabels
#' can be applied. This overwrites the original variables and duplicates rows if
#' multilabels are applied. In occasions were you want to use format containers to
#' afterwards perform operations with other packages, you can make use of this
#' principle with this function.
#'
#' @details
#' [recode.()] is based on the 'SAS' function put(), which provides an efficient
#' and readable way, to generate new variables with the help of formats.
#'
#' When creating a format you can basically write code like you think: This new
#' category consists of these original values. And after that you just apply these
#' new categories to the original values to create a new variable. No need for multiple
#' if_else statements.
#'
#' @return
#' [recode.()]: Returns a vector with recoded values.
#'
#' @seealso
#' Creating formats: [discrete_format()] and [interval_format()].
#'
#' Functions that also make use of formats: [frequencies()], [crosstabs()],
#' [any_table()], [summarise_plus()], [transpose_plus()], [sort_plus()]
#'
#' @examples
#' # Example formats
#' age. <- discrete_format(
#'     "under 18"       = 0:17,
#'     "18 to under 25" = 18:24,
#'     "25 to under 55" = 25:54,
#'     "55 to under 65" = 55:64,
#'     "65 and older"   = 65:100)
#'
#' # Example data frame
#' my_data <- dummy_data(1000)
#'
#' # Call function
#' my_data[["age_group1"]] <- my_data |> recode.(age = age.)
#'
#' # Formats can also be passed as characters
#' my_data[["age_group2"]] <- my_data |> recode.(age = "age.")
#'
#' # Multilabel recode
#' sex. <- discrete_format(
#'     "Total"  = 1:2,
#'     "Male"   = 1,
#'     "Female" = 2)
#'
#' income. <- interval_format(
#'     "Total"              =    0:100000,
#'     "below 500"          =    0:500,
#'     "500 to under 1000"  =  500:1000,
#'     "1000 to under 2000" = 1000:2000,
#'     "2000 and more"      = 2000:100000)
#'
#' # recode_multi() can not only apply multiple recodings, but it can also
#' # apply multilabels.
#' # NOTE: Recoding will always be in place. When applying multilabels the
#' #       result data frame will have more observations than before.
#' multi_data <- my_data |> recode_multi(sex = sex., income = income.)
#'
#' @rdname recode
#'
#' @export
recode. <- function(data_frame,
                    ...){
    # Measure the time
    print_start_message(suppress = TRUE)

    ###########################################################################
    # Early evaluations
    ###########################################################################

    # Translate ... into separately controllable arguments
    formats <- tryCatch({
        # Force evaluation to see if it exists
        list(...)
    }, error = function(e){
        # Evaluation failed
        NULL
    })

    if (is.null(formats)){
        print_message("ERROR", "Unknown object found. Recode will be aborted.")
        return(invisible(NULL))
    }

    # Evaluate formats early
    if (!is_list_of_dfs(formats)){
        formats <- evaluate_formats(formats)
    }

    ###########################################################################
    # Error handling
    ###########################################################################

    # Get information from ... list
    current_var <- names(formats)[1]
    format_df   <- formats[[current_var]]

    if (!current_var %in% names(data_frame)){
        print_message("ERROR", "Variable '[var]' not found in the input data frame. No format will be applied.", var = current_var)
        return(invisible(NULL))
    }

    if (!data.table::is.data.table(format_df)){
        print_message("ERROR", "The format for '[var]' must be a data table. No format will be applied.", var = current_var)
        return(invisible(NULL))
    }

    if (names(format_df)[1] == "value" && collapse::any_duplicated(format_df[["value"]])){
        print_message("WARNING", c("The format for '[var]' is a multilabel. A multilabel can't be fully applied in recode.",
								   "Only one of the matching categories will be applied."), var = current_var)

        format_df <- format_df |> unique(by = "value", fromLast = FALSE)
    }

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

    ###########################################################################
    # Recode
    ###########################################################################

    # Only keep the variable to be recoded
    data_frame <- data_frame |> keep(current_var)

    # 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)){
        # Reduce multilabel formats to unique ranges which don't overlap
        format_original <- format_df
        format_df       <- format_df |> collapse::fsubset(from >= data.table::shift(cummax(to), fill = -Inf))

        if (collapse::fnrow(format_original) > collapse::fnrow(format_df)){
            print_message("WARNING", c("The format for '[current_var]' is a multilabel. A multilabel can't be fully applied in recode.",
                                       "Only one of the matching categories will be applied."), current_var = current_var)
        }

        # Get number of rows from data frame to compare after the merge to check for multilabel
        original_rows <- collapse::fnrow(data_frame)

        # Separate NAs from rest of the data frame because the used join
        # can't handle them
        na_positions <- is.na(data_frame[[current_var]])
        data_frame   <- data_frame |> collapse::fsubset(!na_positions)

        # Generate pseudo variables for range merging
        data_frame[["qol_from"]] <- data_frame[[as.character(current_var)]]
        data_frame[["qol_to"]]   <- data_frame[[as.character(current_var)]]

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

        # Set key variables
        temp_dt   <- data.table::as.data.table(data_frame)
        format_dt <- data.table::copy(format_df)

        data.table::setkey(format_dt, from, to)

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

        # NA values are now inserted in the same spots as they where before to
        # ensure that there will be no missmatch with the original data frame.
        data_frame                <- rep(NA, original_rows)
        data_frame[!na_positions] <- temp_dt[["label"]]
        data_frame                <- data.table::as.data.table(data_frame)
    }

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

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

        # Join format with data frame
        data_frame <- data_frame |>
            collapse::join(format_df,
                           on      = current_var,
                           how     = "left",
                           verbose = FALSE,
						   overid  = 2) |>
            keep("label")
    }

    print_closing()

    as.vector(data_frame)[[1]]
}


#' @param convert FALSE by default. If TRUE converts recoded variables to numeric
#' or character depending on the input format instead of leaving them as factors.
#'
#' @return
#' [recode_multi()]: Returns a data frame with the newly recoded variable.
#'
#' @rdname recode
#'
#' @export
recode_multi <- function(data_frame, ..., convert = FALSE){
    # Measure the time
    print_start_message(suppress = TRUE)

    # Translate ... into a list if possible
    formats <- tryCatch({
        # Force evaluation to see if it exists
        list(...)
    }, error = function(e){
        # Evaluation failed
        NULL
    })

    if (is.null(formats)){
        print_message("ERROR", c("Unknown object found. Provide recode arguments in the form: variable_name = format_df.",
								 "Recoding will be aborted."))
        return(data_frame)
    }

    # Evaluate formats early
    if (!is_list_of_dfs(formats)){
        formats <- evaluate_formats(formats)
    }

    # Get information from ... list
    variables <- names(formats)
    var_order <- names(data_frame)

    # Apply formats
    data_frame <- data_frame |>
        apply_format(formats, variables) |>
        data.table::setcolorder(var_order)

    # Convert formatted values to intended type
    if (convert){
        for (variable in variables){
            if (is.numeric(formats[[variable]][["label"]])){
                data_frame[[variable]] <- as.numeric(data_frame[[variable]])
            }
            else{
                data_frame[[variable]] <- as.character(data_frame[[variable]])
            }
        }
    }

    print_closing(5)

    data_frame
}
