Hacking

[pozorvlak]

I've decided that I should get to learn more about Haskell, because (from what totherme, michiexile and Duncan say) it sounds like it's got much cooler since I last touched it. So today I sat down to write a program to generate valid Siteswaps for juggling patterns. A siteswap is a list of throw heights: "5" means that you throw a ball sufficiently high that the next time it will be thrown is in five beats' time, and so on. So a Three-Ball Cascade is 3, Right Middle Left is 423, and so on. Wikipedia has more information. A candidate pattern is juggleable if you don't have two balls trying to land at the same time.

It took me about three hours and 53 lines, and a lot of that time was spent wrestling with the type system. Debug.Trace was invaluable, though a bit of a pain to use. Anyway, here's the code: do any of you clever Haskell types out there have any comments for how I could have done things better?

-- newtype SiteSwap = SS [Int] deriving (Show, Read, Eq, Ord)
-- this just turned out to be a hassle

collision :: [Int] -> Bool
collision xs = (length (filter (==0) xs)) >= 2

--isJuggleable :: SiteSwap -> Bool
isJuggleable [] = False
isJuggleable ss = isJuggleable' [] 0 (length ss) (cycle ss)

isJuggleable' :: [Int]->Int->Int->[Int]->Bool
isJuggleable' falling fallen maxfallen (s:ss)
        | collision $ map (\x->x-1) falling     = False
-- a pattern is not juggleable if two balls collide
        | fallen > maxfallen            = True
-- a pattern is juggleable if all the initial balls have landed safely
        | otherwise                     = isJuggleable' newfalling newfallen maxfallen ss
                where (newfalling, newfallen) = advance s falling fallen

advance :: Int->[Int]->Int->([Int], Int)
advance height falling fallen = (advanceFalling height falling,
                                 advanceFallen falling fallen)

advanceFalling :: Int->[Int]->[Int]
advanceFalling height falling = height:(filter (>0) (map (subtract 1) falling))
-- Has to be (>0) because of possibility of throwing 0s (ie Gaps)
-- This way, a throw of 0 gets turned to -1 by (subtract 1) and doesn't trigger `collision`.

advanceFallen falling fallen  =  fallen + (length (filter (==0) (map (subtract 1) falling)))

isRepetitive word = or $ map ((flip isRepeated) word) (tail $ reverse $ prefixes word)
-- Lop off the final prefix, which will be the whole word. Else test becomes degenerate

prefixes :: [a]->[[a]]
prefixes []     = []
prefixes (w:ws) = [w]:(map (w:) (prefixes ws))

-- is word a repetition of candidate?
isRepeated candidate word  = isRepeated' (cycle candidate) word
isRepeated' _ []                = True
isRepeated' (c:cs) (w:ws)       | c == w        = isRepeated cs ws
                                | otherwise     = False

finiteLists xs = concat $ map (finiteLists' xs) [0..]

finiteLists' xs 0 = [[]]
finiteLists' xs n = (concat $ outer (:) xs (finiteLists' xs (n-1)))

outer f [] _    = []
outer f (x:xs) ys = (map (f x) ys):(outer f xs ys)

juggleablePatterns = map (concatMap show) $
                        filter (\x -> ((isJuggleable x) && (not $ isRepetitive x))) (finiteLists [1..9])

Now, a quick take 10000 juggleablePatterns should keep me busy for the next several lifetimes...

Comments

[stronae.livejournal.com]

I'm tickled that you're using Haskell for this, but I agree that getting used to the type system is a major pain.