Problem A in the qualifying round of this year’s Google CodeJam contest was really clever. The problem used a classic made-for-TV gadget from the 80s: The Clapper™ (“snapper” in google’s version) and went like this:

The Snapper is a clever little device that, on one side, plugs its input plug into an output socket, and, on the other side, exposes an output socket for plugging in a light or other device.

When a Snapper is in the ON state and is receiving power from its input plug, then the device connected to its output socket is receiving power as well. When you snap your fingers — making a clicking sound — any Snapper receiving power at the time of the snap toggles between the ON and OFF states.

In hopes of destroying the universe by means of a singularity, I have purchased N Snapper devices and chained them together by plugging the first one into a power socket, the second one into the first one, and so on. The light is plugged into the Nth Snapper.

Initially, all the Snappers are in the OFF state, so only the first one is receiving power from the socket, and the light is off. I snap my fingers once, which toggles the first Snapper into the ON state and gives power to the second one. I snap my fingers again, which toggles both Snappers and then promptly cuts power off from the second one, leaving it in the ON state, but with no power. I snap my fingers the third time, which toggles the first Snapper again and gives power to the second one. Now both Snappers are in the ON state, and if my light is plugged into the second Snapper it will be on.

I keep doing this for hours. Will the light be on or off after I have snapped my fingers K times? The light is on if and only if it’s receiving power from the Snapper it’s plugged into.

It’s a great problem because we have a situation that is easily modeled with a computer program, and yet a naive solution will be far too inefficient to process the inputs that google provides (e.g. 10^8 claps).

Here is a direct-to-code translation of the functioning of a “chain of snappers” implemented in (very verbose) Haskell:

We can then look at a few iterations (snaps) and see how the chain changes. True is a “snapper” in the ON state:

*Main> take 4 $ iterate clapOnOff [False,False,False]
[[False,False,False],[False,False,True],[False,True,False],[False,True,True]]

A Solution

After working out a few iterations on paper I realized that the snappers follow the pattern of an ascending binary number count: 000, 001, 010, 011...

The lamp will be on when all of the snappers are 1s (i.e. in the ON state) which will occur every (2^number_of_snappers) snaps. Thus my solution was simply the following:

caseAlgorithm (n,k) = 
    if (((k+1) `mod` 2^n) == 0)
       then ON
       else OFF

More Code and Thoughts

Here is a more terse and better version of the Snapper simulation code I posted above, now simply called increment for incrementing a binary number:

We can convert our lists into pretty strings with…

And play with it like so:

*Main> map showBinary $ take 9 $ iterate increment  [False,False,False]
["000","001","010","011","100","101","110","111","000"]

I liked realizing that a binary count could be represented recursively and mechanically. It led me to look into how binary counter circuits are implemented in electronics (it turns out The Clapper™ is not generally involved), and got me thinking about cellular automata.

A binary counter could be implemented as Cellular Automata in which each bit is an Automaton with two states: an ON/OFF state and a POWERED/UNPOWERED state.

…although I think POWERED or UNPOWERED would have to be evaluated lazily, which might not fit the model.

Oh well, good luck to everyone doing the competition this year!

To adapt the module to a problem, one defines the following:

1. a type Case into which we will parse a test case (i.e. problem)
2. a type SolvedCase, representing a solution to a test case
3. our algorithm :: Case -> SolvedCase
4. a Parser caseParser which can parse a single test case (n.b. not the whole file) into the Case type
5. a function formatCase :: SolvedCase -> String which brings the solution to the state where it can be prepended with the standard “Case #1: ” string

Here is the module, filled in to solve the Minimum Scalar Product practice problem. You can download the code here:

module Main
    where

import Text.ParserCombinators.Parsec
import IO hiding (try)
import System.Environment

-- PROBLEM-SPECIFIC IMPORTS --
import Data.List (sort)
import Control.Arrow
------------------------------


-- the input file will be parsed into a list of some type representing
-- individual cases to be solved by our algorithm:
type Input = [Case] 

