山折り谷折り〜 横へな 2014.2.1 参考問題

( 元ネタは http://nabetani.sakura.ne.jp/hena/ord18mafovafo/ )
( 他の解答例は http://qiita.com/Nabetani/items/373105e7fafd12f5e9fd )

最初にMFVF.hsを書き始めて出力が正しいかどうかの確認が終わるまででちょうど20分。
うーん。これはちょっと簡単すぎないかな……
前回の「折って切る」を更に簡単にしたものになってるような……

型シグニチャを書きながらそれを手がかりに考えつつ本体を書いていくのが好きなので、「折り目」のデータ型をきちんと定義せずにCharやらで暗黙に代用するのは好きではないのだが、簡単に書きたければこんな感じか（紙の状態をStringで表現するので出力整形とか気にしないでいいのが利点なのかなあ）：

MFVFbis.hs

module Main where

turn = map inv . reverse
  where inv 'm' = 'V'; inv 'V' = 'm'

unFold f p = let q = turn p in case f of 
  'L' -> q ++ "V" ++ p
  'J' -> p ++ "V" ++ q
  'Z' -> p ++ "m" ++ q ++ "V" ++ p
  'S' -> p ++ "V" ++ q ++ "m" ++ p
  'U' -> q ++ "V" ++ p ++ "V" ++ q

develop = foldr unFold ""

main = do
  s <- getContents
  mapM_ (putStrLn . develop) (lines s)

みたまんま、標準入力から食わせれば標準出力に吐きます。

ちなみに以下のものが頭から考えながら20分程度でそのまま書き下ろした当初のヴァージョン。情弱らしくアラだらけだが、まあ情弱なのでこんなものだろう。

MFVF.hs

module Main where
import Data.List
import System.Environment (getArgs)

data Folding = MF | VF 
instance Show Folding where
  show f = case f of
    MF -> "m"
    VF -> "V"

type Paper = [Folding]

turn :: Paper -> Paper
turn p = map inv $ reverse p
  where inv MF = VF
        inv VF = MF

unfolding :: Paper -> Char -> Paper 
unfolding p ch = case ch of 
  'L' -> turn p ++ [VF] ++ p
  'J' -> p ++ [VF] ++ turn p
  'Z' -> p ++ [MF] ++ turn p ++ [VF] ++ p
  'U' -> turn p ++ [VF] ++ p ++ [VF] ++ turn p
  'S' -> p ++ [VF] ++ turn p ++ [MF] ++ p

develop :: String -> Paper
develop s = foldl' (unfolding) [] (reverse s)

pprint :: Paper -> String
pprint = concat . map show

main = do
  input <- getArgs
  let s = input !! 0
  putStrLn $ pprint $ develop s

おまけ （Data.Sequence版）

MFVFTer.hs

module Main where

import Prelude hiding (reverse)
import Data.Foldable (toList)
import Data.Sequence

turn = fmap inv . reverse
  where inv 'm' = 'V'
        inv 'V' = 'm'


unFold f p = let q = turn p in case f of
  'L' -> q >< singleton 'V' >< p
  'J' -> p >< singleton 'V' >< q
  'Z' -> p >< singleton 'm' >< q >< singleton 'V' >< p
  'S' -> p >< singleton 'V' >< q >< singleton 'm' >< p
  'U' -> q >< singleton 'V' >< p >< singleton 'V' >< q

develop = foldr unFold empty

main = do
  s <- getContents
  mapM_ (putStrLn . toList . develop) (lines s)