Another try at this problem in LISP. This time rather than generating every possible row combination for the melody I tried to calculate the best combination directly. Unfortunately there's a problem - the output is a messy list full of vectors and single values. Is there a good way to concatenate vectors together with value between them?
(proclaim '(type (vector (vector symbol 4) 3) *rows*)) (defparameter *rows* #( #(:c :ds :fs :a) #(:cs :e :g :as) #(:d :f :gs :b))) (defun row-for-note (note) (declare (symbol note)) "Returns the lower row on which a note is played." (position-if (lambda (row) (find note row)) *rows*)) (defun equivalent-row (row) (declare (fixnum row)) "Returns the equivalent upper row to a given lower row." (case row (1 -2) (2 -1) (0 0))) (defun rows-for-notelist (notelist) (declare ((vector symbol) notelist)) "Returns the sequence of lower rows on which a sequence of notes are played." (map 'vector #'row-for-note notelist)) (defun flip-sequence (rowlist) (declare ((vector fixnum) notelist)) "Returns the sequence of upper rows equivalent to a sequence of lower rows." (map 'vector #'equivalent-row rowlist)) (defun vector-last (thevec) (declare (vector thevec)) "Returns the last element of a vector." (elt thevec (- (length thevec) 1))) (defun vector-first (thevec) (declare (vector thevec)) "Returns the first element of a vector." (elt thevec 0)) (defun should-flip-block (rowlist) (declare ((vector fixnum) rowlist)) "Determines if a sequence of rows starts and ends on row 2 or not." "These sequences are more easily played on upper rows because they will then start and end on row -1." (if (= (length rowlist) 0) nil (let* ((exithigh (= (vector-last rowlist) 2)) (enterhigh (= (vector-first rowlist) 2))) (and exithigh enterhigh)))) (defun flip-block-if-should (rowlist) (declare ((vector number) rowlist)) (if (should-flip-block rowlist) (flip-sequence rowlist) (eval rowlist))) (defun optimal-sequence (notelist) (declare ((vector symbol) notelist)) (let* ((baserows (rows-for-notelist notelist)) (blocks (split-sequence '(0) baserows)) (flipped (mapcar #'flip-block-if-should blocks))) (loop for x in flipped collect x collect 0)))