-- our algorithms will produce a list of some type SolutionCase:
type Solution = [SolvedCase] 

-- we convert each solved case into a String, which is zipped with
--  the standard "Case #x: " strings for the final output
type Output = [String]





-- --------------- BEGIN EDITING --------------- --



-- DEFINE A TYPE TO REPRESENT A SINGLE UNSOLVED TEST CASE: --
type Case =
    -- EXAMPLE: a pair of lists of Ints (our "vectors"):
    ([Int],[Int])


-- DEFINE A TYPE TO REPRESENT A SINGLE SOLVED TEST CASE: --
type SolvedCase = 
    -- EXAMPLE: our Minimum Scalar Product as an Int:
    Int


     -- -- -- ALGORITHMS -- -- --


-- SOLVE A TEST CASE HERE:
algorithm :: Case -> SolvedCase
algorithm = 
    -- EXAMPLE: simply sort both lists, reverse one, and combine:
    sum . uncurry (zipWith (*)) . (reverse . sort *** sort)



    -- -- -- PARSING INPUT -- -- --


-- DEFINE PARSER FOR A TEST CASE: --
caseParser :: Parser Case
caseParser = do
     -- EXAMPLE: parses a case consisting of 3 lines: the first describes the
     --  number n of elements in the following two lines, the next two lines
     -- have n space-separated elements:
    w <- word
    let n = read w
    as <- count n word
    bs <- count n word
    return  (map read as, map read bs)



     -- -- -- FORMAT OUTPUT -- -- --


-- DEFINE A FUNCTION FROM AN INDIVIDUAL SolvedCase -> String.
formatCase :: SolvedCase -> String
formatCase sol = 
    -- EXAMPLE: nothing to speak of here:
    show sol
    
  

-- --------------- STOP EDITING --------------- --



    --------------------
    -- IO BOILERPLATE --
    --------------------


main = do
    
     -- pass the input file name to our program:
    (f:_) <- getArgs
    file  <- readFile f

     -- start parsing, solve problem, and prepare output:
    let inp  = parseWith mainParser file
        solution        = map algorithm inp
        solutionStrings = map formatCase solution
        outp = zipWith (++) prefixes solutionStrings
    
     -- write the prepared output to screen:
    putStr $ unlines outp


-- dies with error, or returns some datatype with our parsed data:
parseWith p = either (error . show) id . parse p "" 

-- to begin parsing, we read in a line containing the number of test cases
-- to follow. We parse them with caseParser, returning a list:
mainParser :: Parser Input
mainParser = do
    n  <- word
    ms <- count (read n) caseParser 
    return ms
    <?> "mainParser"

-- strings to prepend to output:
prefixes = [ "Case #" ++ show n ++ ": " | n <- [1..]]





    ---------------------
    -- VARIOUS PARSERS --
    ---------------------


-- -- LINE PARSERS -- --


-- a single line String, up to the newline:
wholeLine :: Parser String
wholeLine = manyTill anyChar (try newline) <?> "wholeLine"

-- parse a String with whitespace-separated values into [String]
whiteSepLine = manyTill spaceSepWord newline <?> "whiteSepLine"


-- -- WORD PARSERS -- --


-- a single word followed by whitespace (space, newline, etc.):
word = do
    w <- many1 nonWhite
    spaces
    return w
    <?> "word"

-- a single word followed by one or more ' ' characters (won't consume '\n')
spaceSepWord = do
    w <- many1 nonWhite
    many (char ' ')
    return w
    <?> "spaceSepWord"

-- e.g. "hello:world" ---> ("hello","world")
-- won't consume newlines
twoWordsSepBy c = do
    x <- manyTill nonWhite (try$ char c)
    y <- many1 nonWhite
    many (char ' ')
    return (x,y)
    <?> "twoWordsSepBy"


-- -- CHARACTER PARSERS -- --


-- nonWhitespace character:
nonWhite = noneOf " \v\f\t\r\n" <?> "nonWhite"