R/tiny_label.R

In labeleR: Automate the Production of Custom Labels, Badges, Certificates, and Other Documents

#' Create tiny labels
#'
#' Create tiny labels (16 labels per DIN-A4 page)
#'
#' @param data a data frame including information of a species
#' @param path Character. Path to folder where the PDF file will be saved.
#' @param filename Character. Filename of the pdf. If NULL, default is "Tiny_label".
#' @param qr String. Free text or column of `data` that specifies the link for the QR code.
#'          If the specified value of `qr` is not a column name of `data`,
#'          all the QRs will be equal, pointing to the same link.
#' @param field1.column Character (optional). Name of the column in `data` storing the first free text to
#' appear at the top of the label.
#' @param field2.column Character (optional). Name of the column in `data` storing the second free text to
#' appear below field1.
#' @param field3.column Character (optional). Name of the column in `data` storing the third free text to
#' appear below field2.
#' @param field4.column Character (optional). Name of the column in `data` storing the fourth free text to
#' appear below field3.
#' @param field5.column Character (optional). Name of the column in `data` storing the fifth free text to
#' appear below field4.
#' @inheritParams create_badge
#'
#' @return A PDF file named "Tiny_label.pdf" is saved on disk, in the folder defined
#' by `path`. If `keep.files = TRUE`, an RMarkdown file will also appear in the same folder.
#'
#' @export
#'
#' @author  Ignacio Ramos-Gutierrez, Julia G. de Aledo, Francisco Rodriguez-Sanchez
#'
#' @examplesIf interactive()
#' create_tiny_label(
#'   data = tiny.table,
#'   qr = "QR_code",
#'   path = "labeleR_output",
#'   field1.column = "field1",
#'   field2.column = "field2",
#'   field3.column = "field3",
#'   field4.column = "field4",
#'   field5.column = "field5"
#' )
#'

create_tiny_label <- function(data = NULL,
                             qr = NULL,
                             path = NULL,
                             filename = NULL,
                             field1.column = NULL,
                             field2.column = NULL,
                             field3.column = NULL,
                             field4.column = NULL,
                             field5.column = NULL,
                             keep.files = FALSE,
                             template = NULL) {

  ## Check arguments

  if (is.null(data)) {
    stop("Please provide a data.frame or tibble.")
  }

  if ((!(all(class(data) == "data.frame"))) & any(class(data) == "data.frame")) {data <- as.data.frame(data)}
  if (!inherits(data, "data.frame")) {stop("The 'data' object must be a data frame.")}
  data <- fill_NAs_df(data)

  if (is.null(path)) {stop("A folder path must be specified.")}
  if (!file.exists(path)) {
    message("The specified folder does not exist. Creating folder")
    dir.create(path)
  }

  if (is.null(filename)) {
    message("No file name provided")
    filename <- "Tiny_label"
  }


  if (any(apply(data, 1, nchar) > 150)) {
    message("Too long texts may give undesired results. Please consider shortening long fields.")
  }


  ## QR code

  if (!is.null(qr)) {
    stopifnot(is.character(qr))
    # If qr is not a column in data, use same qr for all items
    if (!(qr %in% colnames(data))) {
      data$qr <- qr   # recycling to all rows in data
      qr <- "qr"    # used later for selecting column
    }
  }
  if (is.null(qr)) {
    message("No qr provided")
    data$qr <- ""
    qr <- "qr"    # used later for selecting column
  }



  ## Check columns are in data or create empty characters if NULL

  field1.column <- check_column_or_create_empty_char(data, field1.column)
  field2.column <- check_column_or_create_empty_char(data, field2.column)
  field3.column <- check_column_or_create_empty_char(data, field3.column)
  field4.column <- check_column_or_create_empty_char(data, field4.column)
  field5.column <- check_column_or_create_empty_char(data, field5.column)

  arguments <- c(field1.column,field2.column,field3.column,field4.column,field5.column)
  arguments <- arguments[arguments != ""]

  data <- check_latex_columns(data, arguments)




  ## Keep intermediate files? If no, using tempdir for intermediate files
  if (!isTRUE(keep.files)) {
    folder <- tempdir()
  } else {
    folder <- path  # all files will remain there
  }


  ## Defining Rmd template to use
  if (is.null(template)) {
    # use pkg default
    file.copy(
      from = system.file("rmarkdown/templates/tiny_label/skeleton/skeleton.Rmd", package = "labeleR"),
      to = file.path(folder, "tiny_label.Rmd"),
      overwrite = TRUE
    )
  } else {
    stopifnot(file.exists(template))
    file.copy(
      from = template,
      to = file.path(folder, "tiny_label.Rmd"),
      overwrite = TRUE
    )
  }


  ## Render
  output_file <- paste0(filename,'.pdf')
  data <- as.data.frame(data) ## to exploit drop = TRUE when selecting cols below
  bl.char <- rep("~", times = nrow(data))

  rmarkdown::render(
    input = file.path(folder, "tiny_label.Rmd"),
    output_dir = path,
    output_file = output_file,
    params = list(
      qr.i = data[, qr],
      field1.i = if (field1.column == "") {bl.char} else {data[,field1.column]},
      field2.i = if (field2.column == "") {bl.char} else {data[,field2.column]},
      field3.i = if (field3.column == "") {bl.char} else {data[,field3.column]},
      field4.i = if (field4.column == "") {bl.char} else {data[,field4.column]},
      field5.i = if (field5.column == "") {bl.char} else {data[,field5.column]}
    )
  )

}