Making nice

Author: klaus

.Rbuildignore

@@ -1,2 +1,5 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
+.travis.yml
+^Makefile
+data_raw

DESCRIPTION

@@ -1,21 +1,28 @@
-Package: sologenerator
+Package: parkR
 Type: Package
-Title: Generate monophonic jazz solos for chord sequences
+Title: Generates monophonic jazz solos for chord sequences
 Version: 0.1.0
-Author: NN
-Maintainer: NN <[email protected]>
+Authors@R: c(
+  person("Klaus", "Frieler", email = "[email protected]", role = c("aut","cre"))
+  )
+Maintainer: Klaus Frieler <[email protected]>
 Description: Generates jazz solos using Weimar Bebop Alphabet atoms and midlevel units based on the Weimar Jazz Database.
-License: MIT
+License: MIT + file LICENSE
 Encoding: UTF-8
+URL: https://github.com/klausfrieler/parkR
+BugReports: https://github.com/klausfrieler/parkR/issues
 LazyData: true
 Depends: 
     R (>= 3.5.0),
 Imports:
     tidyverse (>= 1.2.1),
     ggplot2,
+    ggthemes,
     dplyr,
     tibble,
     purrr,
+    purrrlyr,
+    tidyr,
     stringr,
     stats
 Suggests:

LICENSE

@@ -1,4 +1,4 @@
 This project is licensed under the terms of the MIT license.
 
 YEAR: 2021
-COPYRIGHT HOLDER: NN
+COPYRIGHT HOLDER: Klaus Frieler

NAMESPACE

@@ -13,7 +13,11 @@ export(solo_to_mcsv2)
 export(write_mcsv2)
 import(dplyr)
 import(ggplot2)
+import(ggthemes)
+import(purrr)
+import(purrrlyr)
 import(stringr)
 import(tibble)
+import(tidyr)
 importFrom(stats,chisq.test)
 importFrom(utils,write.table)

NEWS.md

@@ -1,4 +1,4 @@
-# sologenerator 0.1.0
+# parkR 0.1.0
 
 Initial version.
 

R/chords.R

