;;;
;;; (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)))