;;;
;;; (load "c:\\program files\\acl62\\music59.cl")
;;;
(load "c:\\program files\\acl62\\music58.cl")
;;;
;;;(rotate-list-from-elment-forward 'c '(a b c d e f g))
;;;(c d e f g a b)
;;;
(defun rotate-list-from-elment-forward (element l)
(rotate-list-left l (- (get-position-of-an-element element l) 1)))
;;;
;;;(rotate-list-from-elment-forward-and-cut 'c '(a b c d e f g))
;;;(c d e f g)
;;;
(defun rotate-list-from-elment-forward-and-cut (element l)
(let ((lst (rotate-list-from-elment-forward element l)))
(cut-list-at-length (+ (random (length lst)) 1) lst)))
;;;
;;;(rotate-list-from-elment-forward-and-cut-2 'c '(a b c d e f g))
;;;(c)
;;;
(defun rotate-list-from-elment-forward-and-cut-2 (element l)
(let ((lst (rotate-list-from-elment-forward element l)))
(cut-list-at-length (+ (random 4) 1) lst)))
;;;
;;;(rotate-list-from-elment-backward 'c '(a b c d e f g))
;;;(c b a g f e d)
;;;
(defun rotate-list-from-elment-backward (element l)
(rotate-list-left (reverse l) (- (get-position-of-an-element element
(reverse l)) 1)))
;;;
;;;(rotate-list-from-elment-backward-and-cut 'c '(a b c d e f g))
;;;(c b a g f)
;;;
(defun rotate-list-from-elment-backward-and-cut (element l)
(let ((lst (rotate-list-from-elment-backward element l)))
(cut-list-at-length (+ (random (length lst)) 1) lst)))
;;;
;;;(rotate-list-from-elment-backward-and-cut-2 'c '(a b c d e f g))
;;;(c b)
;;;
(defun rotate-list-from-elment-backward-and-cut-2 (element l)
(let ((lst (rotate-list-from-elment-backward element l)))
(cut-list-at-length (+ (random 4) 1) lst)))
;;;
;;;(rotate-list-from-elment-and-cut 'c '(a b c d e f g))
;;;(c d e)
;;;
(defun rotate-list-from-elment-and-cut (element l)
(case (random 2)
(0 (rotate-list-from-elment-forward-and-cut element l))
(1 (rotate-list-from-elment-backward-and-cut element l))))
;;;
;;;(rotate-list-from-elment-and-cut-2 'c '(a b c d e f g))
;;;(c)
;;;
(defun rotate-list-from-elment-and-cut-2 (element l)
(case (random 2)
(0 (rotate-list-from-elment-forward-and-cut-2 element l))
(1 (rotate-list-from-elment-backward-and-cut-2 element l))))
;;;
;;;(rotate-list-from-elment-forward-at-random '(a b c d e f g))
;;;(f g a b c d e)
;;;
(defun rotate-list-from-elment-forward-at-random (l)
(rotate-list-from-elment-forward (nth (random (length l)) l) l))
;;;
;;;(rotate-list-from-elment-backward-at-random '(a b c d e f g))
;;;(c b a g f e d)
;;;
(defun rotate-list-from-elment-backward-at-random (l)
(rotate-list-from-elment-backward (nth (random (length l)) l) l))
;;;
;;;(rotate-list-from-elment-forward-at-random-and-cut '(a b c d e f g))
;;;(g a b c d)
;;;
(defun rotate-list-from-elment-forward-at-random-and-cut (l)
(let ((lst (rotate-list-from-elment-forward-at-random l)))
(cut-list-at-length (+ (random (length lst)) 1) lst)))
;;;
;;;(rotate-list-from-elment-forward-at-random-and-cut-2 '(a b c d e f g))
;;;(e f)
;;;
(defun rotate-list-from-elment-forward-at-random-and-cut-2 (l)
(let ((lst (rotate-list-from-elment-forward-at-random l)))
(cut-list-at-length (+ (random 4) 1) lst)))
;;;
;;;(rotate-list-from-elment-backward-at-random-and-cut '(a b c d e f g))
;;;(g f e d)
;;;
(defun rotate-list-from-elment-backward-at-random-and-cut (l)
(let ((lst (rotate-list-from-elment-backward-at-random l)))
(cut-list-at-length (+ (random (length lst)) 1) lst)))
;;;
;;;(rotate-list-from-elment-backward-at-random-and-cut-2 '(a b c d e f g))
;;;(b a g)
;;;
(defun rotate-list-from-elment-backward-at-random-and-cut-2 (l)
(let ((lst (rotate-list-from-elment-backward-at-random l)))
(cut-list-at-length (+ (random 4) 1) lst)))
;;;
;;;(rotate-list-from-elment-at-random-and-cut '(a b c d e f g))
;;;(e f g a b c d)
;;;
(defun rotate-list-from-elment-at-random-and-cut (l)
(case (random 2)
(0 (rotate-list-from-elment-forward-at-random-and-cut l))
(1 (rotate-list-from-elment-backward-at-random-and-cut l))))
;;;
;;;(rotate-list-from-elment-at-random-and-cut-2 '(a b c d e f g))
;;;(f g)
;;;
(defun rotate-list-from-elment-at-random-and-cut-2 (l)
(case (random 2)
(0 (rotate-list-from-elment-forward-at-random-and-cut-2 l))
(1 (rotate-list-from-elment-backward-at-random-and-cut-2 l))))
;;;
;;;(print (connect-lists '(do re mi fa so la si)))
;;;(si do re mi fa so la si do re mi fa so la si do re mi re do si la so fa mi re do si do re mi)
;;;
;;;(print (connect-lists '(do mi so si)))
;;;(mi so mi do mi so mi do si so mi do si so mi)
;;;
(defun connect-lists (l)
(let* ((ll (rotate-list-from-elment-at-random-and-cut l))
(l1 (rotate-list-from-elment-and-cut (car (last ll)) l))
(l2 (rotate-list-from-elment-and-cut (car (last l1)) l))
(l3 (rotate-list-from-elment-and-cut (car (last l2)) l))
(l4 (rotate-list-from-elment-and-cut (car (last l3)) l))
(l5 (rotate-list-from-elment-and-cut (car (last l4)) l))
(l6 (rotate-list-from-elment-and-cut (car (last l5)) l))
(l7 (rotate-list-from-elment-and-cut (car (last l6)) l))
(l8 (rotate-list-from-elment-and-cut (car (last l7)) l))
(l9 (rotate-list-from-elment-and-cut (car (last l8)) l)))
(append (butlast ll) (butlast l1) (butlast l2) (butlast l3) (butlast
l4) (butlast l5)
(butlast l6) (butlast l7) (butlast l8) (butlast l9))))
;;;
;;;(print (connect-lists-2 '(do re mi fa so la si)))
;;;(re mi fa mi re do si la so la so fa mi re do re mi fa mi re)
;;;
;;;(print (connect-lists-2 '(do mi so si)))
;;;(do si so mi do si so mi do mi so)
;;;
(defun connect-lists-2 (l)
(let* ((ll (rotate-list-from-elment-at-random-and-cut-2 l))
(l1 (rotate-list-from-elment-and-cut-2 (car (last ll)) l))
(l2 (rotate-list-from-elment-and-cut-2 (car (last l1)) l))
(l3 (rotate-list-from-elment-and-cut-2 (car (last l2)) l))
(l4 (rotate-list-from-elment-and-cut-2 (car (last l3)) l))
(l5 (rotate-list-from-elment-and-cut-2 (car (last l4)) l))
(l6 (rotate-list-from-elment-and-cut-2 (car (last l5)) l))
(l7 (rotate-list-from-elment-and-cut-2 (car (last l6)) l))
(l8 (rotate-list-from-elment-and-cut-2 (car (last l7)) l))
(l9 (rotate-list-from-elment-and-cut-2 (car (last l8)) l)))
(append (butlast ll) (butlast l1) (butlast l2) (butlast l3) (butlast
l4)
(butlast l5) (butlast l6) (butlast l7) (butlast l8) (butlast l9))))
;;;
;;;(print (get-elements-in-a-list-at-random '(do re mi fa so la si)))
;;;(fa si do do fa so re la fa mi mi)
;;;
;;;(print (get-elements-in-a-list-at-random '(do mi so si)))
;;;(si mi mi do so si mi do mi so si mi mi mi si mi mi mi mi do)
;;;
(defun get-elements-in-a-list-at-random (l)
(do ((i 1 (1+ i))
(w))
((> i 20) (cut-list-at-length (+ (random 20) 1) w))
(push (nth (random (length l)) l) w)))
;;;
;;;(print (get-elements-in-a-list-at-random-2 '(do re mi fa so la si)))
;;;(si la re so fa so do do)
;;;
;;;(print (get-elements-in-a-list-at-random-2 '(do mi so si)))
;;;(mi si so so so mi so si mi so)
;;;
(defun get-elements-in-a-list-at-random-2 (l)
(do ((i 1 (1+ i))
(w))
((> i 10) (cut-list-at-length (+ (random 10) 1) w))
(push (nth (random (length l)) l) w)))