1st commit on 036_haskell

2 files changed, 67 insertions, 0 deletions

diff --git a/challenge-036/stuart-little/haskell/ch-1.hs b/challenge-036/stuart-little/haskell/ch-1.hs
new file mode 100755
index 0000000000..af71e2ef76
--- /dev/null
+++ b/challenge-036/stuart-little/haskell/ch-1.hs
@@ -0,0 +1,33 @@
+#!/usr/bin/env runghc
+
+-- run <script> <VIN>
+
+import Data.List ((\\))
+import System.Environment (getArgs,)
+
+letters :: String
+letters = (['0'..'9'] ++ ['A'..'Z']) \\ "IOQ"
+
+values :: [Int]
+values = [0..9] ++ [1..8] ++ ([1..9]\\[6,8]) ++ [2..9]
+
+wts :: [Int]
+wts = [8,7..2] ++ [10,0] ++ [9,8..2]
+
+checkDig :: String -> Char
+checkDig vin = case (traverse (flip lookup (zip letters values)) vin) of
+  Nothing -> error "Invalid characters"
+  Just vs -> let r = flip mod 11 $ sum $ zipWith (\i v -> (wts !! i) * v) [0..] vs in
+    if r<10
+    then head $ show r
+    else 'X'
+
+validateVin :: String -> String
+validateVin vin
+  |(length vin /= 17) = error "Must be 17-characters-long"
+  |checkDig vin /= vin !! 8 = error "Check-digit does not match"
+  |otherwise = "Valid"
+
+main = do
+  vin <- getArgs >>= return.head
+  putStrLn $ validateVin vin
diff --git a/challenge-036/stuart-little/haskell/ch-2.hs b/challenge-036/stuart-little/haskell/ch-2.hs
new file mode 100755
index 0000000000..6e916f850b
--- /dev/null
+++ b/challenge-036/stuart-little/haskell/ch-2.hs
@@ -0,0 +1,34 @@
+#!/usr/bin/env runghc
+
+-- run <script> <nr of boxes; defaults to arbitrary>
+
+import Data.List (subsequences,sortOn,)
+import Data.List.Utils (join,)
+import Data.Maybe (isNothing,fromJust,)
+import Safe (headMay,lastDef,)
+import System.Environment (getArgs,)
+
+data Knapsack = KS { name :: String  
+                   , weight :: Float
+                   , amount :: Float
+                   } deriving (Show)   
+
+optKS :: Maybe Int -> Float -> [Knapsack] -> [Knapsack]
+optKS nr underw sacks = lastDef [] $ sortOn (sum.(map amount)) $ filter (nrSacks nr) $ filter ( (underw >).sum.(map weight) ) $ subsequences sacks where
+  nrSacks :: Maybe Int -> [Knapsack] -> Bool
+  nrSacks nr = if (isNothing nr)
+               then (const True)
+               else ((fromJust nr)==).length
+
+main = do
+  nrbx <- getArgs >>= return.headMay.(map (read::String->Int))
+  let res = optKS nrbx 15 sacks where
+        sacks = [ KS {name = "R", weight=1.0, amount=1.0},
+                  KS {name = "B", weight=1, amount=2},
+                  KS {name = "G", weight=2, amount=2},
+                  KS {name = "Y", weight=12, amount=4},
+                  KS {name = "P", weight=4, amount=10.0}
+                ]
+  putStrLn $ "Result: " ++ (join " + " $ map name res)
+  putStrLn $ "Total weight: " ++ (show $ sum $ map weight res)
+  putStrLn $ "Total value: " ++ (show $ sum $ map amount res)