\version "2.22"

% returns a string representation of a pitch
#(define (pitch->str p)
   (string-append "Po"
                  (number->string (ly:pitch-octave p))
                  "n"
                  (number->string (ly:pitch-notename p))))

% returns a symbol representation of a list of pitches
#(define (signature pitches)
   (let
    ((sp (sort pitches ly:pitch<?)))
    (string->symbol (apply string-append (map pitch->str sp)))))

% takes a alist that maps symbol representations of chords to a list of pitches and some music
% and replaces all occurences of chords with the key pitches in the alist with chords with the
% pitches associated with that key
replaceChords =
#(define-music-function (replacements mus) (list? ly:music?)
   ; get a list of all notes in music
   (define (extract-notes music)
     (let
      ((name (ly:music-property music 'name))
       (elt (ly:music-property music 'element))
       (elts (ly:music-property music 'elements)))
      (if (eq? name 'NoteEvent)
          (let
           ((nelt (if (null? elt) elt (extract-notes elt)))
            (nelts (apply append (map extract-notes elts))))
           (cons music (append nelt nelts)))
          (let
           ((nelt (if (null? elt) elt (extract-notes elt)))
            (nelts (apply append (map extract-notes elts))))
           (append nelt nelts)))))
   ; get the duration of a chord from one of the notes in the chord
   (define (extract-duration notes)
     (if (null? notes) 0
         (ly:music-property (first notes) 'duration)))
   ; get pitch from a note
   (define (extract-one-pitch note)
     (ly:music-property note 'pitch))
   ; get list of pitches from a list of notes
   (define (extract-pitch notes)
     (map extract-one-pitch notes))
   ; check if argument is a note
   (define (is-note? music)
     (eq? (ly:music-property music 'name) 'NoteEvent))
   ; check if argument is not a note
   (define (is-not-note? music)
     (not (is-note? music)))
   ; remove all notes from 'elements
   (define (remove-notes music)
     (let
      ((elt (ly:music-property music 'element))
       (elts (ly:music-property music 'elements)))
      (if (not (null? elt))
          (if (is-note? elt)
              (ly:music-set-property! music 'element '())
              (remove-notes elt)))
      (ly:music-set-property! music 'elements
                              (filter is-not-note? elts))
      (map remove-notes (ly:music-property music 'elements))))
   ; add specified notes to 'elements
   (define (add-notes music pitches dur)
     (define (add-note p)
       (if (not (null? p))
           (begin
            (ly:music-set-property! music 'elements
                                    (cons
                                     (make-music
                                       'NoteEvent
                                       'pitch
                                       (car p)
                                       'duration
                                       (ly:make-duration 2))
                                     (ly:music-property music 'elements)))
            (add-note (cdr p)))))
     (add-note pitches))
   ; parse music tree
   (define (walk-music-tree music)
     (let
      ((name (ly:music-property music 'name))
       (elt (ly:music-property music 'element))
       (elts (ly:music-property music 'elements)))
      ; is music a chord?
      (if (eq? name 'EventChord)
          (let*
           ((note-raw (extract-notes music))
            (duration (extract-duration note-raw))
            (notes (sort (extract-pitch note-raw) ly:pitch<?))
            (rep-pitches (ly:assoc-get (signature notes) replacements)))
           (if rep-pitches
               (begin
                 (remove-notes music)
                 (add-notes music rep-pitches duration))
               (display (format "Chord ~a not found!\n" (signature notes))))))
         (if (not (null? elt)) (walk-music-tree elt))
         (map walk-music-tree elts)))
   (walk-music-tree mus)
   mus)

% takes some music and creates a list of all pitches in the music
#(define (notes->pitches mus)
   (define (extract-notes music)
     (let
      ((name (ly:music-property music 'name))
       (elt (ly:music-property music 'element))
       (elts (ly:music-property music 'elements)))
      (if (eq? name 'NoteEvent)
          (let
           ((nelt (if (null? elt) elt (extract-notes elt)))
            (nelts (apply append (map extract-notes elts))))
           (cons music (append nelt nelts)))
          (let
           ((nelt (if (null? elt) elt (extract-notes elt)))
            (nelts (apply append (map extract-notes elts))))
           (append nelt nelts)))))
   (define (extract-one-pitch note)
     (ly:music-property note 'pitch))
   (define (extract-pitch notes)
     (map extract-one-pitch notes))
   ; is music a chord?
   (let
    ((note-raw (extract-notes mus)))
    (sort (extract-pitch note-raw) ly:pitch<?)))

% takes some music and creates a symbol representation of all pitches in the music
#(define (sigchord mus)
    (signature (notes->pitches mus)))

% takes music of the form { a1 a2 b1 b2 ... } and returns a replacement alist
% for replacing a1 with a2, b1 with b2, ...
replistfrommusic=#(define-scheme-function (mus) (ly:music?)
   (define (walk-elts elts)
    (if (or (null? elts) (null? (cdr elts)))
        '()
        (cons (cons (sigchord (car elts)) (notes->pitches (cadr elts)))
              (walk-elts (cddr elts)))))
   (let
    ((name (ly:music-property mus 'name))
     (elts (ly:music-property mus 'elements)))
    ; is music sequential?
    (if (not (eq? name 'SequentialMusic)) (warning "Music does not seem to be sequential!"))
    (walk-elts elts)))



%%%%%%%%%%%%%%%%%%%%%
%%%%%% EXAMPLE %%%%%%
%%%%%%%%%%%%%%%%%%%%%

rep = \replistfrommusic { c <c' e'>
                       d <d' f'>
                       <c' d' e'> <d' e' f'> }

{ \replaceChords \rep { <c' d' e'>->^"markup and chord articulations are preserved!" <c>^"to replace single notes, use single note chords!" c <d> <c,> } }