setOldClass(c("listing_df", "tbl_df", "tbl", "data.frame"))

setOldClass(c("MatrixPrintForm", "list"))

#' Create a listing from a `data.frame` or `tibble`

#'

#' @description `r lifecycle::badge("experimental")`

#'

#' Create listings displaying `key_cols` and `disp_cols` to produce a compact and

#' elegant representation of the input `data.frame` or `tibble`.

#'

#' @param df (`data.frame` or `listing_df`)\cr the `data.frame` to be converted to a listing or

#'   `listing_df` to be modified.

#' @param key_cols (`character`)\cr vector of names of columns which should be treated as *key columns*

#'   when rendering the listing. Key columns allow you to group repeat occurrences.

#' @param disp_cols (`character` or `NULL`)\cr vector of names of non-key columns which should be

#'   displayed when the listing is rendered. Defaults to all columns of `df` not named in `key_cols` or

#'   `non_disp_cols`.

#' @param non_disp_cols (`character` or `NULL`)\cr vector of names of non-key columns to be excluded as display

#'   columns. All other non-key columns are treated as display columns. Ignored if `disp_cols` is non-`NULL`.

#' @param sort_cols (`character` or `NULL`)\cr vector of names of columns (in order) which should be used to sort the

#'   listing. Defaults to `key_cols`. If `NULL`, no sorting will be performed.

#' @param unique_rows (`flag`)\cr whether only unique rows should be included in the listing. Defaults to `FALSE`.

#' @param default_formatting (`list`)\cr a named list of default column format configurations to apply when rendering

#'   the listing. Each name-value pair consists of a name corresponding to a data class (or "numeric" for all

#'   unspecified numeric classes) and a value of type `fmt_config` with the format configuration that should be

#'   implemented for columns of that class. If named element "all" is included in the list, this configuration will be

#'   used for all data classes not specified. Objects of type `fmt_config` can take 3 arguments: `format`, `na_str`,

#'   and `align`.

#' @param col_formatting (`list`)\cr a named list of custom column formatting configurations to apply to specific

#'   columns when rendering the listing. Each name-value pair consists of a name corresponding to a column name and a

#'   value of type `fmt_config` with the formatting configuration that should be implemented for that column. Objects

#'   of type `fmt_config` can take 3 arguments: `format`, `na_str`, and `align`. Defaults to `NULL`.

#' @param add_trailing_sep (`character` or `numeric` or `NULL`)\cr If it is assigned to one or more column names,

#'   a trailing separator will be added between groups with identical values for that column. Numeric option allows

#'   the user to specify in which rows it can be added. Defaults to `NULL`.

#' @param trailing_sep (`character(1)`)\cr The separator to be added between groups. The character will be repeated to

#'   fill the row.

#' @param main_title (`string` or `NULL`)\cr the main title for the listing, or `NULL` (the default).

#' @param subtitles (`character` or `NULL`)\cr a vector of subtitles for the listing, or `NULL` (the default).

#' @param main_footer (`character` or `NULL`)\cr a vector of main footer lines for the listing, or `NULL` (the default).

#' @param prov_footer (`character` or `NULL`)\cr a vector of provenance footer lines for the listing, or `NULL`

#'   (the default). Each string element is placed on a new line.

#' @param split_into_pages_by_var (`character` or `NULL`)\cr the name of a variable for on the listing should be split

#'   into pages, with each page corresponding to one unique value/level of the variable. See

#'   [split_into_pages_by_var()] for more details.

#' @param vec (`string`)\cr name of a column vector from a `listing_df` object to be annotated as a key column.

#'

#' @return A `listing_df` object, sorted by its key columns.

#'

#' @details

#' At its core, a `listing_df` object is a `tbl_df` object with a customized

#' print method  and support for the formatting and pagination machinery provided by

#' the `formatters` package.

#'

#' `listing_df` objects have two 'special' types of columns: key columns and display columns.

#'

#' Key columns act as indexes, which means a number of things in practice.

#'

#' All key columns are also display columns.

#'

#' `listing_df` objects are always sorted by their set of key columns at creation time.

#' Any `listing_df` object which is not sorted by its full set of key columns (e.g.,

#' one whose rows have been reordered explicitly during creation) is invalid and the behavior

#' when rendering or paginating that object is undefined.

#'

#' Each value of a key column is printed only once per page and per unique combination of

#' values for all higher-priority (i.e., to the left of it) key columns. Locations

#' where a repeated value would have been printed within a key column for the same

#' higher-priority-key combination on the same page are rendered as empty space.

#' Note, determination of which elements to display within a key column at rendering is

#' based on the underlying value; any non-default formatting applied to the column

