;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ASHBY-OPERATOR:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; i coded somethings special, that i have seen in a book
;;; of HEINZ VON FOERSTER (my favorite writer/philosopher..)
;;; https://en.wikipedia.org/wiki/Heinz_von_Foerster
;;; => i didn't found this ASHBY-algo (he is writing about it)
;;; anywhere else, but for me it was interesting to code it.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; every list of integers (from 0 to ?) will end with "0"
;;; perhaps you could map it with whatever you want .......

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun ashby-operator-1 (liste)
  (append (list liste)
                (loop 
                  with slot-pos
                  with slot-val
                  with slot-product
                  
                  ;; choose two positions in the list
                  do (setq slot-pos (loop repeat 2
                                      collect (random (length liste))))
                  
                  ;; picks the values from the positions
                  do (setq slot-val (list (nth (first slot-pos) liste) (nth (second slot-pos) liste))
                           ;; gen the product of the two values
                           slot-product (* (first slot-val) (second slot-val)))
                  
                  ;; replace the value of the first pos with the (first (explode slot-product))
                  ;; or when it's < 10 with 0
                  do (setq liste (loop for i in liste
                                   for cnt = 0 then (incf cnt)
                                   
                                   when (= cnt (first slot-pos))
                                   collect (if (> slot-product 9)
                                             (first (explode slot-product))
                                             (append 0))
                                   else collect i))

                  ;; replace the value of the second pos with the (second (explode slot-product))
                  ;; or or when it's < 10 with the slot-product
                  collect (setq liste (loop for i in liste
                                        for cnt = 0 then (incf cnt)
                                        when (= cnt (second slot-pos))
                                        collect (if (> slot-product 9)
                                                  (second (explode slot-product))
                                                  (append slot-product))
                                        else collect i)) 
                  into bag ;; collects all into bag

                  ;; when LISTE only '(0 0 0 0 0 ...) return all generations
                  when (= (sum liste) 0)
                  do (return bag))))



;;;examples

(ashby-operator-1 '(0 1 2 3 4 5 6 7 8 9))

(list-plot
 (flatten 
  (ashby-operator-1 '(0 1 2 3 4 5 6 7 8 9 11)))
 :point-radius 0.1 :style :fill :line-width 1)

(integer-to-pitch
 (ashby-operator-1 '(0 1 2 3 4 5 6 7 8 9 10 11)))

(chordize-list
 (integer-to-pitch
  (remove-duplicates
  (ashby-operator-1 '(0 1 2 3 5 8 13)))))

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ASHBY-OPERATOR => some nonsense-sound-examples
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; little function for mapping...

(defun eliminate-repetitions (liste)

  (let ((liste (append liste (list 'nil))))
    (loop repeat (1- (length liste))
      with cnt = 0
      when  (not (equal (nth cnt liste) (nth (+ 1 cnt) liste)))
      collect (nth cnt liste)      
      do (incf cnt))))


;;; some examples

;(setq integers
;      (flatten (ashby-operator-1 '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17))))
(setq integers
      (flatten (ashby-operator-1 '( 3 1 4 0 7 8 9 10  5 6 2 11))))
;(setq integers
 ;     (flatten (ashby-operator-1 (gen-sieve '(c4 c7) '(1 2 3)))))


;;; mapping

(setq pitches (eliminate-repetitions (integer-to-pitch integers)))

(def-score example
           (:key-signature 'chromatic
                           :time-signature '(4 8)
                           :tempo '(e 176)
                           :layout (bracket-group 
                                    (piano-grand-layout 'piano)))
  (piano 
   :omn  (setq omn-list (make-omn :pitch pitches
                                  :length (loop repeat (length pitches) collect 1/32)))
   :sound 'gm-piano))
#|

(def-score example-reverse
           (:key-signature 'chromatic
                           :time-signature '(4 8)
                           :tempo '(e 176)
                           :layout (bracket-group 
                                    (piano-grand-layout 'piano)))
  (piano 
   :omn  (setq omn-list (make-omn :pitch (reverse pitches)
                                  :length (loop repeat (length pitches) collect 1/32)))
   :sound 'gm-piano))
|#