challenge ポーカーの役判定

引数に手札を与えると、ポーカーの役を表示するプログラムを作ってください。

条件:

  • スートはS,D,H,C、ランクはA,2~9,T,J,Q,Kのそれぞれ一文字で表します。
  • 手札は S2D5H3CQS9 のように10文字で指定されます。特にソートはされていません。
  • 手札にジョーカーは含まれません。
  • ストレートで取りうるランクの種類はA2345, 23456 ... 9TJQK, TJQKAの10種類で、JQKA2のようにK-A-2をまたぐものはストレートではありません。

実行例:

% ./poker SQSJSASKST
Royal flush

% ./poker D9D7D6D5D8
Straight flush

% ./poker C2D2S2H3H2
Four of a kind

% ./poker C2D3S2H3H2
Full house

% ./poker S9S4S8STSJ
Flush

% ./poker C4H7D5S6H3
Straight

% ./poker S6H6C5DQC6
Three of a kind

% ./poker S6HQC5DQC6
Two pair

% ./poker S6H4C5DQC6
One pair

% ./poker SJSQSKSAC2
No pair

お題にしようと思っていたのに間違えてしまいました。今から変更可能でしょうか?

(説明)
当初間違ってトピックに投稿していたので、このようなコメントを付けていたのですが、
このコメントに気づいた管理人さんにお題に移していただきました。
(最初の2つだけ投稿日時が早いのはそのためです)

Posted feedbacks - Common Lisp

簡潔になるようにしたつもりが、混沌としたものになってしまいました…。
実行結果:
(format t "~A => ~A~%" x (hand x "SQSJSASKST"))
;==>
;SQSJSASKST => Royal straight flash 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
(defpackage :doukaku-121 (:use :cl :ppcre))
(in-package :doukaku-121)

(defun break-part (str &optional (ace-val 1) &aux suit rank)
  (do-matches-as-strings (match "([SDHC][A2-9TJQK])" str)
    (push (schar match 0) suit)
    (push (schar match 1) rank))
  (values
   (sublis `((A . ,ace-val) (T . 10) (J . 11) (Q . 12) (K . 13))
           (mapcar (lambda (x)(read-from-string (string x))) 
                   (nreverse rank)))
   suit))

(defun flashp (str)
  (let ((s (nth-value 1 (break-part str))))
    (and (every (lambda (x) (char= (car s) x)) s) 'flash)))

(defun kinds (str)
  (let ((k (length (delete-duplicates (break-part str)))))
    (if (= k 5) nil k)))

(defun straightp (str)
  (flet ((check (str ace)
           (let ((lst (sort (break-part str ace) #'<)))
             (mapc (lambda (x y) (unless (= 1 (- y x)) (return-from check nil)))
                   lst (cdr lst))
             (values 'straight (if (= 1 ace) nil 'royal)))))
    (or (check str 1) (check str 14))))

(defun 3-2p (str)
  (do ((l (break-part str) (cdr l)))
      ((null (cddr l)) nil)
    (case (count (car l) l)
      (3 (return t))
      (4 (return nil)))))

(defun hand (str &optional (out t))
  (multiple-value-bind (straightp royalp) (straightp str)
    (let ((hand (list royalp straightp (flashp str) (kinds str) (3-2p str))))
      (destructuring-bind (ignore flashp kinds 3-2p) hand
        (declare (ignore ignore))
        (if 3-2p
            (case kinds
              (2 (format out "Full house"))
              (3 (format out "Three of a kind")))
            (case kinds
              (2 (format out "Four of a kind"))
              (3 (format out "Two pair"))
              (4 (format out "One paire"))
              (otherwise (if (or straightp flashp)
                             (format out "~@(~{~@[~A ~]~}~)" hand)
                             (format out "No pair")))))))))

Index

Feed

Other

Link

Pathtraq

loading...