#' has no effect on this behavior.

#'

#' Display columns are columns which should be rendered, but are not key columns. By

#' default this is all non-key columns in the incoming data, but in need not be.

#' Columns in the underlying data which are neither key nor display columns remain

#' within the object available for computations but *are not rendered during

#' printing or export of the listing*.

#'

#' @examples

#' dat <- ex_adae

#'

#' # This example demonstrates the listing with key_cols (values are grouped by USUBJID) and

#' # multiple lines in prov_footer

#' lsting <- as_listing(dat[1:25, ],

#'   key_cols = c("USUBJID", "AESOC"),

#'   main_title = "Example Title for Listing",

#'   subtitles = "This is the subtitle for this Adverse Events Table",

#'   main_footer = "Main footer for the listing",

#'   prov_footer = c(

#'     "You can even add a subfooter", "Second element is place on a new line",

#'     "Third string"

#'   )

#' ) %>%

#'   add_listing_col("AETOXGR") %>%

#'   add_listing_col("BMRKR1", format = "xx.x") %>%

#'   add_listing_col("AESER / AREL", fun = function(df) paste(df$AESER, df$AREL, sep = " / "))

#'

#' mat <- matrix_form(lsting)

#'

#' cat(toString(mat))

#'

#' # This example demonstrates the listing table without key_cols

#' # and specifying the cols with disp_cols.

#' dat <- ex_adae

#' lsting <- as_listing(dat[1:25, ],

#'   disp_cols = c("USUBJID", "AESOC", "RACE", "AETOXGR", "BMRKR1")

#' )

#'

#' mat <- matrix_form(lsting)

#'

#' cat(toString(mat))

#'

#' # This example demonstrates a listing with format configurations specified

#' # via the default_formatting and col_formatting arguments

#' dat <- ex_adae

#' dat$AENDY[3:6] <- NA

#' lsting <- as_listing(dat[1:25, ],

#'   key_cols = c("USUBJID", "AESOC"),

#'   disp_cols = c("STUDYID", "SEX", "ASEQ", "RANDDT", "ASTDY", "AENDY"),

#'   default_formatting = list(

#'     all = fmt_config(align = "left"),

#'     numeric = fmt_config(

#'       format = "xx.xx",

#'       na_str = "<No data>",

#'       align = "right"

#'     )

#'   )

#' ) %>%

#'   add_listing_col("BMRKR1", format = "xx.x", align = "center")

#'

#' mat <- matrix_form(lsting)

#'

#' cat(toString(mat))

#'

#' @export

#' @rdname listings

as_listing <- function(df,

                       key_cols = names(df)[1],

                       disp_cols = NULL,

                       non_disp_cols = NULL,

                       sort_cols = key_cols,

                       unique_rows = FALSE,

                       default_formatting = list(all = fmt_config()),

                       col_formatting = NULL,

                       add_trailing_sep = NULL,

                       trailing_sep = " ",

                       main_title = NULL,

                       subtitles = NULL,

                       main_footer = NULL,

                       prov_footer = NULL,

                       split_into_pages_by_var = NULL) {

    )

  }

    ## non_disp_cols NULL is ok here

  } else {

    ## disp_cols non-null, non_disp_cols NULL

  }

    )

  }

    )

  }

  }

      )

    }

          } else {

          }

        ))

      }

    }

  }

  ## reorder the full set of cols to ensure key columns are first

  }

  ## key cols must be leftmost cols

  }

  # set col format configs

    } else {

        )

      }

    }

    # ANY attr <- fmt_config slot

  })

  ## these all work even when the value is NULL

  }

  # add trailing separators to the df object

      )

    } else {

    }

  }

}

# Helper function to add trailing separators to the dataframe

.do_add_trailing_sep <- function(df_tmp, add_trailing_sep, trailing_sep) {

      )

    }

      }),

    ) %>%

    )

      )

    }

    )

  }

}

#' @export

#' @rdname listings

as_keycol <- function(vec) {

  }

}

#' @export

#' @rdname listings

is_keycol <- function(vec) {

}

#' @export

#' @rdname listings

get_keycols <- function(df) {

}

#' @inherit formatters::matrix_form

#' @param indent_rownames (`flag`)\cr silently ignored, as listings do not have row names

#'   nor indenting structure.

#' @param expand_newlines (`flag`)\cr this should always be `TRUE` for listings. We keep it

#'   for debugging reasons.

#'

#' @return a [formatters::MatrixPrintForm] object.

#'

#' @seealso [formatters::matrix_form()]

#'

#' @examples

#' lsting <- as_listing(mtcars)

#' mf <- matrix_form(lsting)

