モノポリーの各マスに止まる確率を求める問題です。
純粋に計算で出るんじゃないかと思ったけど、だめっぽい。計算のしかたからしてわからない。どうしよう。どうしよう。
で、実際にやってみることにした。 シミュレーションです。
サイコロ振って、マス目を移動して、そこの指示に従う、ってのをたくさん繰り返して、それぞれのマスに止った数を数えて確率を計算します。
最終的に百万回で答を出してます。
ソースは長めですけど、パキパキとできあがって、たのしかったな。
ここのところ、見つけてきた公式にあてはめてっていうパターンが多かったのでさおさらかな。
そういえば、今回から1.4でやってます。mapvとかvecter系の関数はちょっと便利そう。まだ使ってないけど。
作って、とりあえず100回くらいまわしたら、1秒以下で出たので、いきなり百万回まわしてみました。
4秒でした。
※ 最初のソースは余計なデータとか、マクロじゃなくてもいいマクロとかあったので、修正しました。
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ;; Problem 84 : 2012/06/29 | |
| ;; : mod 07/02 | |
| ;; "Elapsed time: 3902.874398 msecs" | |
| ;; "Elapsed time: 3511.571815 msecs" | |
| ;; board def | |
| ;; | |
| ;; | |
| (def board | |
| [:GO :A :CC :A :T :R :B :CH :B :B | |
| :JAIL :C :U :C :C :R :D :CC :D :D | |
| :FP :E :CH :E :E :R :F :F :U :F | |
| :G2J :G :G :CC :G :R :CH :H :T :H]) | |
| (defn pos-type-of [n] | |
| (nth board n)) | |
| ;; | |
| ;; moves | |
| ;; | |
| (defn g2j [pos] 10) | |
| (defn a2g [pos] 0) | |
| (defn c1 [pos] 11) | |
| (defn e3 [pos] 24) | |
| (defn h2 [pos] 39) | |
| (defn r1 [pos] 5) | |
| (defn back3 [pos] | |
| (rem (+ pos 37) 40)) | |
| (defn next-x [tgt] | |
| (fn [pos] | |
| (rem (+ pos | |
| 1 | |
| (.indexOf (seq (drop (inc pos) (concat board board))) | |
| tgt)) | |
| 40))) | |
| (def nxr (next-x :R)) | |
| (def nxu (next-x :U)) | |
| ;; | |
| ;; card piles | |
| ;; | |
| (def cc-cards | |
| (concat [a2g g2j] (repeat 14 nil))) | |
| (def ch-cards | |
| (concat [a2g g2j c1 e3 h2 r1 nxr nxr nxu back3] (repeat 6 nil))) | |
| (defn new-pile [cards] | |
| (let [pile (shuffle cards) | |
| num (atom 0)] | |
| (fn [] | |
| (do (swap! num #(rem (inc %) (count cards))) | |
| (get pile @num))))) | |
| ;; | |
| ;; make move | |
| ;; | |
| (defn make-move [now advance draw-cc draw-ch] | |
| (let [new-pos (rem (+ now advance) 40) | |
| pos-type (pos-type-of new-pos)] | |
| (cond (= pos-type :CC) (if-let [f (draw-cc)] | |
| (f new-pos) | |
| new-pos) | |
| (= pos-type :CH) (if-let [f (draw-ch)] | |
| (f new-pos) | |
| new-pos) | |
| (= pos-type :G2J) (g2j new-pos) | |
| :else new-pos))) | |
| ;; | |
| ;; dice | |
| ;; | |
| (defn roll-two-dice [sides] | |
| (let [a (inc (rand-int sides)) | |
| b (inc (rand-int sides))] | |
| [(= a b) (+ a b)])) | |
| ;; | |
| ;; update stat | |
| ;; | |
| (defn update-stat [pos db] | |
| (do (swap! db #(assoc % pos (inc (get % pos 0))) ) | |
| pos)) | |
| ;; | |
| ;; main | |
| ;; | |
| (defn do-monopoly [times dice-sides] | |
| (let [cc-pile (new-pile cc-cards) | |
| ch-pile (new-pile ch-cards) | |
| resdb (atom {})] | |
| (loop [total-step 0 | |
| pos 0 | |
| double-count 0] | |
| (if (> total-step times) | |
| @resdb | |
| (let [[dbl dice] (roll-two-dice dice-sides) | |
| new-pos (-> (if (and dbl | |
| (= double-count 2)) | |
| (g2j pos) | |
| (make-move pos dice cc-pile ch-pile)) | |
| (update-stat resdb))] | |
| (recur (inc total-step) | |
| new-pos | |
| (if dbl | |
| (rem (inc double-count) 3) | |
| 0))))))) | |
| (defn pe84 [times dice] | |
| (take 3 | |
| (map first | |
| (sort-by second > | |
| (do-monopoly times dice))))) |
board
board-pos
ボードの40マスをベクターで表現したもの。 マスのIDから数字と取った名前だけ並べてます。g2j ..... back3 nxr nxu next-x
CCカードやCHカードの役割を表わす関数群です。現在のポジションを渡すと、そのカードを引いたときの結果のポジションを返す関数になっています。
next-x関数は前のバージョンではマクロでした。
★cc-cards ch-cards
Community Chest と Chance Cardのデータです。 データとして、ポジションを渡すと行き先が返る関数を持っています。
★new-pile
カードの束を渡すと、その束をシャッフルした新しいパイルを作って、そこから1枚ずつ引いてくる関数を返します。
※上の★の2つは関数型言語の特徴を生かしたつくりになってると思う。
※上の★の2つは関数型言語の特徴を生かしたつくりになってると思う。
make-move
現在のポジションとダイスの目をとって次のポジションを返します。
CCとCHに止ったときのために、パイルも2つ受け取ります。
roll-two-dice
さいころを2つ振って、ダブルかどうかと2つの目の合計を返します。
uptdate-stat
結果保存用のmapに結果を保存します。
mapは、キーがポジション、値が訪れた回数です。
do-monopoly
さいころを振る回数とさいころの面数と保存用mapを引数にとって、指定回数さいころを振っておとずれたマスの情報を更新します。
pe84
do-monopolyを呼んで、結果をソートして出力します。
0 コメント:
コメントを投稿