Generate knitr nested lists in R

knested_list.R

#' Convert a nested list structure into a knitr-usable output as html, 
#' LaTeX, or markdown (txt).
#' 
#' @param x The (nested) list to convert into an output-ready format
#' @param listtype The type of list to generate (may be abbreviated)
#' @param use.names Should the list names be displayed in the output?
#' @param format What output format should be used?  The format is 
#'   auto-detected in knitr output and defaults to "txt" which is 
#'   markdown text format.
#' @param ... Arguments passed to other methods.
#' @details List elements are passed down to a knested_list_helper 
#'   function.  By default, everything is converted to a character and 
#'   returned.  Vectors within list elements are collapsed using the 
#'   paste command.
#'   
#'   When generating "txt" \code{format} output, a limitation is that
#'   the items must all reside on one line.
#' @return A character string representing the list suitable for "asis" 
#'   output in a markdown document.
#' @export
knested_list <- function(x,
                         listtype=c("bullet", "numbered", "definition"),
                         use.names=listtype %in% "definition",
                         format=c(NA, "html", "latex", "txt"),
                         ...) {
  listtype <- match.arg(listtype)
  use.names <- as.logical(use.names[1])
  # Choose the output format
  format <- tolower(match.arg(format))
  if (is.na(format)) {
    format <- knitr:::pandoc_to()
    if (is.null(format)) {
      format <- knitr:::out_format()
    }
    if (is.null(format)) {
      format <- "txt"
    }
  }
  format <- tolower(format)
  if (!(format %in% c("html", "latex"))) {
    format <- "txt"
  }
  liststyling <-
    list(
      html=
        list(
          bullet=
            list(list.prefix="<ul>\n",
                 list.suffix="</ul>\n",
                 name.prefix="<li>",
                 name.suffix=": ",
                 item.with.name.prefix="",
                 item.no.name.prefix="<li>",
                 item.suffix="</li>\n"),
          numbered=
            list(list.prefix="<ol>\n",
                 list.suffix="</ol>\n",
                 name.prefix="<li>",
                 name.suffix=": ",
                 item.with.name.prefix="",
                 item.no.name.prefix="<li>",
                 item.suffix="</li>\n"),
          definition=
            list(list.prefix="<dl>\n",
                 list.suffix="</dl>\n",
                 name.prefix="<dt>",
                 name.suffix="</dt>\n",
                 item.with.name.prefix="<dd>",
                 item.no.name.prefix="<dd>",
                 item.suffix="</dd>\n")),
      latex=
        list(
          bullet=
            list(list.prefix="\n\\begin{itemize}\n",
                 list.suffix="\n\\end{itemize}\n",
                 name.prefix="\\item ",
                 name.suffix=": ",
                 item.with.name.prefix="",
                 item.no.name.prefix="\\item ",
                 item.suffix="\n"),
          numbered=
            list(list.prefix="\n\\begin{enumerate}\n",
                 list.suffix="\n\\end{enumerate}\n",
                 name.prefix="\\item ",
                 name.suffix=": ",
                 item.with.name.prefix="",
                 item.no.name.prefix="\\item ",
                 item.suffix="\n"),
          definition=
            list(list.prefix="\n\\begin{description}\n",
                 list.suffix="\n\\end{description}\n",
                 name.prefix="\\item[",
                 name.suffix="]",
                 item.with.name.prefix=" ",
                 item.no.name.prefix="\\item",
                 item.suffix="\n")),
      txt=
        list(
          bullet=
            list(list.prefix="\n",
                 list.suffix=NA,
                 name.prefix="* ",
                 name.suffix=": ",
                 item.with.name.prefix="",
                 item.no.name.prefix="* ",
                 item.suffix="\n",
                 indent="    "),
          numbered=
            list(list.prefix="\n",
                 list.suffix=NA,
                 name.prefix="1. ",
                 name.suffix=": ",
                 item.with.name.prefix="",
                 item.no.name.prefix="1. ",
                 item.suffix="\n",
                 indent="    "),
          definition= # almost the same as bullet
            list(list.prefix="\n",
                 list.suffix=NA,
                 name.prefix="* ",
                 name.suffix=": ",
                 item.with.name.prefix="",
                 item.no.name.prefix="* ",
                 item.suffix="\n",
                 indent="    ")))
  # Generate the output
  knested_list_helper(x, use.names=use.names,
                      styling=liststyling[[format]][[listtype]],
                      indent=0,
                      ...)
}

knested_list_indent <- function(indent, styling) {
  if (indent > 0 && ("indent" %in% names(styling)) && !is.na(styling$indent)) {
    styling$indent
  }  else {
    ""
  }
}

knested_list_item_prefix <- function(use.names, has.name, styling) {
  if (use.names & has.name) {
    styling$item.with.name.prefix
  } else {
    styling$item.no.name.prefix
  }
}

knested_list_name_prefix <- function(use.names, has.name, styling) {
  if (use.names & has.name) {
    styling$name.prefix
  } else {
    ""
  }
}

knested_list_name_suffix <- function(use.names, has.name, styling) {
  if (use.names & has.name) {
    styling$name.suffix
  } else {
    ""
  }
}

knested_list_helper <- function(x, use.names, styling, indent, ...)
  UseMethod("knested_list_helper")

knested_list_helper.list <- function(x, use.names, styling, indent, ...) {
  if (!is.na(styling$list.prefix)) {
    prefix <- styling$list.prefix
  } else {
    prefix <- ""
  }
  if (!is.na(styling$list.suffix)) {
    suffix <- styling$list.suffix
  } else {
    suffix <- ""
  }
  if (!use.names || is.null(names(x))) {
    has.name <- rep(FALSE, length(x))
    name.text <- rep("", length(x))
  } else  {
    name.text <- names(x)
    has.name <- !(name.text %in% "")
  }
  retitems <-
    lapply(X=seq_along(x),
           FUN=function(i) {
             indent.text <- knested_list_indent(indent, styling)
             name.prefix <- knested_list_name_prefix(use.names, has.name[i], styling)
             name.text <- as.character(name.text[i])
             name.suffix <- knested_list_name_suffix(use.names, has.name[i], styling)
             item.prefix <- knested_list_item_prefix(use.names, has.name[i], styling)
             item.text <- knested_list_helper(x[[i]], use.names, styling, indent=indent + 1, ...)
             item.suffix <- styling$item.suffix
             paste0(indent.text,
                    name.prefix, name.text, name.suffix,
                    item.prefix, item.text, item.suffix)
           })
  paste0(prefix,
         do.call(paste0, unname(retitems)),
         suffix)
}

knested_list_helper.character <- function(x, use.names, styling, indent,
                                          sep=" ", collapse=", ", ...) {
  if (length(x) == 0) {
    "''"
  } else if (length(x) == 1) {
    x
  } else {
    paste(x, sep=sep, collapse=collapse)
  }
}

knested_list_helper.data.frame <- function(x, use.names, styling, indent, ...) {
  # I'm not sure that this is a good idea...
  knitr::kable(x, ...)
}

knested_list_helper.default <- function(x, use.names, styling, indent, ...) {
  knested_list_helper(as.character(x, ...), use.names, styling, indent, ...)
}

for (fmt in c("txt", "html", "latex")) {
  for (listfmt in c("bullet", "numbered", "definition")) {
    cat(fmt, listfmt, "\n\n")
    cat(
      knested_list(list(a=1, b=list(c="c", d=factor("D"))),
                   format=fmt,
                   listtype=listfmt))
    cat("\n")
  }
}