#'

#' @export

setMethod(

  "matrix_form", "listing_df",

  rix_form <- function(obj,

                       indent_rownames = FALSE,

                       expand_newlines = TRUE,

                       fontspec = font_spec,

                       col_gap = 3L,

                       round_type = c("iec", "sas")) {

    ##  we intentionally silently ignore indent_rownames because listings have

    ## no rownames, but formatters::vert_pag_indices calls matrix_form(obj, TRUE)

    ## unconditionally.

    )

      )

    }

        )

      }

    }

    )

      )

    )

      )

    }

    # trailing sep setting

      # We need to make sure that the trailing separator is not beyond the number of rows (cases like head())

    }

      ),

      ),

    )

  }

)

#' @export

#' @rdname listings

#' @param new (`character`)\cr vector of names of columns to be added to

#'   the set of display columns.

#'

#' @export

#' @rdname listings

add_listing_dispcol <- function(df, new) {

}

#' @param value (`string`)\cr new value.

#'

#' @export

#' @rdname listings

`listing_dispcols<-` <- function(df, value) {

    )

  }

    )

  }

}

#' @keywords internal

# xxx @param value (`list`)\cr List of names or rows to be separated and their separator.

#'

#' @keywords internal

`listing_trailing_sep<-` <- function(df, value) {

  }

  )

}

#' @inheritParams formatters::fmt_config

#' @param name (`string`)\cr name of the existing or new column to be

#'   displayed when the listing is rendered.

#' @param fun (`function` or `NULL`)\cr a function which accepts `df` and

#'   returns the vector for a new column, which is added to `df` as

#'   `name`, or `NULL` if marking an existing column as a listing column.

#'

#' @return `df` with `name` created (if necessary) and marked for

#'   display during rendering.

#'

#' @export

#' @rdname listings

add_listing_col <- function(df,

                            name,

                            fun = NULL,

                            format = NULL,

                            na_str = "NA",

                            align = "left") {

    )

  }

  } else {

    )

  }

  }

  ## this works for both new and existing columns

}

#' Split Listing by Values of a Variable

#'

#' @description `r lifecycle::badge("experimental")`

#'

#' Split is performed based on unique values of the given parameter present in the listing.

#' Each listing can only be split by variable once. If this function is applied prior to

#' pagination, parameter values will be separated by page.

#'

#' @param lsting (`listing_df`)\cr the listing to split.

#' @param var (`string`)\cr name of the variable to split on. If the column is a factor,

#'   the resulting list follows the order of the levels.

#' @param page_prefix (`string`)\cr prefix to be appended with the split value (`var` level),

#'   at the end of the subtitles, corresponding to each resulting list element (listing).

#'

#' @return A list of `lsting_df` objects each corresponding to a unique value of `var`.

#'

#' @note This function should only be used after the complete listing has been created. The

#'   listing cannot be modified further after applying this function.

#'

#' @examples

#' dat <- ex_adae[1:20, ]

#'

#' lsting <- as_listing(

#'   dat,

#'   key_cols = c("USUBJID", "AGE"),

#'   disp_cols = "SEX",

#'   main_title = "title",

#'   main_footer = "footer"

#' ) %>%

#'   add_listing_col("BMRKR1", format = "xx.x") %>%

#'   split_into_pages_by_var("SEX")

#'

#' lsting

#'

#' @export

split_into_pages_by_var <- function(lsting, var, page_prefix = var) {

  # Pre-processing in case of factor variable

  } else {

  }

  # Main list creator (filters rows by var)

  }

  # Correction for cases with trailing separators

      )

    }

  }

}

## XXX this historically has been 1, but it actually should be 1.2!!!!!

dflt_courier <- font_spec("Courier", 9, 1)

#' Methods for `listing_df` objects

#'

#' See core documentation in [formatters::formatters-package] for descriptions of these functions.

#'

#' @inheritParams formatters::toString

#' @param x (`listing_df`)\cr the listing.

#' @param ... additional parameters passed to [formatters::toString()].

#'

#' @method print listing_df

#'

#' @export

#' @name listing_methods

print.listing_df <- function(x,

                             widths = NULL,

                             tf_wrap = FALSE,

                             max_width = NULL,

                             fontspec = NULL,

                             col_gap = 3L,

                             round_type = c("iec", "sas"),

                             ...) {

        ...

      )

    )

    } else {

    }

  })

}

#' @exportMethod toString

#' @name listing_methods

#' @aliases toString,listing_df-method

setMethod("toString", "listing_df", function(x,

                                             widths = NULL,

                                             fontspec = NULL,

                                             col_gap = 3L,

                                             round_type = c("iec", "sas"),

                                             ...) {

    ...

  )

})

