Spiral/spiral.hs
2019-07-23 12:31:43 +12:00

59 lines
1.4 KiB
Haskell

import System.IO
data Incarnation = S Bool Bool Int (Int,Int) Int Int
seed :: Int -> Int
seed n = 1 + (h * (n+1))
where h = (div n 2)
lineage :: Int -> [Int]
lineage n = take (n*n) $ futures (atom n)
atom :: Int -> Incarnation
atom n = S False True 1 (1,0) (seed n) n
xor :: Bool -> Bool -> Bool
xor a b = (a || b) && (not (a && b))
futures :: Incarnation -> [Int]
futures self@(S _ _ _ _ l _) =
(l:(futures (evolve self)))
divine :: Incarnation -> Int
divine (S v s _ _ l n) = l `sign` val
where
sign = if s then (+) else (-)
val = if v then n else 1
evolve :: Incarnation -> Incarnation
evolve i@(S v s cd (so,sn) _ b)
| cd > 1 = (S v s (cd-1) (so,sn) (divine i) b)
| otherwise =
(S (not v) (s `xor` v) (cs ns) ns (divine i) b)
where
ns = (intuit v (so,sn))
cs = (if v then fst else snd)
intuit :: Bool -> (Int,Int) -> (Int,Int)
intuit True (a,b) = ((a+1),b)
intuit _ (a,b) = (a,(b+1))
-- blurgh io
-- bloating the program making me import stuff >:(
main :: IO ()
main = do
putStr "destinies to observe: "
hFlush stdout
args <- getLine
mapM_ putStrLn
$ map (\n -> ("n=" ++ (show n) ++ " ~ ")
++ (if (aura n)
then (show (lineage (read n)))
else "[ soul contains invalid aura ]"))
(words args)
aura :: String -> Bool
aura s = foldr (&&) True
(map (`elem` ['0'..'9']) s)