Created
October 10, 2013 20:42
-
-
Save uehaj/6925338 to your computer and use it in GitHub Desktop.
第12回オフラインリアルタイムどう書くの問題「サイコロを転がす」をHaskellで解く ref: http://qiita.com/uehaj/items/5f46b012f13e1d3cee55
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
-- http://nabetani.sakura.ne.jp/hena/ord12rotdice/ | |
import Data.List | |
import Control.Monad.State | |
-- 1と2の向きで表わしたサイコロの方向の状態。NEは「1の目が北(N)、2の目が東(E)」を表わす。Uは上、Dは下を表わす。 | |
data DiceState = NE|ES|SW|WN|EN|SE|WS|NW|UN|ND|DS|SU|NU|DN|SD|US|UE|ED|DW|WU|EU|DE|WD|UW deriving (Show, Eq) | |
-- それぞれのサイコロの状態で上面の数字(目)を表わす連想リスト。 | |
deuce :: [(DiceState, Char)] | |
deuce = [(NE,'4'),(ES,'4'),(SW,'4'),(WN,'4'),(EN,'3'),(SE,'3'), | |
(WS,'3'),(NW,'3'),(UN,'1'),(ND,'5'),(DS,'6'),(SU,'2'), | |
(NU,'2'),(DN,'6'),(SD,'5'),(US,'1'),(UE,'1'),(ED,'5'), | |
(DW,'6'),(WU,'2'),(EU,'2'),(DE,'6'),(WD,'5'),(UW,'1')] | |
-- ころがし操作。'N':北へころがす, 'W':西へころがす, 'S':南へころがす, 'E':東へころがす | |
type Roll = Char | |
-- サイコロの状態における目(上を向いている面の数値)を返す | |
getDeuce :: DiceState -> Char | |
getDeuce state = let (Just n) = lookup state deuce in n | |
mkpair :: (t, t, t, t) -> [(t, t)] | |
mkpair (a,b,c,d) = [(a,b),(b,c),(c,d),(d,a)] | |
-- 東にころがす回転('E')におけるサイコロ状態の変化 | |
-- [(回転前の状態,回転後の状態), ...]の連想リスト | |
moveDataToEast :: [(DiceState, DiceState)] | |
moveDataToEast = concat [mkpair (UN,EN,DN,WN), | |
mkpair (ND,NW,NU,NE), | |
mkpair (DS,WS,US,ES), | |
mkpair (SU,SE,SD,SW), | |
mkpair (ED,DW,WU,UE), | |
mkpair (EU,DE,WD,UW)] | |
-- 北にころがす回転('N')におけるサイコロ状態の変化 | |
-- [(回転前の状態,回転後の状態), ...]の連想リスト | |
moveDataToNorth :: [(DiceState, DiceState)] | |
moveDataToNorth = concat [mkpair (UN,ND,DS,SU), | |
mkpair (EN,ED,ES,EU), | |
mkpair (DN,SD,US,NU), | |
mkpair (WN,WD,WS,WU), | |
mkpair (NW,DW,SW,UW), | |
mkpair (SE,UE,NE,DE)] | |
-- 指定した状態に対して、ころがし操作を与えたとき、次状態を得る | |
step :: Roll -> DiceState -> DiceState | |
step r direc = case r of | |
'N' -> moveN direc | |
'W' -> moveW direc | |
'S' -> moveS direc | |
'E' -> moveE direc | |
where | |
-- 北にころがしたときの次状態を返す | |
moveN :: DiceState -> DiceState | |
moveN s = let (Just d) = lookup s moveDataToNorth in d | |
-- 西にころがしたときの次状態を返す | |
moveW :: DiceState -> DiceState | |
moveW s = moveE $ moveE $ moveE s | |
-- 南にころがしたときの次状態を返す | |
moveS :: DiceState -> DiceState | |
moveS s = moveN $ moveN $ moveN s | |
-- 東にころがしたときの次状態を返す | |
moveE :: DiceState -> DiceState | |
moveE s = let (Just d) = lookup s moveDataToEast in d | |
-- ころがし操作を与えると次の状態モナドを返すモナディック関数 | |
-- 状態は、(サイコロ上面の数値(目)の履歴, サイコロの状態)というタプルで表現。 | |
stepSt :: Roll -> State (String, DiceState) () | |
stepSt ch = do | |
(xs, direc) <- get | |
let nextDirec = step ch direc | |
state $ const ((), (getDeuce nextDirec:xs, nextDirec)) | |
-- ころがし操作の列と、結果(目の履歴)の期待値を与え、一致しているかどうかを返す | |
test :: String -> String -> Bool | |
test opr expected = let (xs, _) = execState (mapM stepSt opr) (['1'], UN) | |
in (reverse xs == expected) | |
main :: IO () | |
main = do | |
print $ test "NNESWWS" "15635624" {-- 0 --} | |
print $ test "EEEE" "13641" {-- 1 --} | |
print $ test "WWWW" "14631" {-- 2 --} | |
print $ test "SSSS" "12651" {-- 3 --} | |
print $ test "NNNN" "15621" {-- 4 --} | |
print $ test "EENN" "13651" {-- 5 --} | |
print $ test "WWNN" "14651" {-- 6 --} | |
print $ test "SSNN" "12621" {-- 7 --} | |
print $ test "NENNN" "153641" {-- 8 --} | |
print $ test "NWNNN" "154631" {-- 9 --} | |
print $ test "SWWWSNEEEN" "12453635421" {-- 10 --} | |
print $ test "SENWSWSNSWE" "123123656545" {-- 11 --} | |
print $ test "SSSWNNNE" "126546315" {-- 12 --} | |
print $ test "SWNWSSSWWE" "12415423646" {-- 13 --} | |
print $ test "ENNWWS" "1354135" {-- 14 --} | |
print $ test "ESWNNW" "1321365" {-- 15 --} | |
print $ test "NWSSE" "154135" {-- 16 --} | |
print $ test "SWNWEWSEEN" "12415154135" {-- 17 --} | |
print $ test "EWNWEEEEWN" "13154532426" {-- 18 --} | |
print $ test "WNEWEWWWSNW" "145151562421" {-- 19 --} | |
print $ test "NNEE" "15631" {-- 20 --} | |
print $ test "EEEEWNWSW" "1364145642" {-- 21 --} | |
print $ test "SENNWWES" "123142321" {-- 22 --} | |
print $ test "SWWWSNSNESWW" "1245363635631" {-- 23 --} | |
print $ test "WESSENSE" "141263231" {-- 24 --} | |
print $ test "SWNSSESESSS" "124146231562" {-- 25 --} | |
print $ test "ENS" "1353" {-- 26 --} | |
print $ test "WNN" "1453" {-- 27 --} | |
print $ test "SSEENEEEN" "1263124536" {-- 28 --} | |
print $ test "NWSNNNW" "15414632" {-- 29 --} | |
print $ test "ESSSSSWW" "132453215" {-- 30 --} | |
print $ test "ESE" "1326" {-- 31 --} | |
print $ test "SNWNWWNSSSS" "121456232453" {-- 32 --} | |
print $ test "SWEESEN" "12423653" {-- 33 --} | |
print $ test "NEEWNSSWWW" "15323631562" {-- 34 --} | |
print $ test "WSEW" "14212" {-- 35 --} | |
print $ test "SWSNNNSNWE" "12464131353" {-- 36 --} | |
print $ test "ENWEWSEEW" "1351513545" {-- 37 --} | |
print $ test "WSEWN" "142124" {-- 38 --} | |
print $ test "EWNEESEWE" "1315321414" {-- 39 --} | |
print $ test "NESEEN" "1531263" {-- 40 --} | |
print $ test "WSW" "1426" {-- 41 --} | |
print $ test "ENEWE" "135656" {-- 42 --} | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment