A while ago I posted a robin-round tournament scheduler in ruby. Since I am going
through PAIP, I thought to give a functional common lisp version a go.
In my opinion it is more readable and flexible, but I would
attribute that to better design and experience than the
language. But CL's list utilities sure helped.
;;;; round-robin.lisp (defpackage :round-robin (:use :cl :lisp-unit)) (in-package :round-robin) ;; rotate-list-left : (listof X) integer -> (listof X) (defun rotate-list-left (a-list how-many-moves) "rotate the list how-many-moves to the left" (if (zerop how-many-moves) a-list (rotate-list-left (append (rest a-list) (list (first a-list))) (1- how-many-moves)))) ;; make-matches : (listof X) -> (listof X) (defun make-matches (players) (if (null players) nil (cons (cons (first players) (last players)) (make-matches (butlast (rest players)))))) ;; print-matches : (listof (listof X)) -> nil (defun print-matches (matches) (if (null matches) nil (progn (let ((current-match (first matches))) (print (format nil "~a against ~a!" (first current-match) (second current-match)))) (print-matches (rest matches))))) ;; round-robin : (listof X) -> nil (defun round-robin (players) "prints matches in round robin fashion" (defun do-matches (full-list-of-players max-number-of-rounds current-round) (if (>= current-round max-number-of-rounds) nil (progn (print-matches (make-matches (cons (first full-list-of-players) (rotate-list-left (rest full-list-of-players) current-round)))) (do-matches full-list-of-players max-number-of-rounds (1+ current-round))))) (let ((full-list (if (zerop (mod (length players) 2)) players (append players (list 'DUMMY))))) (do-matches full-list (length full-list) 1))) (define-test round-robin-utilities (print-matches '((a f) (b e) (c d))) ;; check output (assert-equal (rotate-list-left '(a b c d e f g h) 3) '(d e f g h a b c)) (assert-equal (make-matches '(a b c d e f)) '((a f) (b e) (c d)))) (define-test round-robin (print "Even number of players") (round-robin '(a b c d)) (print "Odd number of players") (round-robin '(a b c d e))) (run-tests)
Nenhum comentário:
Postar um comentário