#' diffdf

#' @description

#' Compares 2 dataframes and outputs any differences.

#' @param base input dataframe

#' @param compare comparison dataframe

#' @param keys vector of variables (as strings) that defines a unique row in

#' the base and compare dataframes

#' @param strict_numeric Flag for strict numeric to numeric comparisons

#' (default = TRUE). If False diffdf will cast integer to double where

#' required for comparisons. Note that variables specified in the keys

#' will never be casted.

#' @param strict_factor Flag for strict factor to character comparisons

#' (default = TRUE). If False diffdf will cast factors to characters where

#' required for comparisons. Note that variables specified in the keys will

#' never be casted.

#' @param suppress_warnings Do you want to suppress warnings? (logical)

#' @param file Location and name of a text file to output the results to.

#' Setting to NULL will cause no file to be produced.

#' @param tolerance Set tolerance for numeric comparisons. Note that

#' comparisons fail if (x-y)/scale > tolerance.

#' @param scale Set scale for numeric comparisons. Note that comparisons fail

#' if (x-y)/scale > tolerance. Setting as NULL is a slightly more efficient

#' version of scale = 1.

#' @param check_column_order Should the column ordering be checked? (logical)

#' @param check_df_class Do you want to check for differences in the class

#' between `base` and `compare`? (logical)

#' @examples

#' x <- subset(iris, -Species)

#' x[1, 2] <- 5

#' COMPARE <- diffdf(iris, x)

#' print(COMPARE)

#'

#' #### Sample data frames

#'

#' DF1 <- data.frame(

#'     id = c(1, 2, 3, 4, 5, 6),

#'     v1 = letters[1:6],

#'     v2 = c(NA, NA, 1, 2, 3, NA)

#' )

#'

#' DF2 <- data.frame(

#'     id = c(1, 2, 3, 4, 5, 7),

#'     v1 = letters[1:6],

#'     v2 = c(NA, NA, 1, 2, NA, NA),

#'     v3 = c(NA, NA, 1, 2, NA, 4)

#' )

#'

#' diffdf(DF1, DF1, keys = "id")

#'

#' # We can control matching with scale/location for example:

#'

#' DF1 <- data.frame(

#'     id = c(1, 2, 3, 4, 5, 6),

#'     v1 = letters[1:6],

#'     v2 = c(1, 2, 3, 4, 5, 6)

#' )

#' DF2 <- data.frame(

#'     id = c(1, 2, 3, 4, 5, 6),

#'     v1 = letters[1:6],

#'     v2 = c(1.1, 2, 3, 4, 5, 6)

#' )

#'

#' diffdf(DF1, DF2, keys = "id")

#' diffdf(DF1, DF2, keys = "id", tolerance = 0.2)

#' diffdf(DF1, DF2, keys = "id", scale = 10, tolerance = 0.2)

#'

#' # We can use strict_factor to compare factors with characters for example:

#'

#' DF1 <- data.frame(

#'     id = c(1, 2, 3, 4, 5, 6),

#'     v1 = letters[1:6],

#'     v2 = c(NA, NA, 1, 2, 3, NA),

#'     stringsAsFactors = FALSE

#' )

#'

#' DF2 <- data.frame(

#'     id = c(1, 2, 3, 4, 5, 6),

#'     v1 = letters[1:6],

#'     v2 = c(NA, NA, 1, 2, 3, NA)

#' )

#'

#' diffdf(DF1, DF2, keys = "id", strict_factor = TRUE)

#' diffdf(DF1, DF2, keys = "id", strict_factor = FALSE)

#'

#' @export

diffdf <- function(

    base,

    compare,

    keys = NULL,

    suppress_warnings = FALSE,

    strict_numeric = TRUE,

    strict_factor = TRUE,

    file = NULL,

    tolerance = sqrt(.Machine$double.eps),

    scale = NULL,

    check_column_order = FALSE,

    check_df_class = FALSE

) {

    )

    ### Initatiate output object

    )

    ### If no key is suplied match values based upon row number

    }

    )

        )

    )

        )

    )

    )

    )

    #### Check essential variable properties (class & mode)

    )

    )

    # cast variables if strict is off

        )

    }

    )

    )

    ##### Check Validity of Keys

    )

    )

    )

    )

    )

    )

    )

        } else {

        }

            ),

        )

    }

    ##### Check Attributes

    )

    ##### Check data

    )

    )

    )

    )

    )

    ## Summarise the number of mismatching rows per variable

        )

    }

        )

    }

    # suppress warning message of data summary if user didn't request to check it

    # we leave the issue in the main compare object though for printing purposes

    )

    }

    # Get all issue messages, remove blank message, and collapse into single string

        }

    }

    # If the classes are the same and it is the only entry in the compare

    # object then remove it in order to trigger "no issues found"

    }

    # If the summary is the only item and the user didn't want to check classes

    # then remove the object to trigger the "no issues found"

    }

    }

}

