第五回オフラインリアルタイムどう書くの回答例(Arc)

本番は、問題が難しくなったため、焦って混乱して結局解けなかった。
まだまだ精進が足りないと思った。
一部複雑なところがあるが、落ち着いてやれば普通に解ける。
問題は以下
http://nabetani.sakura.ne.jp/hena/ord5dahimi/

ord5dahimi.arc

(def filter (f lis) (mappend [if (f _) (list _)] lis))
(def cardify (str) (map string (pair (coerce str 'cons))))
(def level (c) (pos (c 1) "3456789TJQKA2"))
(def levcomp (f a b)
  (and (no (is a "Jo")) (or (is b "Jo") (f (level a) (level b)))))

(def find-same-levels (lev-cord mine n)
  (let result '()
    ((afn (lev-cord mine n acc)
       (if (is n 0)
           (push acc result)
           (let founds (filter [levcomp is lev-cord _] mine)
             (each found founds
               (self lev-cord (rem found mine) (- n 1) (cons found acc))))))
     lev-cord mine n '())
    result))

(def find-pair (lev-cord n mine)
  (mappend
    (fn (target)
      (if (levcomp < lev-cord target)
          (map [cons target _]
                (find-same-levels
                  target (rem target mine)
                  (- n 1)))))
    mine))

(def solve (str)
  (let tok (map cardify (tokens str #\,))
    (with (p (car tok)
           m (cadr tok))
      (aif (aand (find [level _] p)
                 (dedup (map [apply + (sort > _)] (find-pair it (len p) m)))
                 (string (intersperse "," it)))
           it "-"))))

以上が算出のコード
難しかったのはfind-same-levelsの中で、
木構造再帰の結果をどのように平らなリストにストアして返すかが思い浮かばなかった。
結局、単純に見つかった時点でプリントするのと同じく、外部変数の配列に格納する事にした。

realtime_doukaku_5_result.arc

(def same-card-pair? (p1 p2)
  (is (apply + (sort > p1)) (apply + (sort > p2))))
(def check-equality (expected result)
  (or (and (is expected "-") (is expected result))
      (let expected-card-pairs (map cardify (tokens expected #\,))
        (no (rem (fn (res) (find (fn (exp) (same-card-pair? res exp))
                                 expected-card-pairs))
                 (map cardify (tokens result #\,)))))))
(def test (f arg expected)
  (check-equality expected (f arg)))

(and
  (test solve "DJ," "-")
  (test solve "H7,HK" "HK")
  (test solve "S3,D4D2" "D4,D2")
  (test solve "S9,C8H4" "-")
  (test solve "S6,S7STCK" "CK,ST,S7")
  (test solve "H4,SAS8CKH6S4" "S8,CK,H6,SA")
  (test solve "ST,D6S8JoC7HQHAC2CK" "Jo,C2,CK,HA,HQ")
  (test solve "SA,HAD6S8S6D3C4H2C5D4CKHQS7D5" "H2")
  (test solve "S2,D8C9D6HQS7H4C6DTS5S6C7HAD4SQ" "-")
  (test solve "Jo,HAC8DJSJDTH2" "-")
  (test solve "S4Jo,CQS6C9DQH9S2D6S3" "DQCQ,D6S6,H9C9")
  (test solve "CTDT,S9C2D9D3JoC6DASJS4" "JoC2,SJJo,DAJo")
  (test solve "H3D3,DQS2D6H9HAHTD7S6S7Jo" "JoHA,JoD6,JoH9,D6S6,D7S7,JoS6,HTJo,JoDQ,S2Jo,JoD7,JoS7")
  (test solve "D5Jo,CQDAH8C6C9DQH7S2SJCKH5" "CQDQ")
  (test solve "C7H7,S7CTH8D5HACQS8JoD6SJS5H4" "HAJo,JoSJ,H8S8,H8Jo,CQJo,CTJo,JoS8")
  (test solve "SAHA,S7SKCTS3H9DJHJH7S5H2DKDQS4" "-")
  (test solve "JoC8,H6D7C5S9CQH9STDTCAD9S5DAS2CT" "CTDT,H9D9,S9D9,DACA,CTST,H9S9,DTST")
  (test solve "HTST,SJHJDJCJJoS3D2" "DJCJ,SJDJ,JoHJ,CJHJ,SJJo,HJSJ,DJJo,JoCJ,JoD2,SJCJ,DJHJ")
  (test solve "C7D7,S8D8JoCTDTD4CJ" "D8S8,JoS8,CTJo,DTJo,JoCJ,CTDT,D8Jo")
  (test solve "DJSJ,DTDKDQHQJoC2" "JoDK,HQDQ,DQJo,C2Jo,JoHQ")
  (test solve "C3H3D3,CKH2DTD5H6S4CJS5C6H5S9CA" "S5H5D5")
  (test solve "D8H8S8,CQHJCJJoHQ" "JoCQHQ,JoHJCJ")
  (test solve "H6D6S6,H8S8D8C8JoD2H2" "D2H2Jo,D8JoS8,D8S8C8,C8D8H8,JoC8S8,H8JoC8,S8H8C8,JoS8H8,C8JoD8,D8H8S8,D8JoH8")
  (test solve "JoD4H4,D3H3S3C3CADASAD2" "DACASA")
  (test solve "DJHJSJ,SQDQJoHQCQC2CA" "SQJoCQ,DQCQJo,JoSQHQ,SQCQHQ,DQHQSQ,HQDQCQ,HQDQJo,SQDQCQ,CQJoHQ,SQJoDQ")
  (test solve "H3D3Jo,D4SKH6CTS8SAS2CQH4HAC5DADKD9" "HASADA")
  (test solve "C3JoH3D3,S2S3H7HQCACTC2CKC6S7H5C7" "-")
  (test solve "H5C5S5D5,C7S6D6C3H7HAH6H4C6HQC9" "C6D6S6H6")
  (test solve "H7S7C7D7,S5SAH5HAD5DAC5CA" "SADACAHA")
  (test solve "D4H4S4C4,S6SAH6HAD6DAC6CAJo" "C6H6S6D6,SAJoDACA,S6H6C6Jo,SACAJoHA,HADASAJo,HADAJoCA,CADAHASA,D6C6JoH6,S6D6C6Jo,H6JoS6D6")
  (test solve "DTCTSTHT,S3SQH3HQD3DQC3CQJo" "HQSQJoDQ,SQCQDQJo,DQCQHQJo,SQHQJoCQ,CQDQHQSQ")
  (test solve "JoS8D8H8,S9DTH9CTD9STC9CAC2" "H9C9D9S9")
  "PASSED ALL TESTS")

;; -> "PASSED ALL TESTS"

以上がテストコード
全部うまく行ったようだ。