2
\$\begingroup\$

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)))
\$\endgroup\$
1
\$\begingroup\$

To concatenate vectors, you can do this:

(apply #'concatenate 'vector 
       (mapcar (lambda (x) 
                 (typecase x 
                   (vector x) 
                   (t (vector x))))
               list-of-vectors-or-numbers))

PS. Since this is CR, here are some notes on your code:

  1. Doc string (no more than one, but it can be multi-line!) usually comes before the declarations. Please see Syntactic Interaction of Documentation Strings and Declarations: (defun foo (...) (declare ...) "doc") will define a function foo which has no docstring and return "doc", while (defun foo (...) "doc" (declare ...)) will declare a function with a docstring, returning nil.

  2. (declare ((vector number) rowlist)) should be (declare (type (vector number) rowlist)).

  3. elt should not be used if you know that the object is a vector; use aref instead.

  4. There is no need to bind exithigh and enterhigh in should-flip-block since they are used just once.

  5. declaim is, I think, more "idiomatic" than proclaim in your case.

  6. It is clearer to use 1- in vector-last.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.