#' diffdf_has_issues

#'

#' Utility function which returns TRUE if an diffdf

#' object has issues or FALSE if an diffdf object does not have issues

#' @param x diffdf object

#' @examples

#'

#' # Example with no issues

#' x <- diffdf(iris, iris)

#' diffdf_has_issues(x)

#'

#' # Example with issues

#' iris2 <- iris

#' iris2[2, 2] <- NA

#' x <- diffdf(iris, iris2, suppress_warnings = TRUE)

#' diffdf_has_issues(x)

#' @export

diffdf_has_issues <- function(x) {

}

#' Assert that keys are valid

#'

#' Utility function to check that user provided "keys" aren't listed as a problem

#' variable of the current list of issues.

#' @param COMPARE (`list`)\cr A named list of which each element is a `data.frame` with the

#' column `VARIABLE`

#' @param KEYS (`character`)\cr name of key variables to check to make sure they don't contain

#' any issues

#' @param component (`character`)\cr name of the component within `COMPARE` to check against

#' @param msg (`character`)\cr error message to print if any of `KEYS` are found within

#' `COMPARE[component]$VARIABLE`

#' @keywords internal

assert_valid_keys <- function(COMPARE, KEYS, component, msg) {

        )

    )

}

#' Print diffdf objects

#'

#' Print a nicely formatted version of a diffdf object.

#'

#' @param x A comparison object created by \code{diffdf()}.

#' @param ... Additional arguments (not used).

#' @param row_limit Maximum number of rows to display in difference tables.

#' Use \code{NULL} to show all rows. Default is 10.

#' @param as_string Logical. If \code{TRUE}, returns the printed message as an R

#' character vector instead of printing to the console. Default is \code{FALSE}.

#' @param file A connection or a character string naming the file to print to. If

#' \code{NULL} (the default), output is printed to the console.

#'

#' @examples

#' x <- subset(iris, -Species)

#' x[1, 2] <- 5

#' COMPARE <- diffdf(iris, x)

#' print(COMPARE)

#' print(COMPARE, row_limit = 5)

#' print(COMPARE, file = "output.txt")

#'

#' @export

print.diffdf <- function(x, row_limit = 10, as_string = FALSE, file = NULL, ...) {

        )

    }

    )

    } else {

    }

            {

            },

            },

            }

        )

    }

    } else {

    }

}

#' identify_extra_rows

#'

#' Identifies rows that are in a baseline dataset but not in a comparator dataset

#' @param DS1 Baseline dataset (data frame)

#' @param DS2 Comparator dataset (data frame)

#' @param KEYS List of variables that define a unique row within the datasets (strings)

#' @keywords internal

identify_extra_rows <- function(DS1, DS2, KEYS) {

    }

    )

}

#' identify_extra_cols

#'

#' Identifies columns that are in a baseline dataset but not in a comparator dataset

#' @param DS1 Baseline dataset (data frame)

#' @param DS2 Comparator dataset (data frame)

#' @importFrom tibble tibble

#' @keywords internal

identify_extra_cols <- function(DS1, DS2) {

    )

    )

}

#' identify_matching_cols

#'

#' Identifies columns with the same name in two data frames

#' @param DS1 Input dataset 1 (data frame)

#' @param DS2 Input dataset 2 (data frame)

#' @param EXCLUDE Columns to ignore

#' @keywords internal

identify_matching_cols <- function(DS1, DS2, EXCLUDE = "") {

}

#' identify_unsupported_cols

#'

#' Identifies any columns for which the package is not setup to handle

#' @param dsin input dataset

#' @keywords internal

