patternMinor
Calculating series of rows to use to play a melody on 5-row Bayan Accordion
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..
(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.)
(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:
Missing:
Only slight improvements.
No need to use
Okay:
Compute
Slight improvements:
- improved formatting and layout
- instead of
carandcdr, usefirstandrest.
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.