@@ -422,9 +422,9 @@ shift_pc_set <- function(pc_set, shift){
 }
 find_best_matching_scale <- function(pitch_set, root = pitch_set[1]){
   if(is.list(pitch_set)){
-    print((pitch_set))
+    #print((pitch_set))
     pitch_set <- purrr::reduce(pitch_set, union)
-    print(sort(pitch_set))
+    #print(sort(pitch_set))
   }
   candidates <- purrr::map_int(scales, function(x) length(intersect(shift_pc_set(x, root), pitch_set))) %>% sort(decreasing = T)
   best = candidates[candidates == max(candidates)]
@@ -441,7 +441,7 @@ blues <- tibble(chord = c("F7","Bb7", "F7",  "Cmin7", "F7", "Bb7", "Bb7", "F7",
                 length_beats = as.integer(c(4, 4, 4, 2, 2, 4, 4, 4, 4, 4, 4, 4, 4)))
 blues <- blues %>% mutate(length_ticks = length_beats*4) %>%
                           mutate(parsed = purrr::map(chord, parse_chord)) %>%
-  unnest(cols = parsed)
+  tidyr::unnest(cols = parsed)
 blues$onset_ticks <- cumsum(blues$length_ticks)
 blues$onset_ticks <- blues$onset_ticks - blues$onset_ticks[1]
 blues$beat <- (floor(blues$onset_ticks/4) %%4 ) + 1
@@ -464,11 +464,11 @@ unroll_durations <- function(durations){
 #' @export
 create_from_irb <- function(compid, name = NULL, with_form = F){
   if(is.character(compid)){
-    sheet <- sologenerator::irb[tolower(sologenerator::irb$title) == tolower(compid),] %>%
+    sheet <- parkR::irb[tolower(parkR::irb$title) == tolower(compid),] %>%
       select(chord, duration, section, title, time, composer, date, compid, key)
   }
   else {
-    sheet <- sologenerator::irb[sologenerator::irb$compid == compid,] %>% select(chord, duration, title, time)
+    sheet <- parkR::irb[parkR::irb$compid == compid,] %>% select(chord, duration, title, time)
   }
   time <- strsplit(sheet$time[1], "/")[[1]]
   period <- as.integer(time[1])
@@ -483,7 +483,7 @@ create_from_irb <- function(compid, name = NULL, with_form = F){
     sheet %>%
     mutate(length_ticks = duration * ticks_per_beat) %>%
     mutate(parsed = purrr::map(chord, parse_chord)) %>%
-    unnest(cols = parsed)
+    tidyr::unnest(cols = parsed)
 
   sheet$onset_ticks <- unroll_durations(sheet$length_ticks)
   sheet$running_beat <- unroll_durations(sheet$duration)
@@ -516,7 +516,7 @@ create_sheet <- function(name, chords, length_beats){
                   length_beats = length_beats)
   tmp <- tmp %>% mutate(length_ticks = length_beats * 4) %>%
     mutate(parsed = purrr::map(chord, parse_chord)) %>%
-    unnest(cols = c(parsed))
+    tidyr::unnest(cols = c(parsed))
   tmp$onset_ticks <- cumsum(tmp$length_ticks)
   tmp$onset_ticks <- tmp$onset_ticks- tmp$onset_ticks[1]
   tmp$beat <- (floor(tmp$onset_ticks/4) %% 4 ) + 1
@@ -644,7 +644,7 @@ expand_chord_changes <- function(split_changes, num_choruses = 1, max_bar = NULL
   one_chorus <-
     purrr::map_dfr(1:nrow(split_changes),function(row_id){
       t <- split_changes[row_id,]
-      purrr:::map_dfr(seq(t$beat_pos, t$beat_pos + t$duration-1), function(b){
+      purrr::map_dfr(seq(t$beat_pos, t$beat_pos + t$duration-1), function(b){
         t %>% select(-beat_pos) %>%  mutate(beat_pos = b)
       })
     })

R/data.R

@@ -19,11 +19,18 @@ NULL
 #' @docType data
 NULL
 
+#' wba_mla
+#'
+#' Database of WBA atoms and midlevel units (MLUs)
+#' @name wba_mla
+#' @docType data
+NULL
+
 
 #' successor_dist
 #'
 #' First order Markov transitions of WBA atoms
-#' @name WBA_df
+#' @name successor_dist
 #' @docType data
 NULL
 
@@ -43,11 +50,18 @@ NULL
 
 #' length_dist
 #'
-#' Disbtribution of phrase lengths and relative phrase positions
+#' Disbtribution of number of phrases over WJD solos
 #' @name length_dist
 #' @docType data
 NULL
 
+#' phrase_length_dist
+#'
+#' Disbtribution of phrase lengths and relative phrase positions
+#' @name phrase_length_dist
+#' @docType data
+NULL
+
 #' F_blues
 #'
 #' Sample lead sheet of a sinple 12-bar jazz blues in F

R/imports.R

@@ -7,9 +7,21 @@ NULL
 #' @import ggplot2
 NULL
 
+#' @import ggthemes
+NULL
+
 #' @import stringr
 NULL
 
+#' @import purrr
+NULL
+
+#' @import purrrlyr
+NULL
+
+#' @import tidyr
+NULL
+
 
 #' @importFrom stats chisq.test
 NULL

R/interval_grammar.R

@@ -45,11 +45,11 @@ vec_to_value <- function(int_vec){
   sprintf("[%s]", paste(int_vec, collapse=","))
 }
 
-add_overlaps <- function(data, type=c("all", "pre", "post")) {
+add_overlaps <- function(data, type = c("all", "pre", "post")) {
   data <- data %>%
-    mutate(pre_over = data.table::shift(data$end, type="lag")- data$start + 1)
+    mutate(pre_over = dplyr::lag(data$end)- data$start + 1)
   data <- data %>%
-           mutate(post_over = data.table::shift(data$pre_over, type="lead"))
+           mutate(post_over = dplyr::lead(data$pre_over))
   if(type[1] == "all"){
     return(data)
   }
@@ -156,7 +156,7 @@ make_rle_df <- function(data, var){
 values_from_positions <- function(int_vector, data){
   values <- purrrlyr::by_row(data,
                          function(x) vec_to_value(int_vector[x$start:x$end])) %>%
-    unnest(cols = c(.out)) %>%
+    tidyr::unnest(cols = c(.out)) %>%
     as.data.frame()
 
     values[, ".out"]
@@ -165,7 +165,7 @@ values_from_positions <- function(int_vector, data){
 directions_from_positions <- function(int_vector, data){
   values <- purrrlyr::by_row(data,
                           function(x) sign(sum(int_vector[x$start:x$end]))) %>%
-    unnest(cols = c(.out)) %>%
+    tidyr::unnest(cols = c(.out)) %>%
     as.data.frame()
 
   values[, ".out"]
@@ -279,7 +279,7 @@ find_scales <- function(int_vector){
   ###### second approach#######
   #types <- purrrlyr::by_row(scales,
   #                          function(x) classify_scale(int_vector[x$start:x$end])) %>%
-  #  unnest(cols = c(.out)) %>%
+  #  tidyr::unnest(cols = c(.out)) %>%
   #  as.data.frame()
   #scales$type <- types[, ".out"]
 
@@ -315,9 +315,6 @@ find_arpeggios <- function(int_vector){
   tmp
 }
 
-by_row_result_to_vec <- function(by_row_result_tbl){
-  by_row_result_tbl %>% select(cols = c(.out)) %>% unlist()
-}
 
 find_chords <- function(int_vector){
   arp_int_vector <- sign(int_vector)*get_arp_int_from_int(int_vector)
@@ -344,11 +341,11 @@ find_chords <- function(int_vector){
 }
 
 find_trills <- function(int_vector){
-  sum_vector <- int_vector + data.table::shift(int_vector, 1, type="lead")
+  sum_vector <- int_vector + dplyr::lead(int_vector, 1)
   zero_crossings <- intersect(which(sum_vector == 0),
-                              which(abs(int_vector) %in% c(1,2)))
+                              which(abs(int_vector) %in% c(1, 2)))
   #print(zero_crossings)
-  trills<-get_rle_df(sum_vector) %>% filter(value == 0, length>0, start %in% zero_crossings)
+  trills<-get_rle_df(sum_vector) %>% filter(value == 0, length > 0, start %in% zero_crossings)
   if(nrow(trills) == 0){
     return(NULL)
   }
@@ -373,22 +370,22 @@ find_trills <- function(int_vector){
              stringsAsFactors=F)
 }
 
-find_bigram <- function(int_vector, bigram, value="F"){
-  bigrams <- paste(int_vector, data.table::shift(int_vector, 1, type="lead"), sep=" ")
+find_bigram <- function(int_vector, bigram, value = "F"){
+  bigrams <- paste(int_vector, dplyr::lead(int_vector, 1), sep = " ")
   bigram <- paste(bigram, collapse=" ")
   pos <- which(bigrams == bigram)
   if(length(pos) == 0){
     return(NULL)
   }
-  values <- values_from_positions(int_vector, data.frame(start=pos, end=pos+1))
-  directions <- directions_from_positions(int_vector, data.frame(start=pos, end=pos+1))
+  values <- values_from_positions(int_vector, data.frame(start = pos, end = pos+1))
+  directions <- directions_from_positions(int_vector, data.frame(start = pos, end = pos + 1))
   data.frame(length = 2,
              type = "F",
              value = values,
              direction = directions,
              start = pos,
              end = pos + 1,
-             stringsAsFactors=F)
+             stringsAsFactors = F)
 }
 
 find_approaches <- function(int_vector){
@@ -546,7 +543,7 @@ remove_rows <- function(data, rows){
   data[left_over,]
 }
 
-remove_redundants <- function(data, debug=F){
+remove_redundants <- function(data, debug = F){
   to_remove <- which(data$length == 2 &
                        data$pre_over == 1 &
                        data$post_over == 1 & data$type %in% c("F", "T"))
@@ -883,8 +880,9 @@ get_class_code_raw <- function(data, type = c("full", "reduced", "short", "exten
 }
 
 compare_freq <- function(data1, data2, type="F"){
-  tt <- bind_rows(tibble(source = 1, value=data1[data1$type == type,]$value),
-              tibble(source = 2, value=data2[data2$type == type,]$value))
+  tt <- bind_rows(
+    tibble(source = 1, value=data1[data1$type == type,]$value),
+    tibble(source = 2, value=data2[data2$type == type,]$value))
   #print(tt)
   tt$value <- factor(tt$value)
   tt1 <- table(tt[tt$source == 1,]$value)
@@ -902,7 +900,7 @@ hash_wba_dataframe <- function(data){
     too_long <- TRUE
     print(sprintf("Too long by %d", tl))
   }
-  hashes <- by_row(data, function(x){
+  hashes <- purrrlyr::by_row(data, function(x){
                           hash_wba(x$type, x$direction, x$length)}) %>%
     select(cols = c(.out)) %>%
     unlist() %>%
@@ -932,8 +930,8 @@ find_wba <- function(x, debug = F){
     resolve_overlaps(debug = debug)
 }
 
-recalc_pattern_classes <- function(){
-  patterns <- lapply(unique(master$value), pattern_to_vec)
+recalc_pattern_classes <- function(data){
+  patterns <- lapply(unique(data$value), pattern_to_vec)
   patterns_classes <- purrr::map(patterns,
                                  function(x) data.frame(pattern = vec_to_value(x),
                                                         find_wba(x)))

R/output.R

@@ -3,7 +3,7 @@
 #' This function write a MCSV2 formated data fraem to a file
 #'
 #' @param data (data frame) MCSV2 formatted solo data.frame
-#' @param fname (character scale) path to write to.
+#' @param fname (character scalar) file path to write to.
 #' @export
 write_mcsv2 <- function(data, fname){
   header <- strsplit("onset;duration;period;division;bar;beat;tatum;beat_duration;signature;pitch;phrase_id;phrase_begin", ";") %>% unlist()