identify_unsupported_cols <- function(dsin) {

    )

}

#' identify_mode_differences

#'

#' Identifies any mode differences between two data frames

#' @param BASE Base dataset for comparison (data.frame)

#' @param COMP Comparator dataset to compare base against (data.frame)

#' @keywords internal

identify_mode_differences <- function(BASE, COMP) {

    )

}

#' identify_class_differences

#'

#' Identifies any class differences between two data frames

#' @param BASE Base dataset for comparison (data.frame)

#' @param COMP Comparator dataset to compare base against (data.frame)

#' @keywords internal

identify_class_differences <- function(BASE, COMP) {

    )

    )

}

#' Identify differences in attributes

#'

#' Identifies any attribute differences between two data frames

#' @param BASE Base dataset for comparison (data.frame)

#' @param COMP Comparator dataset to compare base against (data.frame)

#' @param exclude_cols Columns to exclude from comparison

#' @importFrom tibble tibble

#' @keywords internal

identify_att_differences <- function(BASE, COMP, exclude_cols = "") {

    )

    ### Setup dummy return value

    )

        ### Get a vector of all available attributes across both variables

        ))

        ### If variable has no attributes move onto the next variable

        ### Loop over each attribute checking if they are identical and outputing

        ### anyones that arn't

                )

            }

        }

    }

}

#' identify_differences

#'

#' Compares each column within 2 datasets to identify any values which they

#' mismatch on.

#' @param BASE Base dataset for comparison (data.frame)

#' @param COMP Comparator dataset to compare base against (data.frame)

#' @param KEYS List of variables that define a unique row within the datasets (strings)

#' @param exclude_cols Columns to exclude from comparison

#' @param tolerance Level of tolerance for numeric differences between two variables

#' @param scale Scale that tolerance should be set on. If NULL assume absolute

#' @keywords internal

identify_differences <- function(

    BASE,

    COMP,

    KEYS,

    exclude_cols,

    tolerance = sqrt(.Machine$double.eps),

    scale = NULL

) {

    }

    )

    }

        ),

    )

}

#' identify_properties

#'

#' Returns a dataframe of metadata for a given dataset.

#' Returned values include variable names , class , mode , type & attributes

#' @param dsin input dataframe that you want to get the metadata from

#' @importFrom tibble tibble

#' @keywords internal

identify_properties <- function(dsin) {

    ### If missing or null return empty dataset

        )

    }

    )

}

#' Find column ordering differences

#'

#' Compares two datasets and outputs a table listing any differences in the column

#' orders between the two datasets. Columns that are not contained within both

#' are ignored however column ordering is derived prior to removing these columns.

#'

#' @param BASE (`data.frame`)\cr Base dataset for comparison

#' @param COMP (`data.frame`)\cr Comparator dataset to compare base against

#' @keywords internal

identify_column_order_differences <- function(BASE, COMP) {

    )

    )

    )

}

#' Pad String

#'

#' Utility function used to replicate `str_pad`. Adds white space to either end

#' of a string to get it to equal the desired length

#' @param x string

#' @param width desired length

#' @keywords internal

string_pad <- function(x, width) {

    }

}

#' recursive_reduce

#'

#' Utility function used to replicated `purrr::reduce`. Recursively applies a

#' function to a list of elements until only 1 element remains

#' @param .l list of values to apply a function to

#' @param .f function to apply to each each element of the list in turn. See details.

#' @details

#' This function is essentially performing the following operation:

#' ```

#' .l[[1]] <- .f( .l[[1]] , .l[[2]]) ; .l[[1]] <- .f( .l[[1]] , .l[[3]])

#' ```

#' @keywords internal

recursive_reduce <- function(.l, .f) {

    }

}

#' invert

#'

#' Utility function used to replicated `purrr::transpose`. Turns a list inside

#' out.

#' @param x list

#' @keywords internal

invert <- function(x) {

        }

    }

}

#' as_ascii_table

#'

#' This function takes a `data.frame` and attempts to convert it into

#' a simple ascii format suitable for printing to the screen

#' It is assumed all variable values have a `as.character()` method

#' in order to cast them to character.

#' @param dat Input dataset to convert into a ascii table

#' @param line_prefix Symbols to prefix in front of every line of the table

#' @keywords internal

