Solomon Problem.hs

import Data.List (intercalate)

-- takes n from the start of a list and puts them at the end
wrap :: Int -> [a] -> [a]
wrap 0 xs = xs
wrap _ [] = []
wrap n (x:xs)
    | n > 0     = wrap (n-1) (xs ++ [x])
    | otherwise = undefined -- cannot move backward through the list

-- Index the list (from 1) and remove all falses
preprocess :: [Bool] -> [Int]
preprocess bs = map fst . filter snd . index 1 $ bs

-- Index the list starting at `n`
index :: Int -> [a] -> [(Int, a)]
index n xs = zip [n..] $ xs

-- returns the list with the first element dropped, and then shifted forward by `skip` elements
step :: Int -> [a] -> [a]
step skip xs = wrap skip . tail $ xs

-- returns the list of successive steps, ending in a list of one element
run :: Int -> [a] -> [[a]]
run skip xs = takeWhile (not . null) . iterate (step skip) $ xs

-- returns the sole element of the last state of `run` on the provided list
catch :: Int -> [a] -> a
catch skip xs = get . last . run skip $ xs
    where get [x] = x -- fail if the list isn't a singleton

-- returns the index of the last remaining element after running on a preprocessed bool list
solve :: Int -> [Bool] -> Int
solve skip bs = catch skip . preprocess $ bs

-- get the initial data (a list of k boolean values, each True)
initial :: Int -> [Bool]
initial k = replicate k $ True

-- Show the steps while working to the solution
-- from an array of `k` trues, skipping `skip` each step
-- truncating the output bc that gets large
showWorkingTruncated :: Int -> Int -> Int -> IO ()
showWorkingTruncated k skip len = mapM_ putStrLn $ truncated
    where
        truncated :: [String]
        truncated = truncate <$> shown
        shown :: [[String]]
        shown = map show <$> working
        working :: [[Int]]
        working = run skip . preprocess . initial $ k
        truncate :: [String] -> String
        truncate ss
            | length ss <= len = ('[':) . (++     "]") . intercalate ","             $ ss
            | otherwise         = ('[':) . (++ ",...]") . intercalate "," . take len $ ss

-- Show the steps while working to the solution
-- from an array of `k` trues, skipping `skip` each step
showWorking :: Int -> Int -> IO ()
showWorking k skip = mapM_ putStrLn $ show <$> working
    where working = run skip . preprocess . initial $ k

-- Show the solution
-- from an array of `k` trues, skipping `skip` each step
showSolution :: Int -> Int -> IO ()
showSolution k skip = putStrLn . show . solve skip . initial $ k

main =
--        showWorking 10 7
--        showWorkingTruncated 1000 7 10
        showSolution 1000 7 -- array size 1000, step size 7

This program attempts to solve the following (rather unrealistic) problem:
Suppose you have a row of 1000 snacks, numbered 1 to 1000, and you decide to eat them in a novel way. You eat the first (number 1), then skip 7 and eat the 9th (number 9). You continue in this manner, skipping 7 remaining snacks and eating one. When you reach the end of the line of snacks, you return to the start, still keeping count of how many you've skipped. You continue in this way until only a single snack remains. What is the number of this snack?