do it with fun: kill next puzzle

I just stumbled upon a blog-post where Mittal Patel solved this little puzzle using PHP:

100 people standing in a circle in an order 1 to 100. No. 1 has a sword. He kills next person (i.e. no. 2) and gives sword to next to next (i.e no. 3). All person does the same until only 1 survives. Which number survives at the last?

I liked the idea of using a quick program to find the solution for you – but I think the imperative solution really is quite too long here.

To make it short, this is the version I came up using Haskell:

solution :: Int
solution = head . kill $ [1..100]

kill :: [a] -> [a]
kill (p:_:ps) = kill (ps ++ [p])
kill ps = ps

or if you like the same using F#:

let rec kill = 
    function 
    | (p::_::ps) -> kill (ps @ [p])
    | ps         -> ps

let solution = 
    kill [1..100]
    |> List.head

Recursion for the win

By the way this falls into a common pattern, where you repeat a function to some data till the data does not change anymore:

solution :: Int
solution = head. fixP step $ [1..100]

step :: [a] -> [a]
step (p:_:ps) = ps ++ [p]
step ps = ps

fixP :: Eq a => (a -> a) -> a -> a
fixP f x =
  let x' = f x
  in if x == x' then x else fixP f x'

Which is nice because it let us find a better performing solution (try kill [1..100000] and get a coffee):

First let’s rewrite step – instead of just removing the second person and putting the first at the end,step now should process the complete list once but without using the slow concatenation.

If you think about it there are two options: either the last person with the sword finds a next person in the list or not. If he finds one you can just remove the victim too, if not the last swordsman have to be get in front of the new list (to get a victim).

It’s not instant obvious but you can do this using an accumulator and a final reverse:

step :: [a] -> [a]
step = step' []
  where
    step' acc (p:_:ps) = step' (p:acc) ps
    step' acc [p]      = p : reverse acc
    step' acc []       = reverse acc

And now you can reuse fixP to get a much quicker response:

λ> fixP step [1..100000]
[68929]

That lucky bastard …

note

The problem is known as Josephus problem and there is a mathematical solution for it (see the wiki).