R/tracks.R

Defines functions score trackbind .check_phrase_strings track_bass track_bc track_tc track chord_set

Documented in chord_set score track track_bass track_bc trackbind track_tc

#' Generate a chord set
#'
#' Generate a chord set for a music score.
#'
#' The chord set list returned by `chord_set()` is only used for top center
#' placement of a full set of chord fretboard diagrams for a music score.
#' `chord_set()` returns a named list. The names are the chords and the list
#' elements are strings defining string and fret fingering readable by LilyPond.
#' Multiple chord positions can be defined for the same chord name.
#' Instruments with a number of strings other than six are not currently
#' supported.
#'
#' When defining chords, you may also wish to define rests or silent rests for
#' chords that are to be added to a score for placement above the staff in
#' time, where no chord is to be played or explicitly written.
#' Therefore, there are occasions where you may pass chord names and positions
#' that happen to include entries `r` and/or `s` as `NA` as shown in the
#' example. These two special cases are passed through by `chord_set()` but are
#' ignored when the chord chart is generated.
#'
#' @param x character, n-string chord description from lowest to highest pitch,
#' strings n through 1. E.g., `"xo221o"`. You can use spaces or semicolons
#' when 2-digit fret numbers are present, e.g., `"8 10 10 9 o"`. Do not mix
#' formats. Leading `x` are inferred if the number of entries is less than `n`.
#' @param id character, the name of the chord in LilyPond readable format,
#' e.g., `"a:m"`. Ignored if `x` is already a named vector.
#' @param n number of instrument strings.
#'
#' @return a named list.
#' @export
#'
#' @examples
#' chord_names <- c("e:m", "c", "d", "e:m", "d", "r", "s")
#' chord_position <- c("997x", "5553x", "7775x", "ooo22o", "232oxx", NA, NA)
#' chord_set(chord_position, chord_names)
chord_set <- function(x, id = NULL, n = 6){
  if(!is.null(names(x))) id <- names(x)
  idx <- which(is.na(x))
  if(length(idx)){
    x2 <- x[idx]
    names(x2) <- id[idx]
  }
  x <- x[!is.na(x)]
  id <- id[!id %in% c("r", "s")]
  f <- function(x){
    if(grepl(";", x)){
      if(!grepl(";$", x)) x <- paste0(x, ";")
    } else if(grepl(" ", x)){
      x <- paste0(gsub(" ", ";", trimws(x)), ";")
    } else {
      x <- strsplit(x, "")[[1]]
      x <- paste0(paste(x, collapse = ";"), ";")
    }
    n0 <- length(strsplit(x, ";")[[1]])
    if(n0 > n)
      stop("Cannot have more fret values than number of instrument strings.",
           call. = FALSE)
    if(n0 < n) x <- paste(c(rep("x", n - n0), x), collapse = ";")
    gsub("0", "o", x)
  }
  x <- purrr::map_chr(x, f)
  names(x) <- id
  if(length(idx)) x <- c(x, x2)
  x
}

