Hand
Die Klasse hand repräsentiert eine Hand im Poker, das sind mindestens 5 Karten (siehe Karte). Die Klasse ist von keiner anderen Klasse abgeleitet.
(defclass hand ())
Die Hilfsfunktion list-to-set macht aus einer Liste eine Liste ohne mehrfach vorkommende Elemente.
(defproc list-to-set (l)
(when l
(adjoin (first l) (list-to-set (rest l)))))
Die Hilfsfunktion counts liefert für jedes Element in der Menge s die Anzahl des Zutreffens des Tests test für die Elemente der Liste l.
(defproc counts (s l test)
(map-with
(lambda (e) (count-if (curry (test _ e)) l))
s))
Der Konstruktor überprüft, ob ihm fünf oder mehr Karten übergeben wurden. Die Karten werden in einer Instanzvariablen gemerkt. Dann werden die Mengen der Farben und der Werte der Karten bestimmt. Für jeden vorkommenden Wert und jede vorkommende Farbe wird dessen bzw. deren Häufigkeit des Auftretens bestimmt. Es wird gezählt, wie oft ein Wert 4-, 3- oder 2-mal vorkommt. Diese abgeleiteten Informationen werden in Instanzvariablen gespeichert. Danach wird die Instanz eingefroren.
(defmethod initialize ((this hand) cards)
(and
(> (length cards) 4)
(every? (curry (instance-of? _ card)) cards))
(let
((suits (list-to-set (map-with (curry (slot-value _ (quote suit))) cards)))
(ranks (list-to-set (map-with (curry (slot-value _ (quote rank))) cards))))
(let
((rank-counts (counts ranks cards has-rank?))
(suit-counts (counts suits cards has-suit?)))
(let
((quadruples (count-if (curry (= _ 4)) rank-counts))
(triples (count-if (curry (= _ 3)) rank-counts))
(pairs (count-if (curry (= _ 2)) rank-counts)))
(progn
(.= this cards cards)
(.= this ranks ranks)
(.= this suit-counts suit-counts)
(.= this quadruples quadruples)
(.= this triples triples)
(.= this pairs pairs)
(freeze this))))))
Die Methode has-card? überprüft, ob die Hand eine Karte mit dem angegebenen Wert und der angegebenen Farbe enthält.
(defmethod has-card? ((this hand) rank suit)
t
(with-slots-read-only (cards) this
(member-if?
(lambda (card)
(and
(has-rank? card rank)
(has-suit? card suit)))
cards)))
Die Methode to-string liefert eine Liste der Zeichenketten-Repräsentationen der Karten.
(defmethod to-string ((this hand))
t
(with-slots-read-only (cards) this
(map-with to-string cards)))
Die Methode get-category bestimmt, zu welcher Kategorie die Hand gehört. Dazu bedient sie sich der Prädikate, die für die Kategorien definiert sind. Die Prädikate sind so definiert, dass sie die bestmögliche Kategorie für 5 Karten aus der Hand ermitteln.
(defmethod get-category ((this hand))
t
(cond
((straight-flush? this) (quote straight-flush))
((four-of-a-kind? this) (quote four-of-a-kind))
((full-house? this) (quote full-house))
((flush? this) (quote flush))
((straight? this) (quote straight))
((three-of-a-kind? this) (quote three-of-a-kind))
((two-pairs? this) (quote two-pairs))
((one-pair? this) (quote one-pair))
(t (quote high-card))))
Die Methode straight-flush? prüft, ob die Hand ein Straight Flush ist. Das ist der Fall, wenn die Hand ein Straight ist, für den alle Karten die gleiche Farbe haben.
(defmethod straight-flush? ((this hand))
t
(aand
(straight? this)
(some?
(lambda (straight-ranks)
(some?
(lambda (suit)
(every?
(curry (has-card? this _ suit))
straight-ranks))
*suits*))
it)))
Die Methode four-of-a-kind? überprüft, ob die Hand vier Karten mit gleichem Wert enthält.
(defmethod four-of-a-kind? ((this hand))
t
(with-slots-read-only (quadruples) this
(> quadruples 0)))
Die Methode full-house? überprüft, ob die Hand ein Full House ist - also ein Wert drei Mal und ein anderer zwei Mal vorkommt.
(defmethod full-house? ((this hand))
t
(with-slots-read-only (quadruples triples pairs) this
(and
(= quadruples 0)
(> triples 0)
(> (+ triples pairs) 1))))
Die Methode flush? überprüft, ob die Hand ein Flush ist - fünf Karten mit der gleichen Farbe.
(defmethod flush? ((this hand))
t
(with-slots-read-only (suit-counts) this
(some?
(lambda (count) (> count 4))
suit-counts)))
Die Methode straight? überprüft, ob die Hand ein Straight ist.
(defmethod straight? ((this hand))
t
(with-slots-read-only (ranks) this
(select-if
(curry (subset? _ ranks))
(quote
((ace two three four five)
(two three four five six)
(three four five six seven)
(four five six seven eight)
(five six seven eight nine)
(six seven eight nine ten)
(seven eight nine ten jack)
(eight nine ten jack queen)
(nine ten jack queen king)
(ten jack queen king ace))))))
Die Methode three-of-a-kind? überprüft, ob die Hand den gleichen Wert drei Mal enthält.
(defmethod three-of-a-kind? ((this hand))
t
(with-slots-read-only (quadruples triples) this
(and
(= quadruples 0)
(= triples 1))))
Die Methode two-pairs? überprüft, ob die Hand zwei Paare enthält.
(defmethod two-pairs? ((this hand))
t
(with-slots-read-only (quadruples triples pairs) this
(and
(= quadruples 0)
(= triples 0)
(> pairs 1))))
Die Methode one-pair? überprüft, ob die Hand ein Paar enthält.
(defmethod one-pair? ((this hand))
t
(with-slots-read-only (quadruples triples pairs) this
(and
(= quadruples 0)
(= triples 0)
(= pairs 1))))
(defclass hand ())
Die Hilfsfunktion list-to-set macht aus einer Liste eine Liste ohne mehrfach vorkommende Elemente.
(defproc list-to-set (l)
(when l
(adjoin (first l) (list-to-set (rest l)))))
Die Hilfsfunktion counts liefert für jedes Element in der Menge s die Anzahl des Zutreffens des Tests test für die Elemente der Liste l.
(defproc counts (s l test)
(map-with
(lambda (e) (count-if (curry (test _ e)) l))
s))
Der Konstruktor überprüft, ob ihm fünf oder mehr Karten übergeben wurden. Die Karten werden in einer Instanzvariablen gemerkt. Dann werden die Mengen der Farben und der Werte der Karten bestimmt. Für jeden vorkommenden Wert und jede vorkommende Farbe wird dessen bzw. deren Häufigkeit des Auftretens bestimmt. Es wird gezählt, wie oft ein Wert 4-, 3- oder 2-mal vorkommt. Diese abgeleiteten Informationen werden in Instanzvariablen gespeichert. Danach wird die Instanz eingefroren.
(defmethod initialize ((this hand) cards)
(and
(> (length cards) 4)
(every? (curry (instance-of? _ card)) cards))
(let
((suits (list-to-set (map-with (curry (slot-value _ (quote suit))) cards)))
(ranks (list-to-set (map-with (curry (slot-value _ (quote rank))) cards))))
(let
((rank-counts (counts ranks cards has-rank?))
(suit-counts (counts suits cards has-suit?)))
(let
((quadruples (count-if (curry (= _ 4)) rank-counts))
(triples (count-if (curry (= _ 3)) rank-counts))
(pairs (count-if (curry (= _ 2)) rank-counts)))
(progn
(.= this cards cards)
(.= this ranks ranks)
(.= this suit-counts suit-counts)
(.= this quadruples quadruples)
(.= this triples triples)
(.= this pairs pairs)
(freeze this))))))
Die Methode has-card? überprüft, ob die Hand eine Karte mit dem angegebenen Wert und der angegebenen Farbe enthält.
(defmethod has-card? ((this hand) rank suit)
t
(with-slots-read-only (cards) this
(member-if?
(lambda (card)
(and
(has-rank? card rank)
(has-suit? card suit)))
cards)))
Die Methode to-string liefert eine Liste der Zeichenketten-Repräsentationen der Karten.
(defmethod to-string ((this hand))
t
(with-slots-read-only (cards) this
(map-with to-string cards)))
Die Methode get-category bestimmt, zu welcher Kategorie die Hand gehört. Dazu bedient sie sich der Prädikate, die für die Kategorien definiert sind. Die Prädikate sind so definiert, dass sie die bestmögliche Kategorie für 5 Karten aus der Hand ermitteln.
(defmethod get-category ((this hand))
t
(cond
((straight-flush? this) (quote straight-flush))
((four-of-a-kind? this) (quote four-of-a-kind))
((full-house? this) (quote full-house))
((flush? this) (quote flush))
((straight? this) (quote straight))
((three-of-a-kind? this) (quote three-of-a-kind))
((two-pairs? this) (quote two-pairs))
((one-pair? this) (quote one-pair))
(t (quote high-card))))
Die Methode straight-flush? prüft, ob die Hand ein Straight Flush ist. Das ist der Fall, wenn die Hand ein Straight ist, für den alle Karten die gleiche Farbe haben.
(defmethod straight-flush? ((this hand))
t
(aand
(straight? this)
(some?
(lambda (straight-ranks)
(some?
(lambda (suit)
(every?
(curry (has-card? this _ suit))
straight-ranks))
*suits*))
it)))
Die Methode four-of-a-kind? überprüft, ob die Hand vier Karten mit gleichem Wert enthält.
(defmethod four-of-a-kind? ((this hand))
t
(with-slots-read-only (quadruples) this
(> quadruples 0)))
Die Methode full-house? überprüft, ob die Hand ein Full House ist - also ein Wert drei Mal und ein anderer zwei Mal vorkommt.
(defmethod full-house? ((this hand))
t
(with-slots-read-only (quadruples triples pairs) this
(and
(= quadruples 0)
(> triples 0)
(> (+ triples pairs) 1))))
Die Methode flush? überprüft, ob die Hand ein Flush ist - fünf Karten mit der gleichen Farbe.
(defmethod flush? ((this hand))
t
(with-slots-read-only (suit-counts) this
(some?
(lambda (count) (> count 4))
suit-counts)))
Die Methode straight? überprüft, ob die Hand ein Straight ist.
(defmethod straight? ((this hand))
t
(with-slots-read-only (ranks) this
(select-if
(curry (subset? _ ranks))
(quote
((ace two three four five)
(two three four five six)
(three four five six seven)
(four five six seven eight)
(five six seven eight nine)
(six seven eight nine ten)
(seven eight nine ten jack)
(eight nine ten jack queen)
(nine ten jack queen king)
(ten jack queen king ace))))))
Die Methode three-of-a-kind? überprüft, ob die Hand den gleichen Wert drei Mal enthält.
(defmethod three-of-a-kind? ((this hand))
t
(with-slots-read-only (quadruples triples) this
(and
(= quadruples 0)
(= triples 1))))
Die Methode two-pairs? überprüft, ob die Hand zwei Paare enthält.
(defmethod two-pairs? ((this hand))
t
(with-slots-read-only (quadruples triples pairs) this
(and
(= quadruples 0)
(= triples 0)
(> pairs 1))))
Die Methode one-pair? überprüft, ob die Hand ein Paar enthält.
(defmethod one-pair? ((this hand))
t
(with-slots-read-only (quadruples triples pairs) this
(and
(= quadruples 0)
(= triples 0)
(= pairs 1))))