From 6761cf483dce9f6be10ce4c58f168c9e361f3490 Mon Sep 17 00:00:00 2001 From: Yoann Date: Wed, 15 Dec 2010 11:38:02 +0100 Subject: [PATCH] Stats & correction de bug. --- exo5.lisp | 94 +++++++++++++++++++++++++++++++++++++------------------ stat.sh | 6 ++++ 2 files changed, 70 insertions(+), 30 deletions(-) create mode 100644 stat.sh diff --git a/exo5.lisp b/exo5.lisp index 77045a7..8ab5ed0 100644 --- a/exo5.lisp +++ b/exo5.lisp @@ -46,8 +46,6 @@ do (setf (aref c index2) 0) finally (return ge))) -(transport->ecart (build-transport-list 0 8 '((1 8 9) (2 8 1) (3 5 2) (3 4 4) (3 2 4) (4 8 2) (5 8 2) (4 6 3) (6 7 5) (7 1 6)))) - (defun transport->couche (gt) (let ((ge (transport->ecart gt))) (make-couche :nb-noeuds (transport-nb-noeuds ge) @@ -127,18 +125,43 @@ return (get-flot gt ge) do (maj-ecart ge pcc delta))) -(defmacro mbuild-transport (name across/in) - `(defun ,name (source puits arcs+capa) +(defun nettoyer (arcs+capa) + (loop + with nb-noeuds = (1+ (max (loop for i in arcs+capa maximize (car i)) + (loop for i in arcs+capa maximize (cadr i)))) + and copaing + with arcs-sortants = (make-array nb-noeuds :initial-element nil) + initially (loop + for arc in arcs+capa + do (push (aref arcs-sortants (car arc)) arc)) + for arc in arcs+capa + for arcsrest = (setf (aref arcs-sortants (car arc)) (cdr (aref arcs-sortants (car arc)))) + unless (= (car arc) (cadr arc)) ;; boucle + if (setq copaing (find (cadr arc) arcsrest ;; arcs multiples + :key #'cadr)) + do (incf (caddr copaing) (caddr arc)) + else if (setq copaing (find (cadr arc) (aref arcs-sortants (cadr arc)) + :key #'identity)) + collect (list (car arc) nb-noeuds (caddr arc)) + and collect (list nb-noeuds (cadr arc) (caddr arc)) + and do (setf (car arc) nb-noeuds) + and do (incf nb-noeuds) + else + collect arc + end)) + +(defun build-transport-list (source puits arcs+capa) + (setq arcs+capa (nettoyer arcs+capa)) (loop with source = source and puits = puits - and nb-noeuds = (1+ (max (loop for i ,across/in arcs+capa maximize (car i)) - (loop for i ,across/in arcs+capa maximize (cadr i)))) + and nb-noeuds = (1+ (max (loop for i in arcs+capa maximize (car i)) + (loop for i in arcs+capa maximize (cadr i)))) and nb-arcs = (length arcs+capa) with arcs-sortants = (make-array nb-noeuds :initial-element nil) and arcs = (make-array nb-arcs) and capa = (make-array nb-arcs) - for ac ,across/in arcs+capa + for ac in arcs+capa for i upfrom 0 do (push i (aref arcs-sortants (car ac))) do (setf (aref arcs i) (cons (car ac) (cadr ac))) @@ -149,11 +172,11 @@ :puits puits :arcs-sortants arcs-sortants :arcs arcs - :capacites capa))))) - -(mbuild-transport build-transport-array across) -(mbuild-transport build-transport-list in) + :capacites capa)))) +(defun build-transport-array (source puits arcs+capa) + (build-transport-list source puits (map 'list #'identity arcs+capa))) + (defun liste-plus-courts-chemins (gc) "Modifie les arcs présents dans un graphe de couche (seuls les arcs qui font partie d'un plus court chemin de s à t sont conservés)." (loop named pcc @@ -265,28 +288,39 @@ and do (push (list x y (random maxcapa)) arcs)) finally (return (build-transport-list 0 (- n 1) arcs)))) -(defvar exemple-gt (build-transport-array 0 3 #((0 1 3) (0 2 2) (1 3 4) (2 3 1) (2 1 1)))) +;; (defvar exemple-gt (build-transport-array 0 3 #((0 1 3) (0 2 2) (1 3 4) (2 3 1) (2 1 1)))) -(edmonds-karp exemple-gt) -;; => 5 -(edmonds-karp (build-graphe-exemple 5 3)) -(car (edmonds-karp (build-graphe-exemple 20))) -(car (edmonds-karp (build-graphe-exemple 100 10))) -(car (edmonds-karp (build-graphe-exemple 1000 10 40))) -(car (edmonds-karp (build-graphe-exemple 10000 10 100))) +;; (edmonds-karp exemple-gt) +;; ;; => 5 +;; (edmonds-karp (build-graphe-exemple 5 3)) +;; (car (edmonds-karp (build-graphe-exemple 20))) +;; (car (edmonds-karp (build-graphe-exemple 100 10))) +;; (car (edmonds-karp (build-graphe-exemple 1000 10 40))) +;; (car (edmonds-karp (build-graphe-exemple 10000 10 100))) -(dinic exemple-gt) -;; => 5 +;; (dinic exemple-gt) +;; ;; => 5 -;; TODO : - -(defun test-between (maxn &optional (minn 3) (nb-average 5)) +(defun test-between (maxn &optional (nb-average 5) (minn 3)) (loop for n from (max minn 3) to maxn + for gts = (loop + repeat nb-average + collect (build-graphe-exemple n)) + for eks = (progn + (format t "~&ek ~a~&" n) + (time (loop + for gt in gts + collect (car (edmonds-karp gt))))) + for ds = (progn + (format t "~&di ~a~&" n) + (time (loop + for gt in gts + collect (car (dinic gt))))) do (loop - for repeat from 1 to nb-average - for gt = (build-graphe-exemple n) - for ek = (car (progn (format t "~&ek ~a ~a~&" n repeat) (time (edmonds-karp gt)))) - for d = (car (progn (format t "~&di ~a ~a~&" n repeat) (time (dinic gt)))) - unless (= ek d) - do (error "edmonds-karp et dinic ont des résultats différents ! Le graphe :~&~a" gt)))) + for gt in gts + for ek in eks + for d in ds + unless (equal ek d) + do (print gt) + and do (error "edmonds-karp et dinic ont des résultats différents ! Le graphe : ~a et ~a pour" ek d)))) diff --git a/stat.sh b/stat.sh new file mode 100644 index 0000000..36a7580 --- /dev/null +++ b/stat.sh @@ -0,0 +1,6 @@ +#!/bin/sh + +echo '(load "exo5") (test-between 300 40 3)' | sbcl > /tmp/$$-stat +cat /tmp/$$-stat | grep -v '^ek' | grep -v '^di' | tail -n +10 | grep -v '^ \[' | head -n -1 > /tmp/$$-stat2 +cat /tmp/$$-stat2 | while read ab; do read ab; ab="${ab# }" echo -n "${ab%% *} "; read ab; read ab; read ab; read ab; ab="${ab# }" echo "${ab%% *}"; read ab; done > /tmp/$$-stat3 +cat /tmp/$$-stat3 | while read ab; do read xy; echo "$ab $xy"; done