(in-package :lol)



(defun alea-comb (sets)
  (let ((r '()))
    (dotimes (n (length sets) (reverse r))
      (let ((list (nth n sets)))
        (push (nth (random (length list)) list) r)))))


#|
(alea-comb '((a b) (1 2 3) (100 200 300 400)))
|#


#|

(defmethod alea-sets ((N integer) &rest lists)
  (let ((r '()))
    (dotimes (i N r)
      (push (alea-comb lists) r))))

(alea-sets 24 '(a b) '(1 2 3) '(100 200 300 400))
|#

(defun 2sets-product (set1 set2 res)
  (if (not set1)
    res
    (let ((r '())
          (elt (pop set1)))
      (dotimes (n (length set2) )
        (push (list elt (nth n set2)) r))
      (setf r (reverse r))
      (2sets-product set1 set2 (append res r)))))

#|
(length (2sets-product '(a b c) '(0 1 2 3 4 5 6) '()))
|#



(defun set-product (set1 &rest sets)
  (when (listp (caadr sets))
    (setf sets (append (list (car sets)) (cadr sets))))
  (if (null (cadr sets))
    (mapcar #'fflat (2sets-product set1 (car sets) '()))
    (let* ((rt (2sets-product (pop sets) (pop sets) '())))
      (set-product set1 (mapcar #'fflat rt) sets))))
    
#|
(2sets-product '(0 1) '(e f g) '())
(2sets-product '(a b c) '((0 E) (0 F) (0 G) (1 E) (1 F) (1 G)) '())

(set-product '(0 1) '(e nil g) '(a b))
(set-product '(0 1) '(e f g) '(a b) '(alpha beta))
(set-product '(0 1) '(e f g) '(a b) '(alpha beta) '(11 12 13 14 15 16))
(set-product '(a b c) '((0 E) (0 F) (0 G) (1 E) (1 F) (1 G)))
(set-product '(a b c) '(h i) '((0 E) (0 F) (0 G) (1 E) (1 F) (1 G)))
|#


(defun cartesian2 (A B)
  "Returns the cartesian products of A and B."
  (loop for e1 in A
        append (loop for e2 in B
                 collect (list e1 e2))))

(defun cartesian (A &rest rest)
  "Generalized cartesian product."
  (mapcar 'fflat (reduce 'cartesian2 (cons A rest))))


#|
(cartesian2 '(a nil c) '((0 E) (0 F) (0 G) (1 E) (1 F) (1 G)))
(cartesian '(a b c) '((0 E) (0 F) (0 G) (1 E) (1 F) (1 G)))
(cartesian '(a b c) '(h i) '((0 E) (0 F) (0 G) (1 E) (1 F) (1 G)))
(cartesian '(a b c) '(h w! i) '(1 2 3 4))
|#



(defun ror (a &rest b)
  "Recursive or"
  (setf b (fflat b))
  (if a
    a
    (let ((c (pop b)))
      (ror c b))))



(defun editing-distance (seq1 seq2 replace insert 
                              &key (test #'equalp) (scale t) (fact 1))
  "Returns the smallest distance between two lists of symbols seq1 and seq2.
Args :
 <cost if replace>, <cost if insert or delete>.
key :
:test for equality test, :scale, scaling of the distance, absolute or relative (to seq1)."
  
  (let ((matcouts()) d d1 d2 d3 c c1 (rep replace) (ins insert))
    
    (dotimes (j (+ (length seq2) 1))
      (dotimes (i (+ (length seq1) 1))
        (setf d (+ i (* j (+ (length seq1) 1))))
        ;--- SI i et j differents de 0 => cas d'un changement ---
        (cond ((and (> i 0) (> j 0))
               ;;calcul du cout
               (if (funcall test (nth (- i 1) seq1) (nth (- j 1) seq2))
                 (setf c1 0)
                 (setf c1 rep ;(if (member (nth (- i 1) seq1) seq2)
                                 ;rep (* 2 rep))
                       rep (+ (* rep fact) rep)))
               ;;calcul de D(i,j)
               (setf d1 (nth (+ 1 (length seq1)) matcouts)
                     d2 (nth (length seq1) matcouts)
                     d3 (nth 0 matcouts))
               ;;calcul de cout mini
               (setf c (funcall #'min (+ c1 d1) (+ 1 d2) (+ 1 d3)))
               (push c matcouts))
              ;--- SI i ou j = 0  => cas d'une suppression ou insertion 
              ;   (= changement par element neutre) ---
              (t
               ;;calcul du cout
               (if (and (= i 0) (= j 0))
                 (setf c1 0)
                 (setf c1 ins
                       ins (+ ins (* fact insert))))
               ;;si i = 0 et j> 0
               (cond ((and (eq i 0) (> j 0))
                      ;calcul de D(i,j)
                      (setf d (nth (length seq1) matcouts))
                      (setf c (+ c1 d))
                      (push c matcouts))
                     ;;si i > 0 et j = 0
                     ((and (> i 0) (= j 0))
                      ;calcul de D(i,j)
                      (setf d (nth 0 matcouts))
                      (setf c (+ c1 d))
                      (push c matcouts))
                     (t (push '0 matcouts) (setf c '0)))))))
    (if scale
      (float (/ (car matcouts) (length seq1)))
      (car matcouts))))

;(editing-distance '('a 'b 'c) '('a 'b 'b) 1 1 :test #'eq)