ホーム - Project Euler

Problem 54¶

Poker Hands¶

In the card game poker, a hand consists of five cards and are ranked, from lowest to highest, in the following way:

• High Card : Highest value card.
• One Pair : Two cards of the same value.
• Two Pairs : Two different pairs.
• Three of a Kind : Three cards of the same value.
• Straight : All cards are consecutive values.
• Flush : All cards of the same suit.
• Full House : Three of a kind and a pair.
• Four of a Kind : Four cards of the same value.
• Straight Flush : All cards are consecutive values of same suit.
• Royal Flush : Ten, Jack, Queen, King, Ace, in same suit.

The cards are valued in the order:
2, 3, 4, 5, 6, 7, 8, 9, 10, Jack, Queen, King, Ace.
If two players have the same ranked hands then the rank made up of the highest value wins; for example, a pair of eights beats a pair of fives (see example 1 below). But if two ranks tie, for example, both players have a pair of queens, then highest cards in each hand are compared (see example 4 below); if the highest cards tie then the next highest cards are compared, and so on.

Consider the following five hands dealt to two players:

The file, poker.txt, contains one-thousand random hands dealt to two players. Each line of the file contains ten cards (separated by a single space): the first five are Player 1's cards and the last five are Player 2's cards. You can assume that all hands are valid (no invalid characters or repeated cards), each player's hand is in no specific order, and in each hand there is a clear winner.

How many hands does Player 1 win?

ポーカーハンド¶

カードゲームのポーカーでは, 手札は5枚のカードからなりランク付けされている. 役を低い方から高い方へ順に並べると以下である.

• 役無し(ハイカード) : 一番値が大きいカード
• ワン・ペア : 同じ値のカードが2枚
• ツー・ペア : 2つの異なる値のペア
• スリーカード : 同じ値のカードが3枚
• ストレート : 5枚の連続する値のカード
• フラッシュ : 全てのカードが同じスート (注: スートとはダイヤ・ハート・クラブ/スペードというカードの絵柄のこと)
• フルハウス : スリーカードとペア
• フォーカード : 同じ値のカードが4枚
• ストレートフラッシュ : ストレートかつフラッシュ
• ロイヤルフラッシュ : 同じスートの10, J, Q, K, A

ここでカードの値は小さい方から2, 3, 4, 5, 6, 7, 8, 9, 10, J, Q, K, Aである. (訳注：データ中で10は'T'と表される)

もし2人のプレイヤーが同じ役の場合には, 役を構成する中で値が最も大きいカードによってランクが決まる: 例えば, 8のペアは5のペアより強い (下の例1を見よ). それでも同じランクの場合には (例えば, 両者ともQのペアの場合), 一番値が大きいカードによってランクが決まる (下の例4を見よ). 一番値が大きいカードが同じ場合には, 次に値が大きいカードが比べれられ, 以下同様にランクを決定する.

例:

poker.txtには1000個のランダムな手札の組が含まれている. 各行は10枚のカードからなる (スペースで区切られている): 最初の5枚がプレイヤー1の手札であり, 残りの5枚がプレイヤー2の手札である. 以下のことを仮定してよい

• 全ての手札は正しい (使われない文字が出現しない. 同じカードは繰り返されない)
• 各プレイヤーの手札は特に決まった順に並んでいるわけではない
• 各勝負で勝敗は必ず決まる

1000回中プレイヤー1が勝つのは何回か? (訳注 : この問題に置いてA 2 3 4 5というストレートは考えなくてもよい)

(import (scheme base)
        (gauche base)
        (scheme file)
        (scheme sort)
        (gauche record))

(define (read-file filename)
  (call-with-output-string
    (^[string-port]
      (call-with-input-file
        filename
        (^[file-port]
          (let loop ([line (read-line file-port)])
            (unless (eof-object? line)
              (format string-port "~a~%" line)
              (loop (read-line file-port)))))
        :element-type :character))))

