implement practice problems, 2010 Africa

googlecodejam2016-hs.cabal

@@ -35,6 +35,30 @@ executable q1a-c
                      , containers
   default-language:    Haskell2010
 
+executable 2010africa-a
+  hs-source-dirs:      src/2010africa
+  main-is:             A.hs
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , containers
+  default-language:    Haskell2010
+
+executable 2010africa-b
+  hs-source-dirs:      src/2010africa
+  main-is:             B.hs
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , containers
+  default-language:    Haskell2010
+
+executable 2010africa-c
+  hs-source-dirs:      src/2010africa
+  main-is:             C.hs
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , containers
+  default-language:    Haskell2010
+
 test-suite tests
   type:                exitcode-stdio-1.0
   hs-source-dirs:      test
@@ -54,6 +78,33 @@ test-suite q1a-c-test
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   default-language:    Haskell2010
 
+test-suite 2010africa-a-test
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test/2010africa
+  main-is:             ASpec.hs
+  build-depends:       base
+                     , doctest
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010
+
+test-suite 2010africa-b-test
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test/2010africa
+  main-is:             BSpec.hs
+  build-depends:       base
+                     , doctest
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010
+
+test-suite 2010africa-c-test
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test/2010africa
+  main-is:             CSpec.hs
+  build-depends:       base
+                     , doctest
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010
+
 source-repository head
   type:     git
   location: https://github.com/yuto-matsum/googlecodejam2016-hs

src/2010africa/A.hs

@@ -0,0 +1,58 @@
+module Main where
+
+import           Data.List
+import           Data.Ord
+
+main :: IO ()
+main = interact io
+
+io :: String -> String
+io = unlines . addPrefixes . map solve . parse . tail . lines
+
+type Problem = (Int,[Int]) -- (Credit, Prices)
+
+{-|
+>>> parse ["100", "3", "5 75 25", "200", "7", "150 24 79 50 88 345 3"]
+[(100,[5,75,25]),(200,[150,24,79,50,88,345,3])]
+-}
+parse :: [String] -> [Problem]
+parse [] = []
+parse (x:y:z:ws) = (credit, prices) : remaining where
+  credit = read x
+  prices = (map read . words) z
+  remaining = parse ws
+
+{-|
+>>> solve (100,[5,75,25])
+"2 3"
+>>> solve (200,[150,24,79,50,88,345,3])
+"1 4"
+>>> solve (8,[2,1,9,4,4,56,90,3])
+"4 5"
+-}
+solve :: Problem -> String
+solve p = (unwords . map (show . (+1) . fst) . maximumBy comparingPrice . filter (withinCredit c) . iterateChoices . snd) p where
+  c = fst p
+
+{-|
+>>> iterateChoices [5,75,25]
+[[(0,5),(1,75)],[(0,5),(2,25)],[(1,75),(2,25)]]
+-}
+iterateChoices :: [Int] -> [[(Int,Int)]]
+iterateChoices xs = [[kv i, kv j] | i<-[0..n], j<-[(i+1)..n]] where
+  kv i = (i, xs !! i)
+  n = length xs - 1
+
+withinCredit :: Int -> [(Int,Int)] -> Bool
+withinCredit c = (<=c) . sum . map snd
+
+{-|
+>>> comparingPrice [(1,5),(2,75)] [(1,5),(3,25)]
+GT
+-}
+comparingPrice :: [(Int,Int)] -> [(Int,Int)] -> Ordering
+comparingPrice = comparing (sum . map snd)
+
+addPrefixes :: [String] -> [String]
+addPrefixes = zipWith addPrefix [1..] where
+  addPrefix i s = "Case #" ++ show i ++ ": " ++ s

src/2010africa/B.hs

@@ -0,0 +1,22 @@
+module Main where
+
+main :: IO ()
+main = interact io
+
+io :: String -> String
+io = unlines . addPrefixes . map solve . tail . lines
+
+{-|
+>>> solve "this is a test"
+"test a is this"
+>>> solve "foobar"
+"foobar"
+>>> solve "all your base"
+"base your all"
+-}
+solve :: String -> String
+solve = unwords . reverse . words
+
+addPrefixes :: [String] -> [String]
+addPrefixes = zipWith addPrefix [1..] where
+  addPrefix i s = "Case #" ++ show i ++ ": " ++ s

src/2010africa/C.hs

@@ -0,0 +1,47 @@
+module Main where
+
+import           Data.Char
+
+main :: IO ()
+main = interact io
+
+io :: String -> String
+io = unlines . addPrefixes . map solve . tail . lines
+
+{-|
+>>> solve "hi"
+"44 444"
+>>> solve "yes"
+"999337777"
+>>> solve "foo  bar"
+"333666 6660 022 2777"
+>>> solve "hello world"
+"4433555 555666096667775553"
+-}
+solve :: String -> String
+solve = connect . map convert
+
+type Digit = Int
+type Times = Int
+
+convert :: Char -> (Digit,Times)
+convert c | 'a' <= c && c<= 'c' = (2, ord c - ord 'a' + 1)
+          | 'd' <= c && c<= 'f' = (3, ord c - ord 'd' + 1)
+          | 'g' <= c && c<= 'i' = (4, ord c - ord 'g' + 1)
+          | 'j' <= c && c<= 'l' = (5, ord c - ord 'j' + 1)
+          | 'm' <= c && c<= 'o' = (6, ord c - ord 'm' + 1)
+          | 'p' <= c && c<= 's' = (7, ord c - ord 'p' + 1)
+          | 't' <= c && c<= 'v' = (8, ord c - ord 't' + 1)
+          | 'w' <= c && c<= 'z' = (9, ord c - ord 'w' + 1)
+          | ' ' == c            = (0, 1)
+
+connect :: [(Digit,Times)] -> String
+connect [] = ""
+connect [x] = internal x
+connect (x:y:xs) | fst x == fst y = internal x  ++ " " ++ connect (y:xs)
+                 | fst x /= fst y = internal x ++ connect (y:xs)
+internal t = (concatMap show . replicate (snd t) . fst) t
+
+addPrefixes :: [String] -> [String]
+addPrefixes = zipWith addPrefix [1..] where
+  addPrefix i s = "Case #" ++ show i ++ ": " ++ s

test/2010africa/ASpec.hs

@@ -0,0 +1,4 @@
+import           Test.DocTest
+
+main :: IO ()
+main = doctest ["src/2010africa/A.hs"]

test/2010africa/BSpec.hs

@@ -0,0 +1,4 @@
+import           Test.DocTest
+
+main :: IO ()
+main = doctest ["src/2010africa/B.hs"]

test/2010africa/CSpec.hs

@@ -0,0 +1,4 @@
+import           Test.DocTest
+
+main :: IO ()
+main = doctest ["src/2010africa/C.hs"]