## because rle in base is too much of a stickler for being atomic

basic_run_lens <- function(x) {

  }

}

#' @param df (`listing_df`)\cr the listing.

#' @param colnm (`string`)\cr column name.

#' @param colvec (`vector`)\cr column values based on `colnm`.

#'

#' @rdname vec_nlines

#' @keywords internal

format_colvector <- function(df, colnm, colvec = df[[colnm]], round_type = c("iec", "sas")) {

  }

  }

}

#' Utilities for formatting a listing column

#'

#' For `vec_nlines`, calculate the number of lines each element of a column vector will

#' take to render. For `format_colvector`,

#'

#' @param vec (`vector`)\cr a column vector to be rendered into ASCII.

#' @param max_width (`numeric(1)` or `NULL`)\cr the width to render the column with.

#' @return (`numeric`)\cr a vector of the number of lines element-wise that will be

#'   needed to render the elements of `vec` to width `max_width`.

#'

#' @keywords internal

setGeneric("vec_nlines", function(vec, max_width = NULL, fontspec = dflt_courier, round_type = c("iec", "sas")) {

})

#' @param vec (`vector`)\cr a vector.

#'

#' @rdname vec_nlines

#' @keywords internal

setMethod("vec_nlines", "ANY", function(vec, max_width = NULL, fontspec = dflt_courier, round_type = c("iec", "sas")) {

    # NB: flooring as it is used as <= (also in base::strwrap)

  }

  # in formatters for characters

})

## setMethod("vec_nlines", "character", function(vec, max_width = NULL) {

##     strvec <- wrap_txt(format_colvector(colvec = vec), width = max_width, collapse = "\n")

##     mtchs <- gregexpr("\n", strvec, fixed = TRUE)

##     1L + vapply(mtchs, function(vi) sum(vi > 0), 1L)

## })

## setMethod("vec_nlines", "factor", function(vec, max_width = NULL) {

##   lvl_nlines <- vec_nlines(levels(vec), max_width = max_width)

##   ret <- lvl_nlines[vec]

##   ret[is.na(ret)] <- format_value(NA_character

## })

#' Make pagination data frame for a listing

#'

#' @inheritParams formatters::make_row_df

#' @param tt (`listing_df`)\cr the listing to be rendered.

#' @param visible_only (`flag`)\cr ignored, as listings do not have

#'   non-visible structural elements.

#'

#' @return a `data.frame` with pagination information.

#'

#' @seealso [formatters::make_row_df()]

#'

#' @examples

#' lsting <- as_listing(mtcars)

#' mf <- matrix_form(lsting)

#'

#' @export

setMethod(

  "make_row_df", "listing_df",

  function(tt, colwidths = NULL, visible_only = TRUE,

           rownum = 0,

           indent = 0L,

           path = character(),

           incontent = FALSE,

           repr_ext = 0L,

           repr_inds = integer(),

           sibpos = NA_integer_,

           nsibs = NA_integer_,

           fontspec = dflt_courier,

           round_type = c("iec", "sas")) {

    ## assume sortedness by keycols

    } else {

    }

      )

    }

    }

    ## extents is a row-wise vector of extents, for each col, we update

    ## if that column has any rows wider than the previously recorded extent.

      ## duplicated from matrix_form method, refactor!

    }

    )

      ))

    ))

  }

)

##     tt$sibpos <- unlist(lapply(

##     ## don't support pathing for now

##     tt$path <- I(lapply(1:NROW(tt),

##                     function(i) {

##         retpath <- character(2*length(keycols))

##         for(j in seq_along(keycols)) {

##             retpath[2*j - 1] <- keycols[j]

##             retpath[2*j] <- tt[i, keycols[j], drop = TRUE]

##         }

##         retpath

##     }))

##     spl <- split(tt, tt[keycols])

##     spl <- spl[vapply(spl, function(y) NROW(y) > 0, NA)]

##     dfs <- lapply(spl, function(df) {

##         df <- df[order(df$abs_rownumber),]

##         ndf <- NROW(df)

##         lapply(1:ndf, function(i) {

##             rw <- df[i,]

##             stopifnot(nrow(rw) == 1)

##             pagdfrow(nm = "",

##                      lab = "",

##                      rnum = rw$abs_rownumber,

##                      pth = NA_character_,

##                      sibpos = i,

##                      nsibs = ndf,

##                      extent = 1L,

##                      rclass = "listing_df",

##                      repind = integer())

##         })

##     })

##     ret <- do.call(rbind, unlist(dfs, recursive = FALSE))

##     ret <- ret[order(ret$abs_rownumber),]

