solution to 1had "Let it snow" http://lpaste.net/118571

gauss.hs

-- Solution to "Let it snow" 1had - http://lpaste.net/118571

import qualified Data.Map.Strict as M
import Data.List
import Control.Monad
import Data.Maybe

data SnowFlake = Six | Star | Eight | Flower | Unit
   deriving (Eq, Ord, Show)

type Eqn = M.Map SnowFlake Rational

coeff :: Eqn -> SnowFlake -> Rational
coeff e s = M.findWithDefault 0 s e

addM :: Eqn -> Eqn -> Eqn
addM e1 e2 = foldl' go e1 (M.assocs e2)
  where go m (k,v) = M.insertWith (+) k v m

multM :: Rational -> Eqn -> Eqn
multM a e = fmap (*a) e

matrix = [[Six,    Six,    Star, Eight  ],       -- ???
          [Six,    Flower, Star, Flower ],       -- 85
          [Eight,  Star,   Six,  Eight  ],       -- 87
          [Flower, Eight,  Star, Eight  ]]       -- 82
--          87      86      93     79

eqns :: [Eqn]
eqns =  toeqns (tail matrix) [85, 87, 82] ++ toeqns (transpose matrix) [87, 86, 93, 79]
  where toeqns rows units = zipWith toeqn rows units
        toeqn r u = foldl1 addM $ [ mkeqn s 1 | s <- r ] ++ [ mkeqn Unit u ]
          where mkeqn s a = M.fromList [(s,a)]

gauss :: [Eqn] -> Eqn
gauss [] = M.empty
gauss (e:es) =
  case candidates of
    [] -> if coeff e Unit /= 0
            then error "unsolvable"
            else gauss es
    ((s,a):_) -> let es' = map elim es
                     elim f = let b = coeff f s in f `addM` (multM (-b/a) e)
                     vals' = gauss es'
                     -- back substitute
                     ones = sum [ a*b | (s,a) <- M.assocs e,  b <- maybeToList (M.lookup s vals') ]
                              - coeff e Unit
                     v = -ones / a
                 in M.insert s v vals'
  where
    candidates = [ (s,a) | s <- [Six,Star,Eight,Flower], let a = coeff e s, a /= 0 ]

solve = let vals = gauss eqns
            row1 = sum $ map (coeff vals) [Six,Six,Star,Eight]
        in (row1, vals)

test2 = gauss es
  where es = [ M.fromList [ (Six, 1), (Unit, 3) ]
             , M.fromList [ (Six, 1), (Star, 1), (Unit, 5) ]
             ]

-- this is what eqns should be
allEqns :: [Eqn]
allEqns =
  [ m [ (Six, 1), (Flower, 2), (Star, 1), (Unit, 85) ]
  , m [ (Eight, 2), (Star, 1), (Six, 1), (Unit, 87) ]
  , m [ (Flower, 1), (Eight, 2), (Star, 1), (Unit, 82) ]
  , m [ (Six, 2), (Eight, 1), (Flower, 1), (Unit, 87) ]
  , m [ (Six, 1), (Flower, 1), (Star, 1), (Eight, 1), (Unit, 86) ]
  , m [ (Star, 3), (Six, 1), (Unit, 93) ]
  , m [ (Eight, 3), (Flower, 1), (Unit, 79) ]
  ]
  where m = M.fromList

main = print solve