as_ascii_table <- function(dat, line_prefix = "  ") {

    ## Convert every value to character and crop to a suitable length

    ### For each column extract core elements (width, values , title) and pad out

    ### each string to be a suitable length

    }

    ### Collapse into a single value per component ( title , values, width )

    ### Create header and footer lines

    ### Output table

    )

}

#' as_character

#'

#' Stub function to enable mocking in unit tests

as_character <- as.character

#' Format vector to printable string

#'

#' Coerces a vector of any type into a printable string. The most

#' significant transformation is performed on existing character

#' vectors which will be truncated, have newlines converted

#' to explicit symbols and will be wrapped in quotes if they

#' contain white space.

#'

#' @param x (`vector`) \cr vector to be converted to character

#' @param add_quotes (`logical`) \cr if true will wrap strings that contain

#' whitespace with quotes

#' @param crop_at (`numeric`) \cr specifies the limit at which strings should

#' be truncated to

#' @param ... additional arguments (not currently used)

#'

#' @name as_fmt_char

#' @keywords internal

as_fmt_char <- function(x, ...) {

}

#' @rdname as_fmt_char

#' @export

as_fmt_char.numeric <- function(x, ...) {

}

#' @rdname as_fmt_char

#' @export

as_fmt_char.NULL <- function(x, ...) {

}

#' @importFrom utils capture.output

#' @rdname as_fmt_char

#' @export

as_fmt_char.list <- function(x, ...) {

            }

            }

            )

        },

    )

}

#' @rdname as_fmt_char

#' @export

as_fmt_char.factor <- function(x, ...) {

}

#' @rdname as_fmt_char

#' @export

as_fmt_char.character <- function(x, add_quotes = TRUE, crop_at = 30, ...) {

    # Replace \nl \cr with tags to stop print message splitting over

    # multiple lines

    # Add enclosing " " around strings with white space so that it can be

    # clearly identified in the printed output

}

#' @rdname as_fmt_char

#' @export

as_fmt_char.default <- function(x, ...) {

        )

    )

}

#' @rdname as_fmt_char

#' @export

as_fmt_char.POSIXt <- function(x, ...) {

}

#' get_table

#'

#' Generate nice looking table from a data frame

#' @param dsin dataset

#' @inheritParams print.diffdf

#' @keywords internal

get_table <- function(dsin, row_limit = 10) {

    }

        )

    }

    } else {

    }

        )

    } else {

    }

        ),

    )

}

#' construct_issue

#'

#' Make an s3 object with class issue and possible additional class,

#' and assign other arguments to attributes

#' @param value the value of the object

#' @param message the value of the message attribute

#' @param add_class additional class to add

#' @keywords internal

construct_issue <- function(value, message, add_class = NULL) {

    ### If nothing has been provided return nothing !

    }

}

#' get_issue_message

#'

#' Simple function to grab the issue message

#' @param object inputted object of class issue

#' @param ... other arguments

#' @keywords internal

get_issue_message <- function(object, ...) {

}

#' get_print_message

#'

#' Get the required text depending on type of issue

#' @param object inputted object of class issue

#' @param ... other arguments

#' @keywords internal

get_print_message <- function(object, ...) {

}

#' get_print_message.default

#'

#' Errors, as this should only ever be given an issue

#' @param object issue

#' @param ... Not used

#' @keywords internal

get_print_message.default <- function(object, ...) {

}

#' get_print_message.issue

#'

#' Get text from a basic issue, based on the class of the value of the issue

#'

#' @param object an object of class issue_basic

#' @inheritParams print.diffdf

#' @keywords internal

get_print_message.issue <- function(object, row_limit, ...) {

        ),

    )

}

#' sort_then_join

#'

#' Convenience function to sort two strings and paste them together

#' @param string1 first string

#' @param string2 second string

#' @keywords internal

sort_then_join <- function(string1, string2) {

}

#' class_merge

#'

#' Convenience function to put all classes an object has into one string

#' @param x an object

#' @keywords internal

class_merge <- function(x) {

}

get_message <- function(colname, whichdat, totype) {

    ))

}

#' get_casted_vector

#'

#' casts a vector depending on its type and input

#' @param colin column to cast

#' @param colname name of vector

#' @param whichdat whether base or compare is being casted (used for messages)