##     ret

## })

#' @inheritParams base::Extract

#' @param x (`listing_df`)\cr the listing.

#' @param i (`any`)\cr object passed to base `[` methods.

#' @param j (`any`)\cr object passed to base `[` methods.

#'

#' @export

#' @aliases [,listing_df-method

#' @rdname listing_methods

setMethod(

  "[", "listing_df",

  function(x, i, j, drop = FALSE) {

    }

  }

)

#' @rdname listing_methods

#' @param obj (`listing_df`)\cr the listing.

#'

#' @return

#' * Accessor methods return the value of the aspect of `obj`.

#' * Setter methods return `obj` with the relevant element of the listing updated.

#'

#' @examples

#' lsting <- as_listing(mtcars)

#' main_title(lsting) <- "Hi there"

#'

#' main_title(lsting)

#'

#' @export

setMethod(

  "main_title", "listing_df",

)

#' @rdname listing_methods

#' @export

setMethod(

  "subtitles", "listing_df",

)

#' @rdname listing_methods

#' @export

setMethod(

  "main_footer", "listing_df",

)

#' @rdname listing_methods

#' @export

setMethod(

  "prov_footer", "listing_df",

)

.chk_value <- function(val, fname, len_one = FALSE, null_ok = TRUE) {

  }

    )

  }

    )

  }

}

#' @rdname listing_methods

#' @export

setMethod(

  "main_title<-", "listing_df",

  function(obj, value) {

    ## length 1 restriction is to match rtables behavior

    ## which currently enforces this (though incompletely)

  }

)

#' @rdname listing_methods

#' @export

setMethod(

  "subtitles<-", "listing_df",

  function(obj, value) {

  }

)

#' @rdname listing_methods

#' @export

setMethod(

  "main_footer<-", "listing_df",

  function(obj, value) {

  }

)

#' @rdname listing_methods

#' @export

setMethod(

  "prov_footer<-", "listing_df",

  function(obj, value) {

  }

)

#' @rdname listing_methods

#' @export

setMethod(

  "num_rep_cols", "listing_df",

  function(obj) {

  }

)

#' Paginate listings

#'

#' @description `r lifecycle::badge("experimental")`

#'

#' Pagination of a listing. This can be vertical for long listings with many

#' rows and/or horizontal if there are many columns. This function is a wrapper of

#' [formatters::paginate_to_mpfs()] and it is mainly meant for exploration and testing.

#'

#' @inheritParams formatters::pag_indices_inner

#' @inheritParams formatters::vert_pag_indices

#' @inheritParams formatters::page_lcpp

#' @inheritParams formatters::toString

#' @param lsting (`listing_df` or `list`)\cr the listing or list of listings to paginate.

#' @param lpp (`numeric(1)` or `NULL`)\cr number of rows/lines (excluding titles and footers)

#'   to include per page. Standard is `70` while `NULL` disables vertical pagination.

#' @param cpp (`numeric(1)` or `NULL`)\cr width (in characters) of the pages for horizontal

#'   pagination. `NULL` (the default) indicates no horizontal pagination should be done.

#' @param print_pages (`flag`)\cr whether the paginated listing should be printed to the console

#'   (`cat(toString(x))`).

#'

#' @return A list of `listing_df` objects where each list element corresponds to a separate page.

#'

#' @examples

#' dat <- ex_adae

#' lsting <- as_listing(dat[1:25, ], disp_cols = c("USUBJID", "AESOC", "RACE", "AETOXGR", "BMRKR1"))

#' mat <- matrix_form(lsting)

#' cat(toString(mat))

#'

#' paginate_listing(lsting, lpp = 10)

#'

#' paginate_listing(lsting, cpp = 100, lpp = 40)

#'

#' paginate_listing(lsting, cpp = 80, lpp = 40, verbose = TRUE)

#'

#' @export

#' @rdname paginate

paginate_listing <- function(lsting,

                             page_type = "letter",

                             font_family = "Courier",

                             font_size = 8,

                             lineheight = 1,

                             landscape = FALSE,

                             pg_width = NULL,

                             pg_height = NULL,

                             margins = c(top = .5, bottom = .5, left = .75, right = .75),

                             lpp = NA_integer_,

                             cpp = NA_integer_,

                             colwidths = NULL,

                             tf_wrap = !is.null(max_width),

                             rep_cols = NULL,

                             max_width = NULL,

                             col_gap = 3,

                             fontspec = font_spec(font_family, font_size, lineheight),

                             verbose = FALSE,

                             print_pages = TRUE) {

  )

      # It is NULL because paginate_mpfs takes care of it

    })

  }

}