/
phrase_helpers.R
271 lines (261 loc) · 8.67 KB
/
phrase_helpers.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
#' Tied notes
#'
#' Tie notes efficiently.
#'
#' This function is useful for bar chords.
#'
#' @param x character, a single chord.
#'
#' @return a character string.
#' @export
#'
#' @examples
#' tie("e,b,egbe'")
tie <- function(x){
.check_noteworthy(x)
y <- .uncollapse(x)
if(any(grepl("~", y))) y <- gsub("~", "", y)
y <- sapply(y, function(x) paste0(.split_chord(x), "~", collapse = ""),
USE.NAMES = FALSE)
if(length(x) == 1) y <- paste(y, collapse = " ")
.asnw(y)
}
#' @export
#' @rdname tie
untie <- function(x){
.check_noteworthy(x)
.asnw(gsub("~", "", x))
}
#' Create rests
#'
#' Create multiple rests efficiently with a simple wrapper around `rep()` using
#' the `times` argument.
#'
#' @param x integer, duration.
#' @param n integer, number of repetitions.
#'
#' @return a character string.
#' @export
#'
#' @examples
#' rest(c(1, 8), c(1, 4))
rest <- function(x, n = 1){
paste0(rep(paste0("r", x), times = n), collapse = " ")
}
#' Add text to music staff
#'
#' Annotate a music staff, vertically aligned above or below the music staff at
#' a specific note/time.
#'
#' This function binds text annotation in LilyPond syntax to a note's
#' associated `info` entry.
#' Technically, the syntax is a hybrid form, but is later updated safely and
#' unambiguously to LilyPond syntax with respect to the rest of the note info
#' substring when it is fed to `phrase()` for musical phrase assembly.
#'
#' @param x character.
#' @param text character.
#' @param position character, top or bottom.
#'
#' @return a character string.
#' @export
#'
#' @examples
#' notate("8", "Solo")
#' phrase("c'~ c' d' e'", pc(notate(8, "First solo"), "8 8 4."), "5 5 5 5")
notate <- function(x, text, position = "top"){
pos <- switch(position, top = "^", bottom = "_")
paste0(x, ";", pos, "\"", gsub(" ", "_", text), "\"", collapse = " ")
}
#' Concatenate and repeat
#'
#' Helper functions for concatenating musical phrases and raw strings
#' together as well as repetition.
#'
#' Note: When working with special `tabr` classes, you can simply use generics
#' like `c()` and `rep()` as many custom methods exist for these classes. The
#' additional respective helper functions, `pc()` and `pn()`, are more
#' specifically for phrase objects and when you are still working with character
#' strings, yet to be converted to a phrase object (numbers not yet in string
#' form are allowed). See examples.
#'
#' The functions `pc()` and `pn()` are based on base functions `paste()` and
#' `rep()`, respectively, but are tailored for efficiency in creating musical
#' phrases.
#'
#' These functions respect and retain the phrase class when applied to phrases.
#' They are aggressive for phrases and secondarily for noteworthy strings.
#' Combining a phrase with a non-phrase string will assume compatibility and
#' result in a new phrase object.
#' If no phrase objects are present, the presence of any noteworthy string will
#' in turn attempt to force conversion of all strings to noteworthy strings.
#' The aggressiveness provides convenience, but is counter to expected coercion
#' rules. It is up to the user to ensure all inputs can be forced into the more
#' specific child class.
#'
#' This is especially useful for repeated instances. This function applies to
#' general slur notation as well.
#' Multiple input formats are allowed. Total number of note durations must be
#' even because all slurs require start and stop points.
#'
#' @param ... character, phrase or non-phrase string.
#' @param x character, phrase or non-phrase string.
#' @param n integer, number of repetitions.
#' @name append_phrases
#'
#' @return phrase on non-phrase character string, noteworthy string if
#' applicable.
#'
#' @examples
#' pc(8, "16-", "8^")
#' pn(1, 2)
#' x <- phrase("c ec'g' ec'g'", "4 4 2", "5 432 432")
#' y <- phrase("a", 1, 5)
#' pc(x, y)
#' pc(x, pn(y, 2))
#' pc(x, "r1") # add a simple rest instance
#' class(pc(x, y))
#' class(pn(y, 2))
#' class(pc(x, "r1"))
#' class(pn("r1", 2))
#' class(pc("r1", "r4"))
NULL
#' @export
#' @rdname append_phrases
pc <- function(...){
x <- list(...)
classes <- unlist(lapply(x, class))
if(any(!classes %in% c("phrase", "noteworthy", "character", "numeric", "integer")))
stop("pc() is only for phrase objects, noteworthy and simple character strings.",
call. = FALSE)
any_phrase <- any(classes == "phrase")
nw <- any(sapply(unlist(x), noteworthy))
x <- trimws(gsub("\\s\\s+", " ", paste(unlist(x), collapse = " ")))
if(any_phrase){
class(x) <- unique(c("phrase", class(x)))
} else if(nw){
x <- .asnw(x)
}
x
}
#' @export
#' @rdname append_phrases
pn <- function(x, n = 1){
classes <- class(x)
if(any(!classes %in% c("phrase", "noteworthy", "character", "numeric", "integer")))
stop("pn() is only for phrase objects, noteworthy and simple character strings.",
call. = FALSE)
if(n == 0) n <- 1
y <- trimws(gsub("\\s\\s+", " ", paste(rep(x, n), collapse = " ")))
if("phrase" %in% classes){
class(y) <- unique(c("phrase", class(y)))
} else if(is.character(x) && noteworthy(x)){
y <- .asnw(y)
}
y
}
#' Hammer ons and pull offs
#'
#' Helper function for generating hammer on and pull off syntax.
#'
#' This is especially useful for repeated instances. This function applies to
#' general slur notation as well.
#' Multiple input formats are allowed. Total number of note durations must be
#' even because all slurs require start and stop points.
#'
#' @param ... character, note durations. Numeric is allowed for lists of single
#' inputs. See examples.
#'
#' @return character.
#' @export
#'
#' @examples
#' hp(16, 16)
#' hp("16 16")
#' hp("16 8 16", "8 16 8")
hp <- function(...){
x <- unlist(purrr::map(list(...), ~{
paste0(strsplit(as.character(paste0(.x, collapse = " ")), " ")[[1]])
}))
if(length(x) %% 2 == 1)
stop("Even number of arguments required.", call. = FALSE)
idx <- seq_along(x) %% 2 == 0
x[idx == TRUE] <- paste0(x[idx == TRUE], ")")
x[idx == FALSE] <- paste0(x[idx == FALSE], "(")
paste(x, collapse = " ")
}
#' Tuplets
#'
#' Helper function for generating tuplet syntax.
#'
#' This function gives control over tuplet construction. The default arguments
#' `a = 3` and `b = 2` generates a triplet where three triplet notes,
#' each lasting for two thirds of a beat, take up two beats.
#' `n} is used to describe the beat duration with the same
#' fraction-of-measure denominator notation used for notes in `tabr` phrases,
#' e.g., 16th note triplet, 8th note triplet, etc.
#'
#' If you provide a note sequence for multiple tuplets in a row of the same
#' type, they will be connected automatically. It is not necessary to call
#' `tuplet()` each time when the pattern is constant.
#' If you provide a complete phrase object, it will simply be wrapped in the
#' tuplet tag, so take care to ensure the phrase contents make sense as part of
#' a tuplet.
#'
#' @param x noteworthy string or phrase object.
#' @param n integer, duration of each tuplet note, e.g., 8 for 8th note tuplet.
#' @param string, character, optional string or vector with same number of
#' timesteps as `x` that specifies which strings to play for each specific
#' note. Only applies when `x` is a noteworthy string.
#' @param a integer, notes per tuplet.
#' @param b integer, beats per tuplet.
#'
#' @return phrase
#' @export
#'
#' @examples
#' tuplet("c c# d", 8)
#' triplet("c c# d", 8)
#' tuplet("c c# d c c# d", 4, a = 6, b = 4)
#'
#' p1 <- phrase("c c# d", "8-. 8( 8)", "5*3")
#' tuplet(p1, 8)
tuplet <- function(x, n, string = NULL, a = 3, b = 2){
if("phrase" %in% class(x)){
x <- paste0("\\tuplet ", a, "/", b, " ", n / b, " { ", x, " }")
class(x) <- c("phrase", class(x))
return(x)
} else {
notes <- x
}
notes <- .uncollapse(notes)
notes <- .octave_to_tick(.notesub(notes))
s <- !is.null(string)
if(s){
string <- .uncollapse(string)
if(length(string) == 1) string <- rep(string, length(notes))
if(length(string) != length(notes))
stop(paste("`string` must have the same number of timesteps as `x`,",
"or a single value to repeat, or be NULL."), call. = FALSE)
string <- .strsub(string)
}
notes <- purrr::map_chr(
seq_along(notes),
~paste0(
"<", paste0(.split_chord(notes[.x]),
if(s && notes[.x] != "r" && notes[.x] != "s")
paste0("\\", .split_chord(string[.x], TRUE)),
collapse = " "), ">"))
notes[1] <- paste0(notes[1], n)
notes <- paste0(notes, collapse = " ")
notes <- gsub("<r>", "r", notes)
notes <- gsub("<s>", "s", notes)
x <- paste0("\\tuplet ", a, "/", b, " ", n / b, " { ", notes, " }")
class(x) <- c("phrase", class(x))
x
}
#' @export
#' @rdname tuplet
triplet <- function(x, n, string = NULL){
tuplet(x = x, n = n, string = string, a = 3, b = 2)
}