#' @importFrom methods is

#' @keywords internal

get_casted_vector <- function(colin, colname, whichdat) {

    }

    }

}

#' get_casted_dataset

#'

#' Internal utility function to loop across a dataset casting all target

#' variables

#' @param df dataset to be casted

#' @param columns columns to be casted

#' @param whichdat whether base or compare is being casted (used for messages)

#' @keywords internal

get_casted_dataset <- function(df, columns, whichdat) {

    }

}

#' cast_variables

#'

#' Function to cast datasets columns if they have differing types

#' Restricted to specific cases, currently integer and double, and character and factor

#' @param BASE base dataset

#' @param COMPARE comparison dataset

#' @param ignore_vars Variables not to be considered for casting

#' @param cast_integers Logical - Whether integers should be cased to double when compared to doubles

#' @param cast_factors Logical - Whether characters should be casted to characters when compared to characters

#' @keywords internal

cast_variables <- function(

    BASE,

    COMPARE,

    ignore_vars = NULL,

    cast_integers = FALSE,

    cast_factors = FALSE

) {

    )

    )

    )

    )

    )

    }

    }

}

#' Identify Issue Rows

#'

#' This function takes a `diffdf` object and a dataframe and subsets

#' the `data.frame` for problem rows as identified in the comparison object.

#' If \code{vars} has been specified only issue rows associated with those

#' variable(s) will be returned.

#' @param df dataframe to be subsetted

#' @param diff diffdf object

#' @param vars (optional) character vector containing names of issue variables to subset dataframe

#' on. A value of NULL (default) will be taken to mean available issue variables.

#' @examples

#' iris2 <- iris

#' for (i in 1:3) iris2[i, i] <- 99

#' x <- diffdf(iris, iris2, suppress_warnings = TRUE)

#' diffdf_issuerows(iris, x)

#' diffdf_issuerows(iris2, x)

#' diffdf_issuerows(iris2, x, vars = "Sepal.Length")

#' diffdf_issuerows(iris2, x, vars = c("Sepal.Length", "Sepal.Width"))

#' @details

#' Note that `diffdf_issuerows` can be used to subset against any dataframe. The only

#' requirement is that the original variables specified in the keys argument to diffdf

#' are present on the dataframe you are subsetting against. However please note that if

#' no keys were specified in diffdf then the row number is used. This means using

#' `diffdf_issuerows` without a keys against an arbitrary dataset can easily result in

#' nonsense rows being returned. It is always recommended to supply keys to diffdf.

#' @export

diffdf_issuerows <- function(df, diff, vars = NULL) {

    )

    )

    } else {

    }

    }

    )

    }

    }

    )

    }

}

#' get_issue_dataset

#'

#' Internal function used by `diffdf_issuerows` to extract the dataframe

#' from each a target issue. In particular it also strips off any

#' non-key variables

#' @param issue name of issue to extract the dataset from diff

#' @param diff diffdf object which contains issues

#' @keywords internal

get_issue_dataset <- function(issue, diff) {

}

#' is_variable_different

#'

#' This subsets the data set on the variable name, picks out differences and returns a `tibble`

#' of differences for the given variable

#' @importFrom tibble as_tibble

#' @param variablename name of variable being compared

#' @param keynames name of keys

#' @param datain Inputted dataset with base and compare vectors

#' @param ...  Additional arguments which might be passed through (numerical accuracy)

#' @return A boolean vector which is T if target and current are different

#' @keywords internal

is_variable_different <- function(variablename, keynames, datain, ...) {

    )

        )

    )

}

#' compare_vectors

#'

#' Compare two vectors looking for differences

#'

#' @param target the base vector

#' @param current a vector to compare target to

#' @param ...  Additional arguments which might be passed through (numerical accuracy)

#' @keywords internal

compare_vectors <- function(target, current, ...) {

}

#' find_difference

#'

#' This determines if two vectors are different. It expects vectors of the same

#' length and type, and is intended to be used after checks have already been done

#' Initially picks out any `NA`'s (matching `NA`'s count as a match)

#' Then compares remaining vector

#'

#' @param target the base vector

#' @param current a vector to compare target to

#' @param ...  Additional arguments which might be passed through (numerical accuracy)

#' @keywords internal

find_difference <- function(target, current, ...) {