#' Create a music track
#'
#' Create a music track from a collection of musical phrases.
#'
#' Musical phrases generated by [phrase()] are fortified in a track table. All
#' tracks are stored as track tables, one per row, even if that table consists
#' of a single track. `track()` creates a single-entry track table. See
#' [trackbind()] for merging single tracks into a multi-track table. This is row
#' binding that also properly preserves phrase and track classes.
#'
#' There are various `track_*` functions offering sensible defaults based on the
#' function suffix. The base `track()` function is equivalent to
#' `track_guitar()`. See examples. Setting `clef = NA` or `tab = NA` suppresses
#' the music staff or tablature staff, respectively. By default `key = NA`, in
#' which case its inherits the global key from the `key` argument of various
#' sheet music rendering functions. If planning to bind two tracks as one where
#' they are given `voice = 1` and `voice = 2`, respectively, they must also have
#' a common key, even if `key = NA`.
#'
#' `lyrics` should only be used for simple tracks that do not contain repeats.
#' You also need to ensure the timesteps for `lyrics` align with those of
#' `phrase()` in advance. Additionally, LilyPond does not engrave lyrics at
#' rests or tied notes (excluding first note in tied sequence) so if Therefore,
#' if `phrase()` contains rests and tied notes then the lyrics object should be
#' subset to exclude these timesteps as well. This is in contrast to using
#' `render_music*` functions, which handle this automatically for music objects.
#'
#' @param phrase a phrase object.
#' @param clef character, include a music staff with the given clef. `NA` to
#' suppress. See details.
#' @param key character, key signature for music staff. See details.
#' @param tab logical, include tablature staff. `NA` to suppress.
#' @param tuning character, pitches describing the instrument string tuning or
#' a predefined tuning ID. See [tunings()].
#' Defaults to standard guitar tuning; not relevant if tablature staff is
#' suppressed.
#' @param voice integer, ID indicating the unique voice `phrase()` belongs
#' to within a single track (another track may share the same tab/music staff
#' but have a different voice ID). Up to two voices are supported per track.
#' @param lyrics a lyrics object or `NA`. See details.
#'
#' @return a tibble data frame
#' @export
#' @seealso [phrase()], [score()]
#'
#' @examples
#' x <- phrase("c ec'g' ec'g'", "4 4 2", "5 4 4")
#' track(x) # same as track_guitar(x); 8va treble clef above tab staff
#' track_tc(x) # treble clef sheet music, no tab staff
#' track_bc(x) # bass clef sheet music, no tab staff
#'
#' x <- phrase("c, g,c g,c", "4 4 2", "3 2 2")
#' track_bass(x) # includes tab staff and standard bass tuning
track <- function(phrase, clef = "treble_8", key = NA, tab = TRUE,
                  tuning = "standard", voice = 1, lyrics = NA){
  if(!"phrase" %in% class(phrase))
    stop("`phrase` is not a phrase object.", call. = FALSE)
  if(is.na(clef) & !tab)
    stop("Cannot have both `clef = NA` and `tab = FALSE`.", call. = FALSE)
  tuning <- .map_tuning(tuning)
  .check_phrase_strings(phrase, tuning)
  if(is_lyrics(lyrics)) lyrics <- as_space_time(lyrics)
  lyrics <- as.character(lyrics)

  x <- tibble::tibble(
    phrase, clef = as.character(clef), key = as.character(key), tab = tab,
    tuning = tuning, voice = as.integer(voice), lyrics = lyrics)
  x$phrase <- purrr::map(x$phrase, ~as_phrase(.x))
  class(x) <- unique(c("track", class(x)))
  x
}

#' @export
#' @rdname track
track_guitar <- track

#' @export
#' @rdname track
track_tc <- function(phrase, key = NA, voice = 1, lyrics = NA){
  track(phrase, "treble", key, FALSE, "standard", voice, lyrics)
}

#' @export
#' @rdname track
track_bc <- function(phrase, key = NA, voice = 1, lyrics = NA){
  track(phrase, "bass", key, FALSE, "standard", voice, lyrics)
}

#' @export
#' @rdname track
track_bass <- function(phrase, key = NA, voice = 1, lyrics = NA){
  track(phrase, "bass_8", key, FALSE, "bass", voice, lyrics)
}

.check_phrase_strings <- function(phrase, tuning){
  n <- length(.split_chords(tuning))
  ps <- tryCatch(phrase_strings(phrase, TRUE), error = function(e) NULL)
  if(is.null(ps)){
    p2 <- gsub("\\\\repeat (unfold|percent|volta) \\d+ \\{ | \\}|\n", "",
               phrase)
    p2 <- gsub("\\\\tuplet \\d+/\\d+ \\d+ \\{ | \\}|\n", "",
               phrase)
    ps <- tryCatch(phrase_strings(p2, TRUE), error = function(e) NULL)
  }
  if(!is.null(ps)){
    s <- as.integer(strsplit(gsub(" |NA", "", ps), "")[[1]])
    if(any(!is.na(s))){
      if(any(s > n))
        stop("String number exceeds number of strings from `tuning`.",
             call. = FALSE)
    }
  }
}

