;;; Fichier Duval.lisp / 13 avril 2004
;;; algo de JP DUVAL, TCS 60 (1988) 255-283


;;; tableau obtenu par le fichier PygmeesRecur.lisp / 12 avril 2002

; n2  1  3  5  7   9  11  13   15   17   19
;n3-----------------------------------------
;2 |  1  1  1  1   1   1   1   1    1    1
;4 |  1  2  3  4   5   6   7   8    9    10
;6 |  1  4  7  12  19  26  35  46   57   70
;8 |  1  5  14 30  55  91  140 204  285
;10|  1  7  26 66  143 273 476 776
;12|  1  10 42 132
;14|  1  12
;16|  1  15

;;; article IPL 86 (2003) 255Ð261, 
;;; valeurs supplementaires de Louis-Martin ROUSSEAU (ILOG solver)

;10|  1  7  26 66  143 273 476  776  1197
;12|  1  10 42 132 335 728 1428 2586 4389


;;; ===================
;;; Algorithme de Duval
;;; ===================
;;; (duval n) calcule tous les mots de Lyndon sur a, b de longueur <= n

;? (duval 4)
;i=1, w=#(a a a a), lyndon=#(a)
;i=4, w=#(a a a b), lyndon=#(a a a b)
;i=3, w=#(a a b a), lyndon=#(a a b)
;i=4, w=#(a a b b), lyndon=#(a a b b)
;i=2, w=#(a b a b), lyndon=#(a b)
;i=3, w=#(a b b a), lyndon=#(a b b)
;i=4, w=#(a b b b), lyndon=#(a b b b)
;i=1, w=#(b b b b), lyndon=#(b)

(defun duval (n)
  (let ((w (make-array n))
        (i 1))
    (setf (aref w (- i 1)) 'a)
    (while (not (= i 0))
           (do ((j 1 (+ j 1)))
               ((> j (- n i)) 'ok)            
             (setf (aref w (- (+ i j) 1)) (aref w (- j 1))))
           (format t "i=~a, w=~a, lyndon=~a~%" i w (subseq w 0 i))        
           (setf i n)
           (while (and (> i 0) (eq (aref w (- i 1)) 'b))
                  (setf i (- i 1)))
           (if (> i 0) (setf (aref w (- i 1)) (succ (aref w (- i 1))))))))

(defun succ (x) (if (eq x 'a) 'b))



(defun duval1 (n alph)
  (let ((w (make-array n))
        (i 1))
    (setf (aref w (- i 1)) (first alph))
    (while (not (= i 0))
           (do ((j 1 (+ j 1)))
               ((> j (- n i)) 'ok)            
             (setf (aref w (- (+ i j) 1)) (aref w (- j 1))))
           (format t "i=~a, w=~a, lyndon=~a~%" i w (subseq w 0 i))        
           (setf i n)
           (while (and (> i 0) (eq (aref w (- i 1)) (car (last alph))))
                  (setf i (- i 1)))
           (if (> i 0) (setf (aref w (- i 1)) (succ1 (aref w (- i 1)) alph))))))

(defun succ1 (x alph) 
  (let ((tmp (member x alph)))
    (if (not (null (cdr tmp))) (cadr tmp)
        ())))


;;; ==================
;;; Imparite rythmique
;;; ==================


(defun duval-pygmees (na nb)
  (let* ((n (+ na nb))
         (resultat (make-array (list (+ n 1) (+ n 1))))
         (w (make-array n)) 
         (i 1))
    (setf (aref w (- i 1)) 'a)
    (while (not (= i 0))
           (do ((j 1 (+ j 1)))
               ((> j (- n i)) 'ok)            
             (setf (aref w (- (+ i j) 1)) (aref w (- j 1))))
           (setf lyndon (subseq w 0 i))    
           (let* ((ia (compte-lettre lyndon 'a))
                  (ib (compte-lettre lyndon 'b)))
             (setf (aref resultat ia ib) (+ (aref resultat ia ib) 1))
             (do ((k 2 (+ k 1)))
                 ((or (> (* k ia) na)
                      (> (* k ib) nb)) 'ajout-puissances-termine)
                 (setf (aref resultat (* k ia) (* k ib))
                       (+ (aref resultat (* k ia) (* k ib)) 1))))
           (setf i n)
           (while (and (> i 0) (eq (aref w (- i 1)) 'b))
                  (setf i (- i 1)))
           (if (> i 0) (setf (aref w (- i 1)) (succ (aref w (- i 1))))))
    (affiche-2-3 resultat na nb)))


(defun compte-lettre (lyndon x)
  (let ((imax (array-dimension lyndon 0)) (res 0))
    (do ((i 0 (+ i 1)))
        ((= i imax) res)
      (when (eq (aref lyndon i) x) (setf res (+ res 1))))))

;;; ia = nbre de a
;;; ib = nbre de b
;;; verticalement nbre de 3   = n3 (pair) = 2*ia
;;; horizontalement nbre de 2 = n2 impair = ib -> SI IMPAIR

(defun affiche-2-3 (res na nb)
  (do ((ia 1 (+ ia 1)))
      ((> ia na) 'stop)
    (format t "n3=~a   " (* 2 ia))
     (do ((ib 1 (+ ib 2)))
         ((> ib nb) (format t "~%") 'stop)
       (format t "~a " (aref res ia ib)))))


;;; 15 minutes de calcul:
;;; ---------------------
;? (duval-pygmees 8 21)
;n3=2   1 1 1 1 1 1 1 1 1 1 1 
;n3=4   1 2 3 4 5 6 7 8 9 10 11 
;n3=6   1 4 7 12 19 26 35 46 57 70 85 
;n3=8   1 5 14 30 55 91 140 204 285 385 506 
;n3=10   1 7 26 66 143 273 476 776 1197 1771 2530 
;n3=12   1 10 42 132 335 728 1428 2586 4389 7084 10966 
;n3=14   1 12 66 246 715 1768 3876 7752 14421 25300 42288 
;n3=16   1 15 99 429 1430 3978 9690 21318 43263 82225 148005