repeat :: a -> [a]
repeat x = let xs = x:xs
in xs
In the above function, the result is named 'xs', which is again used inside the recursive let. Hence there is a circular loop, where the result in one stage of the evaluation gets fed back into the input. This is the principle of circular programming, and is best used in lazily evaluated languages. Languages that employ strict evaluation semantics will fail to evaluate the above.
Consider an alternative definition of repeat ..
repeat x = x : repeat x
Haskell implements the above function also as a thunk and evaluates *incrementally* and *on demand*. But the evaluation proceeds differently from the earlier version, in the sense that the latter version keeps on consuming memory and appending elements during evaluation. The earlier version is smart enough and traverses the circular structure only.
In Haskell, this technique is also referred to as "tying the knot", and is an effective substitute for mutable references. This technique has been used quite effectively in optimizing traversals on recursive structures - algorithms that usually need multiple traversals in a strict evaluation language can be tackled using a single traversal. But that is the subject of another post, some other day ..
Over the weekend I came across this puzzle, better known as the Josephus Flavius game ..
"Josephus Flavius was a famous Jewish historian of the first century at the time of the Second Temple destruction. During the Jewish-Roman war he got trapped in a cave with a group of 40 soldiers surrounded by romans. The legend has it that preferring suicide to capture, the Jews decided to form a circle and, proceeding around it, to kill every third remaining person until no one was left. Josephus, not keen to die, quickly found the safe spot in the circle and thus stayed alive."
I dug into the problem and tried to find a solution in Haskell. It ended up a cool application of circular programming ..
josephus init nth =
-- alive will have the sequence of victims in the last part
let l = alive
(v, s) = splitAt (length alive - length init) alive
in (s, last v)
where
-- circular: alive gets fed back
alive = init ++ victim (length init) alive []
-- find victims and aggregate sequence
victim 0 line seq = seq
victim n line seq =
let (f, s) = splitAt (nth-1) line
in f ++ (victim (n-1) (tail s) (seq ++ [head s]))
The program returns the last survivor as well as the entire elimination order of the victims. For the Josephus problem, the solution is ..
*Main> josephus [1..40] 3
([3,6,9,12,15,18,21,24,27,30,33,36,39,2,7,11,16,20,25,29,34,38,4,10,17,23,31,37,5,14,26,35,8,22,40,19,1,32,13,28],28)
The first element of the tuple is the sequence in which the victims get eliminated, while the last element (28) is the last survivor. Felt good for a Haskell newbie ..
3 comments:
I would be inclined to keep the list of the dead separate from the list of the living to ensure that they don't get mixed up:
josephus init nth = (dead, last dead)
where
-- circular: alive gets fed back
(alive,dead) = victim (length init) (init++alive)
-- find victims and aggregate sequence
victim 0 _ = ([],[])
victim n alive =
let (f, ~(target:s)) = splitAt (nth-1) alive
(alive',dead') = victim (n-1) s
in (f ++ alive',(target:dead'))
My solution:
josephus :: Int -> Int -> ([Int], Int)
josephus groupSize nth = (order, last order)
where order = josephusOrdering [1..groupSize] nth
josephusOrdering :: [Int] -> Int -> [Int]
josephusOrdering [] _ = []
josephusOrdering xs n = victim : josephusOrdering survivors n
where (victim, survivors) = next xs n
next :: [Int] -> Int -> (Int, [Int])
next (x:xs) 1 = (x, xs)
next (x:xs) n = next (xs ++ [x]) (n - 1)
Some interesting variations on Haskell reddit .. http://www.reddit.com/r/haskell/comments/7w04j/learning_haskell_solving_the_josephus_flavius_game/
Post a Comment