#' Bind track tables
#'
#' Bind together track tables by row.
#'
#' This function appends multiple track tables into a single track table for
#' preparation of generating a multi-track score. `id` is used to separate
#' staves in the sheet music/tablature output. A track's `voice` is used to
#' separate distinct voices within a common music staff.
#'
#' If not provided, `id` automatically propagates `1:n` for `n` tracks passed to
#' `...` when binding these tracks together. This expresses the default
#' assumption of one staff or music/tab staff pair per track. This is the
#' typical use case.
#'
#' Some tracks represent different voices that share the same staff.
#' These should be assigned the same `id`, in which case you must
#' provide the `id` argument. Up to two voices per track are supported.
#' An error will be thrown if any two tracks have both the same `voice`
#' and the same `id`. The pair must be unique. E.g., provide `id = c(1, 1)` when
#' you have two tracks with `voice` equal to 1 and 2. See examples.
#'
#' Note that the actual ID values assigned to each track do not matter;
#' only the order in which tracks are bound, first to last.
#'
#' @param ... single-entry track data frames.
#' @param id integer, ID vector indicating distinct tracks corresponding to
#' distinct sheet music staves. See details.
#'
#' @return a tibble data frame
#' @export
#' @seealso [phrase()], [track()], [score()]
#'
#' @examples
#' x <- phrase("c ec'g' ec'g'", "4 4 2", "5 432 432")
#' x1 <- track(x)
#' x2 <- track(x, voice = 2)
#' trackbind(x1, x1)
#' trackbind(x1, x2, id = c(1, 1))
trackbind <- function(..., id){
  x <- list(...)
  if(!all(purrr::map_lgl(x, ~any(class(.x) == "track"))))
    stop("All arguments must be `track` tables.", call. = FALSE)
  y <- if(missing(id)) seq_along(x) else id
  x <- purrr::map2(x, y, ~dplyr::mutate(.x, id = as.integer(.y)))
  x <- suppressWarnings(dplyr::bind_rows(x))
  d <- dplyr::distinct(x, .data[["voice"]], .data[["id"]])
  if(nrow(d) < nrow(x))
    stop(paste("track `voice` and `id` ID combination must be unique",
               "across track rows."), call. = FALSE)
  n <- purrr::map_int(split(x, x$id), ~{
    nrow(dplyr::distinct(.x, .data[["id"]], .data[["key"]]))
  })
  if(any(n > 1))
    stop(paste("A single track with two voices must have a common key."),
         call. = FALSE)
  x$phrase <- purrr::map(x$phrase, ~as_phrase(.x))
  class(x) <- unique(c("track", class(x)))
  x
}

#' Create a music score
#'
#' Create a music score from a collection of tracks.
#'
#' Score takes track tables generated by [track()] and fortifies them
#' as a music score. It optionally binds tracks with a set of chord diagrams.
#' There may be only one track in `track()` as well as no chord information
#' passed, but for consistency `score()` is still required to fortify the
#' single track as a score object that can be rendered by [tab()].
#'
#' @param track a track table consisting of one or more tracks.
#' @param chords an optional named list of chords and respective fingerings
#' generated by `chord_set`, for inclusion of a top center chord diagram chart.
#' @param chord_seq an optional named vector of chords and their durations, for
#' placing chord diagrams above staves in time.
#'
#' @return a tibble data frame
#' @export
#' @seealso [phrase()], [track()], [trackbind()]
#'
#' @examples
#' x <- phrase("c ec'g' ec'g'", "4 4 2", "5 432 432")
#' x <- track(x)
#' score(x)
score <- function(track, chords = NULL, chord_seq = NULL){
  cl <- class(track)
  if(!"track" %in% cl) stop("`track` is not a `track` table.", call. = FALSE)
  if(!"id" %in% names(track)) track <- dplyr::mutate(track, id = 1L)
  class(track) <- unique(c("score", cl))
  attr(track, "chords") <- chords
  attr(track, "chord_seq") <- chord_seq
  track
}

Try the tabr package in your browser

Any scripts or data that you put into this service are public.

tabr documentation built on Sept. 21, 2023, 5:06 p.m.