(define (read-to-list filename)
  (string-split (read-file filename)
                #[\s]
                'suffix))

(define (analyze-list lis)
  (let loop ([rest lis]
             [current '()]
             [result '()])
    (cond
      [(and (null? rest)
            (null? current))
       (reverse result)]
      [(null? rest)
       (reverse
         (cons (reverse current)
               result))]
      [(<= 5 (length current))
       (loop rest
             '()
             (cons (reverse current)
                   result))]
      [else
        (loop (cdr rest)
              (cons (car rest)
                    current)
              result)])))

(define-record-type cardinfo #t #t
  flush? numbers)

(define (card->suit card)
  (string-ref card 1))

(define (card->number card)
  (ecase (string-ref card 0)
    [(#\2) 2]
    [(#\3) 3]
    [(#\4) 4]
    [(#\5) 5]
    [(#\6) 6]
    [(#\7) 7]
    [(#\8) 8]
    [(#\9) 9]
    [(#\T) 10]
    [(#\J) 11]
    [(#\Q) 12]
    [(#\K) 13]
    [(#\A) 14]))

(define (same-suit? cards)
  (let loop ([rest cards] [suit #f])
    (cond
      [(null? rest) #t]
      [(not suit)
       (loop (cdr rest)
             (card->suit (car rest)))]
      [(char=? suit
               (card->suit (car rest)))
       (loop (cdr rest) suit)]
      [else #f])))

(define (cards->cardinfo cards)
  (let ([sorted-numbers (list-sort
                          <
                          (map card->number cards))])
    (let loop ([rest-numbers sorted-numbers]
               [current-num #f]
               [current-count 0]
               [card-result '()])
      (cond
        [(null? rest-numbers)
         (make-cardinfo (same-suit? cards)
                        (cons `(,current-num . ,current-count)
                              card-result))]
        [(zero? current-count)
         (loop (cdr rest-numbers)
               (car rest-numbers)
               1
               card-result)]
        [(= current-num (car rest-numbers))
         (loop (cdr rest-numbers)
               current-num
               (+ current-count 1)
               card-result)]
        [else
          (loop (cdr rest-numbers)
                (car rest-numbers)
                1
                (cons `(,current-num . ,current-count)
                      card-result))]))))

(define (royal-flush? cardinfo)
  (let ([result (straight? cardinfo)])
    (and result
         (= result 14)
         (flush? cardinfo))))

(define (straight-flush? cardinfo)
  (and (straight? cardinfo)
       (flush? cardinfo)))

(define (four-card? cardinfo)
  (let ([result (find (^c
                        (= (cdr c) 4))
                      (cardinfo-numbers cardinfo))])
    (if result
      (car result)
      #f)))

(define (full-house? cardinfo)
  (and (one-pair? cardinfo)
       (three-card? cardinfo)))

(define (flush? cardinfo)
  (if (cardinfo-flush? cardinfo)
    (caar (cardinfo-numbers cardinfo))
    #f))

(define (straight? cardinfo)
  (let ([numbers (cardinfo-numbers cardinfo)])
    (if (< (length numbers) 5)
      #f
      (let loop ([rest numbers] [current #f])
        (cond
          [(null? rest) (caar numbers)]
          [(not current)
           (loop (cdr rest) (caar rest))]
          [(= (- current 1) (caar rest))
           (loop (cdr rest) (caar rest))]
          [else #f])))))

(define (three-card? cardinfo)
  (let ([result (find (^c
                        (= (cdr c) 3))
                      (cardinfo-numbers cardinfo))])
    (if result
      (car result)
      #f)))

(define (two-pair? cardinfo)
  (let ([result (filter (^c
                          (= (cdr c) 2))
                        (cardinfo-numbers cardinfo))])
    (if (<= 2 (length result))
      (caar result)
      #f)))

(define (one-pair? cardinfo)
  (let ([result (find (^c
                        (= (cdr c) 2))
                      (cardinfo-numbers cardinfo))])
    (if result
      (car result)
      #f)))

(define (compare-cardinfo cardinfo1 cardinfo2)
  (let loop ([rest1 (cardinfo-numbers cardinfo1)]
             [rest2 (cardinfo-numbers cardinfo2)])
    (cond
      [(or (null? rest1)
           (null? rest2))
       (errorf "引き分け！~%")]
      [(= (caar rest1) (caar rest2))
       (loop (cdr rest1) (cdr rest2))]
      [(> (caar rest1) (caar rest2))
       'player-1]
      [else 'player-2])))

(define (winner cardinfo1 cardinfo2)
  (let loop ([procs `(,royal-flush? ,straight-flush? ,four-card?
                                    ,full-house? ,flush? ,straight?
                                    ,three-card? ,two-pair? ,one-pair?)])
    (if (null? procs)
      (compare-cardinfo cardinfo1 cardinfo2)
      (let ([result1 ((car procs) cardinfo1)]
            [result2 ((car procs) cardinfo2)])
        (cond
          [(and (not result1)
                (not result2))
           (loop (cdr procs))]
          [(and result1 result2)
           (if (> result1 result2)
             'player-1
             'player-2)]
          [(boolean result1) 'player-1]
          [else 'player-2])))))

(define each-games
  (let loop ([rest (analyze-list (read-to-list "poker.txt"))]
             [result '()])
    (if (< (length rest) 2)
      (reverse result)
      (loop (cddr rest)
            (cons `(,(car rest) ,(cadr rest))
                  result)))))

(define each-card-info
  (map (^[cards-cell]
         `( ,(cards->cardinfo (car cards-cell))
            ,(cards->cardinfo (cadr cards-cell))))
       each-games))

(define each-winner
  (map (^[cardinfo-cell]
         (winner (car cardinfo-cell)
                 (cadr cardinfo-cell)))
       each-card-info))

(define answer-54
  (length
    (filter (^s (eq? s 'player-1))
            each-winner)))

(format #t "54: ~d~%" answer-54)