十二音技法に基づく作曲支援システムの概要

　二音技法に基づく作曲支援システムを作ってみました。以下が試作曲です。やはり、十二音技法では不安な曲しかできないのでしょうか。ジャズに比べると単純な世界ですが。十二音技法では音程しか考慮しないのでジャズよりも極めて単純なようです。システムを比較してみて下さい。

http://www5f.biglobe.ne.jp/~kimmusic/tokai-no-kodoku.mid

比較的短いプログラムなので、全ソースコードを以下に示します。

;;;

;;; c:\\program files\\acl62\\music43.cl

;;;

(defun make-O ()

　　(let ((lst '(do +do re +re mi fa +fa so +so la +la si)))

　　　(do ((l lst)

　　　　　　(w))

　　　　　　((null l) (reverse w))

　　　　　(let ((note (nth (random (length l)) l)))

　　　　　　(push note w)

　　　　　　(setf l (remove note l))))))

(defun translate-doremi-to-number (doremi)

　　(case doremi

　　　　(do 1.0) (+do 1.5) (re 2.0) (+re 2.5) (mi 3.0)

　　　　(fa 3.5) (+fa 4.0) (so 4.5) (+so 5.0) (la 5.5)

　　　　(+la 6.0) (si 6.5)))

(defun confine-a-number-2 (n)

　　(cond ((>= n 7.0) (- n 6.0))

　　　　　　((<= n 0.5) (+ n 6.0))

　　　　　　(t n)))

(defun translate-number-to-doremi (n)

　　(let ((num (confine-a-number-2 (confine-a-number-2 n))))

　　　　(case num

　　　　　　(1.0 'do) (1.5 '+do) (2.0 're) (2.5 '+re) (3.0 'mi)

　　　　　　(3.5 'fa) (4.0 '+fa) (4.5 'so) (5.0 '+so) (5.5 'la)

　　　　　　(6.0 '+la) (6.5 'si))))

(defun up-a-note (doremi n)

　　(let* ((num (translate-doremi-to-number doremi))

　　　　　　(nn (+ num n)))

　　　　(translate-number-to-doremi nn)))

(defun down-a-note (doremi n)

　　(let* ((num (translate-doremi-to-number doremi))

　　　　　　(nn (- num n)))

　　　　(translate-number-to-doremi nn)))

(defun translate-doremi-to-number-from-start (start doremi)

　(case start

　　　(do (case doremi

　　　　　　　(do 1.0)(+do 1.5)(re 2.0)(+re 2.5)(mi 3.0)(fa 3.5)(+fa 4.0)(so 4.5)(+so 5.0)(la 5.5)(+la 6.0)(si 6.5)))

　　　(+do (case doremi

　　　　　　　(+do 1.0)(re 1.5)(+re 2.0)(mi 2.5)(fa 3.0)(+fa 3.5)(so 4.0)(+so 4.5)(la 5.0)(+la 5.5)(si 6.0)(do 6.5)))

　　　(re (case doremi

　　　　　　　(re 1.0)(+re 1.5)(mi 2.0)(fa 2.5)(+fa 3.0)(so 3.5)(+so 4.0)(la 4.5)(+la 5.0)(si 5.5)(do 6.0)(+do 6.5)))

　　　(+re (case doremi

　　　　　　　(+re 1.0)(mi 1.5)(fa 2.0)(+fa 2.5)(so 3.0)(+so 3.5)(la 4.0)(+la 4.5)(si 5.0)(do 5.5)(+do 6.0)(re 6.5)))

　　　(mi (case doremi

　　　　　　　(mi 1.0)(fa 1.5)(+fa 2.0)(so 2.5)(+so 3.0)(la 3.5)(+la 4.0)(si 4.5)(do 5.0)(+do 5.5)(re 6.0)(+re 6.5)))

　　　(fa (case doremi

　　　　　　　(fa 1.0)(+fa 1.5)(so 2.0)(+so 2.5)(la 3.0)(+la 3.5)(si 4.0)(do 4.5)(+do 5.0)(re 5.5)(+re 6.0)(mi 6.5)))

　　　(+fa (case doremi

　　　　　　　(+fa 1.0)(so 1.5)(+so 2.0)(la 2.5)(+la 3.0)(si 3.5)(do 4.0)(+do 4.5)(re 5.0)(+re 5.5)(mi 6.0)(fa 6.5)))

　　　(so (case doremi

　　　　　　　(so 1.0)(+so 1.5)(la 2.0)(+la 2.5)(si 3.0)(do 3.5)(+do 4.0)(re 4.5)(+re 5.0)(mi 5.5)(fa 6.0)(+fa 6.5)))

　　　(+so (case doremi

　　　　　　　(+so 1.0)(la 1.5)(+la 2.0)(si 2.5)(do 3.0)(+do 3.5)(re 4.0)(+re 4.5)(mi 5.0)(fa 5.5)(+fa 6.0)(so 6.5)))

　　　(la (case doremi

　　　　　　　(la 1.0)(+la 1.5)(si 2.0)(do 2.5)(+do 3.0)(re 3.5)(+re 4.0)(mi 4.5)(fa 5.0)(+fa 5.5)(so 6.0)(+so 6.5)))

　　　(+la (case doremi

　　　　　　　(+la 1.0)(si 1.5)(do 2.0)(+do 2.5)(re 3.0)(+re 3.5)(mi 4.0)(fa 4.5)(+fa 5.0)(so 5.5)(+so 6.0)(la 6.5)))

　　　(si (case doremi

　　　　　　　(si 1.0)(do 1.5)(+do 2.0)(re 2.5)(+re 3.0)(mi 3.5)(fa 4.0)(+fa 4.5)(so 5.0)(+so 5.5)(la 6.0)(+la 6.5)))))

(defun translate-flat-to-sharp-on-a-note (note)

　　(case note

　　　　(do 'do)

　　　　(+do '+do)

　　　　(-re '+do)

　　　　(re 're)

　　　　(+re '+re)

　　　　(-mi '+re)

　　　　(mi 'mi)

　　　　(fa 'fa)

　　　　(+fa '+fa)

　　　　(so 'so)

　　　　(+so '+so)

　　　　(-la '+so)

　　　　(la 'la)

　　　　(+la '+la)

　　　　(-si '+la)

　　　　(si 'si)))

(defun distance-from-n1-to-n2 (n1 n2)

　　(let ((nn1 (translate-flat-to-sharp-on-a-note n1))

　　　　　(nn2 (translate-flat-to-sharp-on-a-note n2)))

　　　　(let ((num (- (translate-doremi-to-number-from-start nn1 nn2) 1.0)))

　　　　　　(list (list nn1 nn2) (list 'down (- 6.0 num)) (list 'up num)))))

(defun make-distance-from-list (lst)

　　(do ((ll lst (cdr ll))

　　　　　(w))

　　　　　((null (cdr ll)) (reverse w))

　　　　(push (distance-from-n1-to-n2 (first ll) (second ll)) w)))

(defun get-up-degrees (lst)

　　(mapcar #'second (mapcar #'second lst)))

(defun make-I-aux-2 (lst)

　　(do ((ll (second lst) (cdr ll))

　　　　　(w1 (car lst))

　　　　　(w2))

　　　　　((null ll) (reverse w2))

　　　　(setf w1 (up-a-note (translate-flat-to-sharp-on-a-note w1) (car ll)))

　　　　(push w1 w2)))

(defun make-I-aux-3 (lst)

　　(cons (car lst) (make-I-aux-2 lst)))

(defun make-I (lst)

　　(let* ((l1 (make-distance-from-list lst))

　　　　　　(l2 (get-up-degrees l1))

　　　　　　(l3 (make-I-aux-2 (list (car lst) l2))))

　　　　(cons (car lst) l3)))

(defun make-R (lst) (reverse lst))

(defun make-IR (lst) (reverse (make-I lst)))

;;;

;;; ４種類の音列の生成（十二音技法の基礎）

;;;

(defun make-4-kinds-of-notes-series ()

　　(let* ((l1 (make-O))

　　　　　　(l2 (make-R l1))

　　　　　　(l3 (make-I l1))

　　　　　　(l4 (make-IR l1)))

　　　　(format t "~%基本形 O (Original) :~a." l1)

　　　　(format t "~%逆行形 R (Retrograde) :~a." l2)

　　　　(format t "~%反行形 I (Inversion) :~a." l3)

　　　　(format t "~%反行逆行形 IR (Inversion+Retrogade):~a." l4)))

;;

;;; c:\\program files\\acl62\\music48.cl

;;;

(defun get-4-kinds-of-note-series ()

　　(let* ((l1 (make-O))

　　　　　　(l2 (make-R l1))

　　　　　　(l3 (make-I l1))

　　　　　　(l4 (make-IR l1)))

　　　　(list `(O ,l1) `(R ,l2) `(I ,l3) `(IR ,l4))))

(defun get-note-series (n)

　　(let* ((l (get-4-kinds-of-note-series))

　　　　　　(l1 (list (first l))))

　　　(do ((nn (1- n) (1- nn))

　　　　　　(w))

　　　　　　((<= nn 0) (append l1 (reverse w)))

　　　　　(let ((kind (nth (random 4) '(O R I IR))))

　　　　　　(push (assoc kind l) w)))))

(defun get-and-squash-note-series (n)

　　(let ((l (get-note-series n)))

　　　(list (mapcar #'first l) (mapcar #'second l))))

(defun get-and-squash-note-series-2 (n)

　　(let ((l (get-note-series n)))

　　　(list (mapcar #'first l) (squash (mapcar #'second l)))))

(defun get-2-part-from-list (lst)

　　(do ((l lst (cddr l))

　　　　　(w))

　　　　　((null l) (reverse w))

　　　(push (list (first l) (second l)) w)))

(defun get-3-part-from-list (lst)

　　(do ((l lst (cdddr l))

　　　　　(w))

　　　　　((null l) (reverse w))

　　　(push (list (first l) (second l) (third l)) w)))

(defun get-4-part-from-list (lst)

　　(do ((l lst (cddddr l))

　　　　　(w))

　　　　　((null l) (reverse w))

　　　　(push (list (first l) (second l) (third l) (fourth l)) w)))

(defun get-6-part-from-list (lst)

　　(do ((l lst (cddr (cddddr l)))

　　　　　(w))

　　　　　((null l) (reverse w))

　　　(push (list (first l) (second l) (third l) (fourth l) (fifth l) (sixth l)) w)))

(defun get-part-from-list-at-random (lst)

　　(let ((n (random 4)))

　　　(case n

　　　　(0 (get-2-part-from-list lst))

　　　　(1 (get-3-part-from-list lst))

　　　　(2 (get-4-part-from-list lst))

　　　　(3 lst))))

(defun auto-comp-twelve (n)

　　(let* ((l1 (get-note-series n))

　　　　　　(l2 (mapcar #'first l1))

　　　　　　(l3 (mapcar #'second l1)))

　　　　(do ((ll1 l2 (cdr ll1))

　　　　　　　(ll2 l3 (cdr ll2))

　　　　　　　(w))

　　　　　　((null ll1) (reverse w))

　　　　　(let ((l4 (car ll1))

　　　　　　　　(l5 (get-part-from-list-at-random (car ll2))))

　　　　　　　(format t "~% ~a : ~a." l4 l5)

　　　　　　　(push (list l4 l5) w)))))

荒井公康

http://www5f.biglobe.ne.jp/~kimmusic/

http://kimiyasu-arai.at.webry.info/