Helper in discussion: http://www.reddit.com/r/compsci/comments/1mv7n2/can_anyone_please_help_me_crack_this_circuit/

gistfile1.hs

-- http://www.reddit.com/r/compsci/comments/1mv7n2/can_anyone_please_help_me_crack_this_circuit/

-- Hey /r/compsci
-- I am in the midst of doing an assigment that requires me to
-- make a circuit that has 7 inputs and outputs a 1 if the input
-- have at least or more than 4 ones. The requirements are that
-- I can only 4 AND gates and limitless XOR gates. Also I can
-- only have 2 input connected to a gate.
--
-- I've been looking at this for 4 hours now and really can't
-- crack it.
--
-- Can anyone here please point me in the right direction?
--
--                                         /u/Lostinboolean


import Text.Printf (printf)


-- This is just a simple generator:
-- > rec [[False,True],[False,True]]
-- >>> [[False,False],[False,True],[True,False],[True,True]]
-- > rec [[1,2],[3,4,5]]
-- >>> [[1,3],[1,4],[1,5],[2,3],[2,4],[2,5]]
rec (ops:xss) = concatMap aux ops
  where recur = rec xss
        aux o = map (o:) recur
rec [] = [[]]


-- Wrapper for generator:
-- gen 2 == rec [[False,True], [False,True]]
gen 0 = []
gen n = [False,True]:gen (n-1)


-- Draw truth table. Takes additional param: list of funs to calc
-- for each input as function * string tuple.
-- > draw [(actual 2, "ACT"), (dlorik, "dlorik")] (rec $ gen 3)
-- >>>    .   |   .   |   .   |       ACT |    dlorik |
-- >>> -------+-------+-------+-----------+-----------+
-- >>>  False | False | False |     False |      False |
-- >>>  False | False |  True |     False |      False |
-- >>>  False |  True | False |     False |      False |
-- >>>                                             (...)
draw :: [([Bool]->Bool, String)] -> [[Bool]] -> IO ()
draw fns bbls@(bls:_) = do
  mapM_ (\_ -> printf "   .   |") bls
  mapM_ (\(f,d) -> printf " %9s |" d) fns
  printf "\n"
  mapM_ (\_ -> printf "-------+") bls
  mapM_ (\(f,d) -> printf "-----------+") fns
  printf "\n"
  aux bbls
  where aux :: [[Bool]] -> IO ()
        aux [] = return ()
        aux (bs:bls) = do
          mapM_ (\x -> printf " %5s |" $ show x) bs
          mapM_ (\(f,d) -> printf " %9s |" $ show $ f bs) fns
          printf "\n"
          aux bls


-- True iff the input have at least or more than NUM ones.
actual num oflist = length (filter id oflist) >= num


xor True False = True
xor False True = True
xor _ _        = False


-- /u/Dlorik: "with inputs A,B,C you ((A XOR B) AND (B XOR C)) XOR B)"
-- (case for simpler problem: ">1 of 3")
-- http://www.reddit.com/r/compsci/comments/1mv7n2/can_anyone_please_help_me_crack_this_circuit/ccdfasv
dlorik [xxx,b,c] = xxx `xor` (and [(xxx `xor` b),(xxx `xor` c)])


-- Check if the given FUN meets the requirements: at least or more than
-- P trues in any input of length Q.
-- > check dlorik 2 3
-- >>> True
check fun p q = all (\x -> (actual p x) == (fun x)) (rec $ gen q)