1日1個 @nabetani さんの作った問題を解くAdventCalendarの24日目です。我が家のクリスマスケーキはこんな感じだそうです。

今日の問題は http://nabetani.sakura.ne.jp/hena/ord12rotdice/ にあります。

module Doukaku.Dice (solve) where
import Data.Char (intToDigit, digitToInt)

solve :: String -> String
solve = map head . scanl (flip roll) "153"

roll :: Char -> String -> String
roll 'E' (x:y:z:_) = z:y:(rev x):[]
roll 'W' ds = let e = roll 'E' in e . e . e $ ds
roll 'S' ds = let n = roll 'N' in n . n . n $ ds
roll 'N' (x:y:z:_) = y:(rev x):z:[]

rev :: Char -> Char
rev = intToDigit . (7 -) . digitToInt

二方向分の回転演算さえ作れば、後はその組み合わせで表現できます。ところで、自分はrollのように戻り値がendmorphismになる関数を書く癖があるのですが、
こいつはfoldlやらscanlと相性が悪くいつもflipする羽目になります。foldの「l」系の関数は使うなってことでしょうか。

http://nabetani.sakura.ne.jp/hena/ord12rotdice/ に他の方の回答もありますので、見ると参考になるでしょう。それではみなさん、よいクリスマスをお迎えください。