HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Calculating series of rows to use to play a melody on 5-row Bayan Accordion

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
rowsmelodyaccordionbayancalculatingplayseriesuserow

Problem

This was my first attempt at writing a program in LISP. Can anyone give any guides as to how it could be improved? The multiple loops in best-pattern seem awkward (I'd normally do that in just one loop but there doesn't seem to be a way of doing that with LOOP, although I'm told there's an iterate extension that can do it), as does the way of calculating alternatives..

(defparameter *rows* (list (list :c :ds :fs :a) (list :cs :e :g :as) (list :d :f :gs :b)))

(defun row-for-note (note)
    (position-if (lambda (row) (find note row)) *rows*)
)

(defun rows-for-notelist (notelist)
    (mapcar #'row-for-note notelist)
)

(defun possible-alternates (rowlist)
    (let ((alternatives '(())))   ;; Lots of irritating silly parentheses
        (when (> (length rowlist) 1)
           (setq alternatives (possible-alternates (cdr rowlist)))
        )
        (case (car rowlist)
            ((0) (mapcar (lambda (x) (append '(0) x)) alternatives))
            ((1) (append (mapcar (lambda (x) (append '(1) x)) alternatives)
                         (mapcar (lambda (x) (append '(-2) x)) alternatives)))
            ((2) (append (mapcar (lambda (x) (append '(2) x)) alternatives)
                         (mapcar (lambda (x) (append '(-1) x)) alternatives)))
        )
    )
)

(defun count-jumps (rowlist)
    (loop for (a b) on rowlist while b counting (> (abs (- a b)) 1))
)

(defun best-pattern (notelist)
    (let ((minval (loop for x in (possible-alternates (rows-for-notelist notelist)) minimize (count-jumps x))))
    (loop for x in (possible-alternates (rows-for-notelist notelist)) when (= (count-jumps x) minval) collect x))
)


(If you're wondering what the program does, it tries to calculate the "most efficient" series of rows to use to play a melody on 5-row Bayan Accordion.)

Solution

Done:

  • improved formatting and layout



  • instead of car and cdr, use first and rest.



Missing:

  • documentation strings



  • example



Only slight improvements.

No need to use list:

(defparameter *rows* '((:c  :ds :fs :a )
                       (:cs :e  :g  :as)
                       (:d  :f  :gs :b )))


Okay:

(defun row-for-note (note)
  (position-if (lambda (row) (find note row))
               *rows*))

(defun rows-for-notelist (notelist)
  (mapcar #'row-for-note notelist))


Compute alternatives directly, without setq. Local functions for repeated use. Use cons. Not so good: recursion limits use, because of limited stack depth.

(defun possible-alternates (rowlist)
  (let ((alternatives (if (rest rowlist)
                          (possible-alternates (rest rowlist))
                        '(()) )))
    (flet ((add (item)
             (mapcar (lambda (x) (cons item x))
                     alternatives)))
      (case (first rowlist)
        (0 (add 0))
        (1 (append (add 1) (add -2)))
        (2 (append (add 2) (add -1)))))))

(defun count-jumps (rowlist)
  (loop for (a b) on rowlist
        while b
        count (> (abs (- a b)) 1)))


Slight improvements:

(defun best-pattern (notelist)
  (let* ((alternates (possible-alternates (rows-for-notelist notelist)))
         (jumps      (mapcar #'count-jumps alternates))
         (min-jump   (loop for j in jumps minimize j)))
    (loop for a in alternates and j in jumps
          when (= min-jump j)
          collect a)))

Code Snippets

(defparameter *rows* '((:c  :ds :fs :a )
                       (:cs :e  :g  :as)
                       (:d  :f  :gs :b )))
(defun row-for-note (note)
  (position-if (lambda (row) (find note row))
               *rows*))

(defun rows-for-notelist (notelist)
  (mapcar #'row-for-note notelist))
(defun possible-alternates (rowlist)
  (let ((alternatives (if (rest rowlist)
                          (possible-alternates (rest rowlist))
                        '(()) )))
    (flet ((add (item)
             (mapcar (lambda (x) (cons item x))
                     alternatives)))
      (case (first rowlist)
        (0 (add 0))
        (1 (append (add 1) (add -2)))
        (2 (append (add 2) (add -1)))))))

(defun count-jumps (rowlist)
  (loop for (a b) on rowlist
        while b
        count (> (abs (- a b)) 1)))
(defun best-pattern (notelist)
  (let* ((alternates (possible-alternates (rows-for-notelist notelist)))
         (jumps      (mapcar #'count-jumps alternates))
         (min-jump   (loop for j in jumps minimize j)))
    (loop for a in alternates and j in jumps
          when (= min-jump j)
          collect a)))

Context

StackExchange Code Review Q#38255, answer score: 3

Revisions (0)

No revisions yet.