gen-stacc => variants

[AM]

;;;;; 
;;;;; gen-stacc2 and gen-stacc3 => usefull tools to build little variants

;;;; subfunctions => also possible with prob?

(defun weighted-random (list)
  (loop for item in list
            with rand-num = (random (loop for x in list sum (second x)))
            for add = (second item) then (+ add (second item))
            when (< rand-num add) return (first item)))
                            
(defun weighted-t/nil (on-weight)
  (let ((off-weight (- 1 on-weight)))
    (weighted-random (list (list 't on-weight) (list 'nil off-weight)))))

                            
;;;; mainfunctions
                            
(defun gen-stacc (liste)
  (if (numberp liste) 
    (if (> (numerator liste) 1)
      (list (/ 1 (denominator liste)) (/ (* -1 (- (numerator liste) 1)) (denominator liste)))
      (list liste))
    (loop for i in liste
      append (if (> (numerator i) 1)
               (list (/ 1 (denominator i)) (/ (* -1 (- (numerator i) 1)) (denominator i)))
               (list i)))))

  
(gen-stacc '(1/32 7/32 9/32 17/32))
(gen-stacc '(3/8))

;;

(defun gen-stacc2 (n liste &key (stacc-chance 1))
  (loop for i in liste
    when (and (> i n) (equal (weighted-t/nil stacc-chance) 't))
    append (list n (* -1 (- (abs i) n)))
    else collect i))

(gen-stacc2 1/32 '(1/32 7/32 9/32 17/32) :stacc-chance 0.5)

;;

(defun gen-stacc3 (n-liste liste &key (stacc-chance 1))
  (loop for i in liste
    with n
    do (setq n (rnd-pick n-liste))
    when (and (> i n) (equal (weighted-t/nil stacc-chance) 't))
    append (list n (* -1 (- (abs i) n)))
    else collect i))

(gen-stacc3 '(1/32 5/32) '(1/32 7/32 5/32 9/32 17/32 3/8 9/32 17/32) :stacc-chance 0.5)


;;;;;;

 

Edited August 7, 2016 by AM
missing function edited

[Stephane Boussuge]

Hi,

weighted-random is missed in that file.

 

Thanks for your very interesting posts.

 

SB

 

[AM]

thank you, i just like it :-)

know everythings seems complete...