R/pin_dataframe.R

In javierluraschi/pins: Pin, Discover and Share Resources

pin_dataframe_sanitize <- function(name) {
  error <- "Can't auto-generate pin name from object, please specify the 'name' parameter."
  if (length(name) != 1) stop(error)

  sanitized <- gsub("[^a-zA-Z0-9-]", "-", name)
  sanitized <- gsub("^-*|-*$", "", sanitized)
  sanitized <- gsub("-+", "-", sanitized)

  if (nchar(sanitized) == 0) stop(error)

  # kaggle boards require five or more character names
  if (nchar(sanitized) < 5) sanitized <- paste(sanitized, "pin", sep = "-")

  sanitized
}

#' @keywords internal
#' @export
pin.data.frame <- function(x, name = NULL, description = NULL, board = NULL, ...) {
  if (is.null(name)) name <- pin_dataframe_sanitize(deparse(substitute(x)))

  path <- tempfile(fileext = ".rds")
  saveRDS(x, path, version = 2)
  on.exit(unlink(path))

  metadata <- list(
    rows = nrow(x),
    cols = ncol(x)
  )

  board_pin_store(board_get(board), path, name, description, "table", metadata,...)
}

#' @keywords internal
#' @export
pin_load.table <- function(path, ...) {
  readRDS(path)
}

#' @keywords internal
#' @export
pin_preview.data.frame <- function(x, board = NULL, ...) {
  head(x, n = getOption("pins.preview", 10^3))
}