;; Ces programmes sont sous licence CeCILL-B V1.
;; Exécution en ligne de commande avec Bigloo :
;; $ bigloo -i TriFusion.scm

;; initialisation d'un tableau avec des nombres aléatoires

(define (RandomInitialise items)
  (let ((nbItems (vector-length items)))
    (do ((item 0 (+ item 1)))
	((= item nbItems))
      (vector-set! items item (random 1000)))))

;; affichage d'un tableau

(define (AfficheTableau items)
  (let ((nbItems (vector-length items)))
    (do ((item 0 (+ item 1)))
	((= item nbItems))
      (display (vector-ref items item))
      (display " "))
    (newline)))

(define (TriFusion)
   (let* ((nbItems 16)
	  (items (make-vector nbItems 0))
	  (items1 (make-vector nbItems 0)))
;; initialisation du tableau avec des nombres aléatoires
      (RandomInitialise items)

;; affichage du tableau avant tri
      (AfficheTableau items)

      (do ((taille 1 (* taille 2)))
	  ((> taille nbItems))
	  (if (< taille nbItems)
	      (let ((debut 0)
		    (x 0)
		    (y taille))
		 (do ((i 0 (+ i 1)))
		     ((= i nbItems))
		     (if (or (and (< x (+ debut taille))
				  (< y (+ debut (* 2 taille)))
				  (< (vector-ref items x)
				     (vector-ref items y)))
			     (= y (+ debut (* 2 taille))))
			 (begin
			    (vector-set! items1 i
			       (vector-ref items x))
			    (set! x (+ x 1)))
			 (begin
			    (vector-set! items1 i
			       (vector-ref items y))
			    (set! y (+ y 1))))
		     (if (and (= x (+ debut taille))
			      (= y (+ debut (* taille 2))))
			 (begin
			    (set! debut (+ debut (* taille 2)))
			    (set! x debut)
			    (set! y (+ debut taille)))))
		 (do ((i 0 (+ i 1)))
		     ((= i nbItems))
		     (vector-set! items i
			(vector-ref items1 i)))) ))

      (AfficheTableau items)
      (newline)))

(TriFusion)