Skip to content

Instantly share code, notes, and snippets.

@lotz84
Created Dec 16, 2018
Embed
What would you like to do?
アルゴリズムこうしん
{-# LANGUAGE RecursiveDo #-}
module Main where
import Control.Monad.Cont
import Control.Monad.State
import Data.IORef
import Data.List
data Action = Empty
| Maenarae
| Eraihito
| Pekorinko
| Kyorokyoro
| Hiraoyogi
| Kurihiroi
| Shushu
| Pyupyu
| Owarikana
| Owari
deriving (Show, Eq, Ord, Enum)
say :: Action -> String
say Empty = ""
say Maenarae = "1歩進んで前習え"
say Eraihito = "1歩進んで偉い人"
say Pekorinko = "ひっくりかえってぺこりんこ"
say Kyorokyoro = "横に歩いてきょろきょろ"
say Hiraoyogi = "ちょっとここらでひらおよぎ"
say Kurihiroi = "ちょっとしゃがんで栗拾い"
say Shushu = "空気入れますしゅうしゅう"
say Pyupyu = "空気がはいってぴゅうぴゅう"
say Owarikana = "そろそろ、終わりかな"
say Owari = "おわり"
actions :: Int -> Int -> [Action]
actions n i = concat $ [ replicate i Empty
, [ Maenarae
, Eraihito
, Pekorinko
, Kyorokyoro
, Hiraoyogi
, Kurihiroi
, Shushu
, Pyupyu
]
, replicate (n-i) Owarikana
, [Owari]
]
type LastAction = Action -- 過去の自分の行動
type PrevAction = Action -- 前の人の行動
type NextAction = Action -- 後ろの人の行動
actor :: IORef LastAction -> ContT NextAction (StateT PrevAction IO) ()
actor actRef = do
lastAct <- liftIO $ readIORef actRef -- 自分が取った前の行動を取得
prevAct <- lift get -- 前の人の行動を取得
let myAct = case (lastAct, prevAct) of
(Empty, Eraihito) -> Maenarae -- 前の人が偉い人をしたら"前ならえ"
(Empty, _ ) -> Empty -- そうじゃなければ無言で進み続ける
(Owarikana, _ ) -> Owarikana -- "終わりかな"は一旦繰り返す
_ -> succ lastAct -- それ以外の場合は次の行動を取る
lift $ put myAct -- 自分の行動を次の人に伝える
ContT $ \k -> do
nextAct <- k myAct -- 継続を使って後ろの人の行動を知る
let myAct' = case (lastAct, nextAct) of
(Owarikana, Owari) -> Owari -- "終わりかな"の時は後ろの人が"おわり"なら自分も終わる
_ -> myAct -- それ以外の場合は行動を変えない
liftIO $ writeIORef actRef myAct' -- 自分の状態を更新する
pure myAct' -- 自分の行動を前の人に伝える
pure ()
main :: IO ()
main = do
-- actRef1 <- newIORef Empty
-- actRef2 <- newIORef Empty
-- fix $ \loop -> do
-- (flip runStateT Eraihito) . (flip runContT (const $ pure Owari)) $ do
-- actor actRef1 -- 一人目
-- actor actRef2 -- 二人目
-- actions <- mapM readIORef [actRef1, actRef2]
-- putStrLn $ intercalate " / " $ map say actions
-- if all (== Owari) actions
-- then pure () -- 全員が"おわり"なら終了する
-- else loop -- そうでなければ繰り返す
let n = 3
actRefs <- sequence . replicate n $ newIORef Empty
fix $ \loop -> do
(flip runStateT Eraihito) .
(flip runContT (const $ pure Owari)) .
sequence $ map actor actRefs
actions <- mapM readIORef actRefs
putStrLn $ intercalate " / " $ map say actions
if all (== Owari) actions
then pure () -- 全員が"おわり"なら終了する
else loop -- そうでなければ繰り返す
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment