Add solver

It's fragile in ways, let's make it better with more specs

Main.hs

@@ -6,6 +6,7 @@ import Data.Attoparsec.Text (parseOnly)
 import qualified Data.Text.IO as T
 
 import INAST
+import INSolver
 
 main :: IO ()
 main = do
@@ -13,4 +14,9 @@ main = do
   T.putStrLn "Using the following input network:"
   T.putStrLn inputNetwork
   T.putStrLn "Parsed AST:"
-  print (parseOnly insuranceNetworkParser inputNetwork)
+  let Right insnet = parseOnly insuranceNetworkParser inputNetwork
+  print insnet
+  T.putStrLn "Problem solution, input=3:"
+  print $ solve (3::Int) insnet
+  T.putStrLn "Problem solution, input=6:"
+  print $ solve (6::Int) insnet

desc.md

@@ -20,7 +20,10 @@ The following grammar:
 
 is used to represents insurance networks.
 
-Given a single input of type `Int`, the job of these networks is to provide, if possible, exactly 100% underwriting capital using the fewest insurers possible. Each insurer contributes their percentage only if their respective conditions are met.
+Given a single input of type `Int`, the job of these networks is to provide, if
+possible, exactly 100% underwriting capital using the fewest insurers possible.
+Each insurer contributes their percentage only if their respective conditions
+are met.
 
 Below is a simple example of such a network:
 
@@ -39,7 +42,8 @@ where:
 - `I3` contributes 40% only if `I1` contributes
 - etc...
 
-Given the above, your task is to write a small command line program that takes 2 parameters:
+Given the above, your task is to write a small command line program that takes 2
+parameters:
 - the path to a file that defines a network
 - an integer input to the network
 
@@ -49,8 +53,11 @@ Eg. if your program was given the above example network and:
 - input `3` then it would output `[1, 2]` (representing insurers `I1` and `I2`)
 - input `6` then it would output `[1, 3, 6]`
 
-If a network is unable to collect exactly 100% for a given input then your program should output `[]`.
+If a network is unable to collect exactly 100% for a given input then your
+program should output `[]`.
 
-Please create a new private github repository named `artificial-network`, commit all your code there and once finished please invite me, `pwm`, so we can check your solution.
+Please create a new private github repository named `artificial-network`, commit
+all your code there and once finished please invite me, `pwm`, so we can check
+your solution.
 
 Good luck!

package.yaml

@@ -6,6 +6,7 @@ dependencies:
   - base == 4.*
   - attoparsec
   - text
+  - mtl
 
 executables:
   in23:
@@ -17,4 +18,5 @@ library:
   source-dirs: src
   exposed-modules:
     - INAST
+    - INSolver
 

src/INAST.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveFoldable #-}
 {-# OPTIONS_GHC -Wno-unused-do-bind #-}
 
 module INAST where
@@ -49,7 +50,11 @@ insuranceNetworkParser = many1 line
 
 type InsuranceNetworkAST = [INASTLine]
 
-data INASTLine = INASTLine INASTInsurerId INASTPercent [INASTExpr]
+data INASTLine =
+  INASTLine { unINASTLineInsurerId :: INASTInsurerId
+            , unINASTLinePercent :: INASTPercent
+            , unINASTLineExprs :: [INASTExpr]
+            }
   deriving (Show)
 
 data INASTExpr = INASTExprLt INASTLt
@@ -64,7 +69,14 @@ newtype INASTGt = INASTGt Int
   deriving (Show)
 newtype INASTEq = INASTEq Int
   deriving (Show)
-newtype INASTInsurerId = INASTInsurerId Int
+newtype INASTInsurerId = INASTInsurerId { unNASTInsurerId :: Int }
-  deriving (Show)
+  deriving (Eq)
-newtype INASTPercent = INASTPercent Int
+
-  deriving (Show)
+instance Show INASTInsurerId where
+  show (INASTInsurerId i) = "I" ++ show i
+
+newtype INASTPercent = INASTPercent { unINASTPercent :: Int }
+
+instance Show INASTPercent where
+  show (INASTPercent p) = show p ++ "%"
+

src/INSolver.hs

@@ -0,0 +1,38 @@
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
+
+module INSolver where
+
+import Control.Monad
+import Control.Monad.State
+import Data.List (tails,find)
+
+import INAST
+
+-- solve :: Int -> InsuranceNetworkAST -> [INASTInsurerId]
+solve i = maybe [] (map unNASTInsurerId . reverse . fst)
+        . find ((== 100) . snd)
+        . map foldMe
+        . tails
+        . flip execState []
+        . mapM potentialInsId
+  where
+    foldMe :: [(INASTInsurerId,INASTPercent)] -> ([INASTInsurerId],Int)
+    foldMe = foldr (\ (i',INASTPercent p) (ixacc,pacc) -> (i':ixacc,p+pacc)) ([],0)
+
+    -- | Result is sensitive to order of execution.
+    --   One thing not speficied in the problem statement is whether expressions
+    --   only apply to previous lines, or if they can be looking forward
+    --   Here we're assuming the former case holds true.
+    potentialInsId :: INASTLine -> State [(INASTInsurerId,INASTPercent)] ()
+    potentialInsId (INASTLine iid pct exprs) = do
+      insidpctx <- get
+      when (allExprEval i insidpctx exprs) (modify ((iid,pct) :))
+
+allExprEval :: Int -> [(INASTInsurerId,INASTPercent)] -> [INASTExpr] -> Bool
+allExprEval i xs = all (exprEval i (map fst xs))
+
+exprEval :: Int -> [INASTInsurerId] -> INASTExpr -> Bool
+exprEval i _    (INASTExprLt (INASTLt n))  = i < n
+exprEval i _    (INASTExprGt (INASTGt n))  = i > n
+exprEval i _    (INASTExprEq (INASTEq n))  = i == n
+exprEval _ insx (INASTExprInsurerId insid) = insid `elem` insx