terça-feira, 7 de dezembro de 2010

Functional Round-Robin scheduler in Common Lisp

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)
      (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)
      (cons (cons (first players)
                  (last players))
            (make-matches (butlast (rest players))))))

;; print-matches : (listof (listof X)) -> nil
(defun print-matches (matches)
  (if (null matches)
        (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
    (if (>= current-round max-number-of-rounds)
        (progn (print-matches
                 (cons (first full-list-of-players)
                       (rotate-list-left (rest full-list-of-players)
               (do-matches full-list-of-players
                 (1+ current-round)))))
  (let ((full-list (if (zerop (mod (length players) 2))
                       (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)))


Nenhum comentário:

Postar um comentário