71 lines
1.7 KiB
Haskell
71 lines
1.7 KiB
Haskell
module Main where
|
|
|
|
import Control.Monad
|
|
import Data.Monoid
|
|
import Data.List
|
|
|
|
{-
|
|
0 1 2
|
|
3 4
|
|
5 6 7
|
|
-}
|
|
|
|
zeroPile = replicate 8 0
|
|
addPiles = zipWith (+)
|
|
scalePile v = map (v*)
|
|
indices = [0..7]
|
|
valid = all (<4)
|
|
|
|
topple ls = foldr addPiles zeroPile . map (\(i, v) -> scalePile v (neighbours i)) . zip indices $ ls
|
|
|
|
step ls = let (rems, divs) = unzip . map (\v -> (v `rem` 4, v `div` 4)) $ ls in addPiles rems (topple divs)
|
|
|
|
steps ls = head . dropWhile (not . valid) . iterate step $ ls
|
|
|
|
-- 0 1 2 3 4 5 6 7
|
|
neighbours 0 = [0,1,1,1,0,1,0,0]
|
|
neighbours 1 = [1,0,1,0,0,0,1,0]
|
|
neighbours 2 = [1,1,0,0,1,0,0,1]
|
|
neighbours 3 = [1,0,0,0,1,1,0,0]
|
|
neighbours 4 = [0,0,1,1,0,0,0,1]
|
|
neighbours 5 = [1,0,0,1,0,0,1,1]
|
|
neighbours 6 = [0,1,0,0,0,1,0,1]
|
|
neighbours 7 = [0,0,1,0,1,1,1,0]
|
|
neighbours _ = []
|
|
|
|
newtype Sandpile = Sandpile [Int]
|
|
deriving (Eq, Ord)
|
|
|
|
instance Monoid Sandpile where
|
|
mempty = Sandpile $ zeroPile
|
|
mappend (Sandpile l1) (Sandpile l2) = Sandpile $ steps (addPiles l1 l2)
|
|
|
|
instance Show Sandpile where
|
|
show (Sandpile ls) = show ls
|
|
|
|
zero2 = Sandpile [2,3,2,3,3,2,3,2]
|
|
|
|
isClosed s = s <> zero2 == s
|
|
|
|
bigGuy = Sandpile [3,3,3,3,3,3,3,3]
|
|
|
|
inverseOf333 = bigGuy
|
|
|
|
inverse (Sandpile l) = Sandpile diff <> inverseOf333
|
|
where diff = zipWith (-) (replicate 8 3) l
|
|
|
|
-- most elements have order 224, then a lot 112.
|
|
-- Some are a power of two (such as 32)
|
|
order s = go s (s <> s) 1
|
|
where go s acc n = if s == acc
|
|
then n
|
|
else go s (s <> acc) (n+1)
|
|
|
|
|
|
main = do
|
|
--let piles = filter isClosed [Sandpile ls | ls <- replicateM 8 [0..3]]
|
|
let piles = filter isClosed $ Sandpile <$> replicateM 8 [0..3]
|
|
let orders = map head . group . sort . map order $ piles
|
|
print $ length piles
|
|
print orders
|
|
|