gac/pc-ops.scm

(define-module (gac pc-ops)
  #:use-module (gac sg1)
  #:use-module (srfi srfi-1)
  #:export (transpositions
            transpose-all
	    inversions
	    reverse-all
	    get-sc
	    append-sc
	    cons-sc
	    choose-sc
	    sc1+))

(define
  (transpositions l)
  (define
    (rot o)
    (map
     (lambda (e)
       (remainder (+ o e) 12)) l))
  (map rot (iota 12)))


set-classes

'(0 1 2 3 4 5 6 7 8 9 10 11)

'("c" "cs" "d" "ds" "e" "f" "fs" "g" "gs" "a" "as" "b")

'((0 . "c") (1 . "cs") ...)

(define %trichords '((0 1 2) (0 1 3) (0 2 3) (0 1 4)
                     (0 3 4) (0 1 5) (0 4 5) (0 1 6)
                     (0 5 6) (0 2 4) (0 2 5) (0 3 5)
                     (0 2 6) (0 4 6) (0 2 7) (0 3 6)
                     (0 3 7) (0 4 7) (0 4 8)))

(transpose-all %trichords)
(((0 1 2)

  "<c cs d>1" lilypond token

  $ lilypond chords.ly > evince chords.pdf
  writer > chords.ly
  reader = parser

  gac "guile assisted composition" "rare tropical fruit"

  Modules:

  sg1 "data" set classes
  pc-ops transposition inversion transpose-all multiplication alpha (1->1 mapping)
  ga "genetic algorithms"
  lily "writes"

  abc "writer"
  guido "writer"
  abcjs "writer"

  package it for guix
  
  guix install guile-gac
  
  (1 2 3)
  (2 3 4)
  (3 4 5)
  (4 5 6)
  (5 6 7)
  (6 7 8)
  (7 8 9)
  (8 9 10)
  (9 10 11)
  (10 11 0)
  (11 0 1))
 ((0 1 3)
  (1 2 4)
  (2 3 5)
  (3 4 6)
  (4 5 7)
  (5 6 8)
  (6 7 9)
  (7 8 10)
  (8 9 11)
  (9 10 0)
  (10 11 1)
  (11 0 2))
 ((0 2 3)
  (1 3 4)
  (2 4 5)
  (3 5 6)
  (4 6 7)
  (5 7 8)
  (6 8 9)
  (7 9 10)
  (8 10 11)
  (9 11 0)
  (10 0 1)
  (11 1 2))
 ((0 1 4)
  (1 2 5)
  (2 3 6)
  (3 4 7)
  (4 5 8)
  (5 6 9)
  (6 7 10)
  (7 8 11)
  (8 9 0)
  (9 10 1)
  (10 11 2)
  (11 0 3))
 ((0 3 4)
  (1 4 5)
  (2 5 6)
  (3 6 7)
  (4 7 8)
  (5 8 9)
  (6 9 10)
  (7 10 11)
  (8 11 0)
  (9 0 1)
  (10 1 2)
  (11 2 3))
 ((0 1 5)
  (1 2 6)
  (2 3 7)
  (3 4 8)
  (4 5 9)
  (5 6 10)
  (6 7 11)
  (7 8 0)
  (8 9 1)
  (9 10 2)
  (10 11 3)
  (11 0 4))
 ((0 4 5)
  (1 5 6)
  (2 6 7)
  (3 7 8)
  (4 8 9)
  (5 9 10)
  (6 10 11)
  (7 11 0)
  (8 0 1)
  (9 1 2)
  (10 2 3)
  (11 3 4))
 ((0 1 6)
  (1 2 7)
  (2 3 8)
  (3 4 9)
  (4 5 10)
  (5 6 11)
  (6 7 0)
  (7 8 1)
  (8 9 2)
  (9 10 3)
  (10 11 4)
  (11 0 5))
 ((0 5 6)
  (1 6 7)
  (2 7 8)
  (3 8 9)
  (4 9 10)
  (5 10 11)
  (6 11 0)
  (7 0 1)
  (8 1 2)
  (9 2 3)
  (10 3 4)
  (11 4 5))
 ((0 2 4)
  (1 3 5)
  (2 4 6)
  (3 5 7)
  (4 6 8)
  (5 7 9)
  (6 8 10)
  (7 9 11)
  (8 10 0)
  (9 11 1)
  (10 0 2)
  (11 1 3))
 ((0 2 5)
  (1 3 6)
  (2 4 7)
  (3 5 8)
  (4 6 9)
  (5 7 10)
  (6 8 11)
  (7 9 0)
  (8 10 1)
  (9 11 2)
  (10 0 3)
  (11 1 4))
 ((0 3 5)
  (1 4 6)
  (2 5 7)
  (3 6 8)
  (4 7 9)
  (5 8 10)
  (6 9 11)
  (7 10 0)
  (8 11 1)
  (9 0 2)
  (10 1 3)
  (11 2 4))
 ((0 2 6)
  (1 3 7)
  (2 4 8)
  (3 5 9)
  (4 6 10)
  (5 7 11)
  (6 8 0)
  (7 9 1)
  (8 10 2)
  (9 11 3)
  (10 0 4)
  (11 1 5))
 ((0 4 6)
  (1 5 7)
  (2 6 8)
  (3 7 9)
  (4 8 10)
  (5 9 11)
  (6 10 0)
  (7 11 1)
  (8 0 2)
  (9 1 3)
  (10 2 4)
  (11 3 5))
 ((0 2 7)
  (1 3 8)
  (2 4 9)
  (3 5 10)
  (4 6 11)
  (5 7 0)
  (6 8 1)
  (7 9 2)
  (8 10 3)
  (9 11 4)
  (10 0 5)
  (11 1 6))
 ((0 3 6)
  (1 4 7)
  (2 5 8)
  (3 6 9)
  (4 7 10)
  (5 8 11)
  (6 9 0)
  (7 10 1)
  (8 11 2)
  (9 0 3)
  (10 1 4)
  (11 2 5))
 ((0 3 7)
  (1 4 8)
  (2 5 9)
  (3 6 10)
  (4 7 11)
  (5 8 0)
  (6 9 1)
  (7 10 2)
  (8 11 3)
  (9 0 4)
  (10 1 5)
  (11 2 6))
 ((0 4 7)
  (1 5 8)
  (2 6 9)
  (3 7 10)
  (4 8 11)
  (5 9 0)
  (6 10 1)
  (7 11 2)
  (8 0 3)
  (9 1 4)
  (10 2 5)
  (11 3 6))
 ((0 4 8)
  (1 5 9)
  (2 6 10)
  (3 7 11)
  (4 8 0)
  (5 9 1)
  (6 10 2)
  (7 11 3)
  (8 0 4)
  (9 1 5)
  (10 2 6)
  (11 3 7)))

(define (transpose-all chords)
  (map transpositions chords))

(transpose-all %trichords)

(define inversions
  '((0 . 0)
    (1 . 11)
    (2 . 10)
    (3 . 9)
    (4 . 8)
    (5 . 7)
    (6 . 6)))

'(0 1 2) => '(0 11 10) => '(1 0 11)

(map (compose inversions transpose-by-zero))

;; todo add alpha mappings from morris' composition with pitch classes

(define
  (reverse-all lst)
  (map
   (lambda (x) (reverse x))
   lst))

(define (get-sc setclass position)
  (list-ref setclass position))

(define (append-sc sc1 sc2)
  (append sc1 sc2))

(define (cons-sc sc1 sc2)
  (cons sc1 sc2))

(define (choose-sc setclass)
  (list-ref setclass (random (length setclass))))

;; this can be used with get-sc e.g. (sc1+ (get-sc %trichords 1))

(define (sc1+ setclass)
  (map (lambda (x) (1+ x)))
   setclass)