R/lyrics.R

Defines functions .tabr_print4 summary.lyrics print.lyrics lyrics_template .check_lyrics is_lyrics .aslyrics as_lyrics lyrical

Documented in as_lyrics is_lyrics lyrical lyrics_template

#' Create lyrics and check lyrics string validity
#'
#' Functions for creating and checking lyrics objects.
#'
#' The `lyrics` class is a simple class for arranging lyrics text by timestep.
#' Its structure and behavior aligns with that of the classes `noteworthy`,
#' `noteinfo` and `music`.
#'
#' `lyrical()` is a trivial function that returns a scalar logical result
#' essentially for any object that inherits from character, though this check
#' may become more specific in the future.
#'
#' `as_lyrics()` can be used to coerce to the `lyrics` class. Coercion will fail
#' if the string is not lyrical. The `lyrics` class has its own `print()` and
#' `summary()` methods.
#'
#' When `format = NULL`, the timestep delimiter format is inferred from the
#' lyrical string input.
#'
#' @param x character or lyrics object. For `lyrics_template()`, an integer or
#' one of the classes `noteworthy`, `noteinfo` or `music` to derive the number
#' of timesteps from.
#' @param format `NULL` or character, the timestep delimiter format, `"space"`
#' or `"vector"`.
#'
#' @return depends on the function
#' @export
#' @name lyrics
#'
#' @examples
#' # space-delimited lyrics; use periods for timesteps with no lyric
#' x <- "These are the ly- rics . . . to this song"
#' is_lyrics(x)
#' lyrical(x)
#' as_lyrics(x)
#'
#' # character vector; empty, period or NA for no lyric
#' x <- c("These", "are", "the", "ly-", "rics",
#'        "", ".", NA, "to", "this", "song") #
#' as_lyrics(x)
#'
#' # generate empty lyrics object from noteworthy, noteinfo or music object
#' notes <- as_noteworthy("c d e d c r*3 e g c'")
#' x <- lyrics_template(notes)
#' x
#'
#' x[1:5] <- strsplit("These are the ly- rics", " ")[[1]]
#' x[9:11] <- c("to", "this", "song")
#' x
#'
#' summary(x)
#'
#' attributes(x)
lyrical <- function(x){
  if(is_lyrics(x)) return(TRUE)
  .check_lyrics(x, FALSE)
}

#' @export
#' @rdname lyrics
as_lyrics <- function(x, format = NULL){
  if(inherits(x, "lyrics") & is.null(format)) return(x)
  if(is.null(format)) format <- .infer_time_format(x)
  .check_lyrics(x)
  .check_format_arg(format)
  .aslyrics(x, format)
}

.aslyrics <- function(x, format = "space"){
  x <- .uncollapse(x)
  x[is.na(x) | x == ""] <- "."
  steps <- length(x)
  npause <- length(which(x == "."))
  nlyric <- steps - npause
  if(format == "space"){
    if(length(x) > 1) x <- paste(x, collapse = " ")
    format <- "space-delimited time"
  } else {
    format <- "vectorized time"
  }
  attributes(x) <- list(steps = steps, n_lyric = nlyric, n_pause = npause,
                        format = format)
  class(x) <- unique(c("lyrics", class(x)))
  x
}

#' @export
#' @rdname lyrics
is_lyrics <- function(x){
  inherits(x, "lyrics")
}

.check_lyrics <- function(x, err = TRUE){
  if(inherits(x, "character")){
    if(err) return(invisible()) else return(TRUE)
  }
  if(err)
    stop("Lyrics do not inherit from character.", call. = FALSE) else FALSE
}

#' @export
#' @rdname lyrics
lyrics_template <- function(x, format = NULL){
  if(is.numeric(x)) return(as_lyrics(rep(".", x), format))
  if(is_noteworthy(x) | is_noteinfo(x) | is_music(x)){
    if(is.null(format)) format <- if(is_space_time(x)) "space" else "vector"
    as_lyrics(rep(".", length(x)), format)
  } else {
    stop("`x` must be an integer, or `noteworthy`, `noteinfo` or `music`.",
         call. = FALSE)
  }
}

#' @export
print.lyrics <- function(x, ...){
  a <- attributes(x)
  col1 <- crayon::make_style("gray50")
  col2 <- col1$bold
  if(length(as.character(x)) == 1) x <- .uncollapse(x)
  cat(col2("<Lyrics string>\n  Format: "), a$format, col2("\n  Values: "),
      col1(.tabr_print4(x)), "\n", sep = "")
}

#' @export
summary.lyrics <- function(object, ...){
  a <- attributes(object)
  col1 <- crayon::make_style("gray50")
  col2 <- col1$bold
  cat(col2("<Lyrics string>\n  Timesteps: "), a$steps, " (",
      a$n_lyric, " ", paste0("lyric", ifelse(a$n_lyric == 1, "", "s")), ", ",
      a$n_pause, " ", paste0("pause", ifelse(a$n_pause == 1, "", "s"), ")"),
      col2("\n  Format: "), a$format, col2("\n  Values: "),
      col1(.tabr_print4(.uncollapse(as.character(object)))), "\n", sep = "")
}

.tabr_print4 <- function(x){
  col1 <- crayon::make_style("dodgerblue")$bold
  col2 <- crayon::make_style("orange2")
  x <- .uncollapse(x)
  x <- col1(x)
  x <- gsub("(\\.)", col2("\\1"), x)
  paste(x, collapse = " ")
}
leonawicz/tabr documentation built on Sept. 24, 2023, 2:49 p.m.