Merge branch 'release/0.1.0.0'

.travis.yml

@@ -18,7 +18,7 @@ install:
   - stack setup --no-terminal
 
 script:
-  - stack test --no-terminal --coverage
+  - stack test :tests --no-terminal --coverage
 
 after_script:
   - travis_retry curl -L https://github.com/rubik/stack-hpc-coveralls/releases/download/v0.0.3.0/shc-linux-x64-${GHCVER}.tar.bz2 | tar -xj

googlecodejam2016-hs.cabal

@@ -27,10 +27,28 @@ executable q1a-b
   build-depends:       base
   default-language:    Haskell2010
 
+executable q1a-c
+  hs-source-dirs:      q1a
+  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
   main-is:             Spec.hs
+  build-depends:       base
+                     , doctest
+                     , directory
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010
+
+test-suite q1a-c-test
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test/q1a
+  main-is:             CSpec.hs
   build-depends:       base
                      , doctest
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N

q1a/C.hs

@@ -0,0 +1,227 @@
+module Main where
+
+import qualified Data.List  as List
+import qualified Data.Map   as Map
+import qualified Data.Maybe as Maybe
+
+main :: IO ()
+main = interact io
+
+{-|
+-- >>> io "4\n4\n2 3 4 1\n4\n3 3 4 1\n4\n3 3 4 3\n10\n7 8 10 10 9 2 9 6 3 3\n"
+-- "Case #1: 4\nCase #2: 3\nCase #3: 3\nCase #4: 6\n"
+-}
+io :: String -> String
+io = unlines . addPrefixes . map solve . parse . tail . lines
+
+{-|
+>>> addPrefixes ["A","B","C"]
+["Case #1: A","Case #2: B","Case #3: C"]
+-}
+addPrefixes :: [String] -> [String]
+addPrefixes = zipWith addPrefix [1..] where
+  addPrefix :: Int -> String -> String
+  addPrefix i s = "Case #" ++ show i ++ ": " ++ s
+
+type Problem = [Int]
+
+{-|
+>>> parse ["4","2 3 4 1","3","3 2 1"]
+[[2,3,4,1],[3,2,1]]
+-}
+parse :: [String] -> [Problem]
+parse [] = []
+parse (_:xs) = parsed : parse remaining where
+  parsed = (map read . words . head) xs
+  remaining = tail xs
+
+{-|
+-- >>> solve [2,3,4,1]
+-- "4"
+-- >>> solve [3,3,4,1]
+-- "3"
+-- >>> solve [3,3,4,3]
+-- "3"
+-- >>> solve [7,8,10,10,9,2,9,6,3,3]
+-- "6"
+-}
+solve :: Problem -> String
+solve p = (show . length) theLongest where
+  theLongest :: Circle
+  theLongest = List.maximumBy orderByLength anyCircles
+  anyCircles = [circle x y | x <- anyPaths, y <- anyPaths]
+  anyPaths = pathsOf p
+
+type Circle = [Int]
+type Path = [Int]
+
+{-|
+>>> circle [1,2,3] [1,2]
+[1,2,3]
+>>> circle [1,2] [1,2,3]
+[1,2,3]
+>>> circle [1,2,3,10,11] [6,5,4,3]
+[1,2,3,4,5,6]
+>>> circle [1,2,3,10,11] [4,3]
+[1,2,3,4]
+-}
+circle :: Path -> Path -> Circle
+circle p q | p `isSubpathOf` q = q
+           | q `isSubpathOf` p = p
+           | otherwise = connectPath p (reverse q)
+
+{-|
+>>> [3,4,5] `isSubpathOf` [1,2,3,4,5,6]
+True
+>>> [3,4,5] `isSubpathOf` [1,2,3,4,5]
+True
+>>> [3,4,5] `isSubpathOf` [1,2,3,4]
+False
+>>> [1,2,3] `isSubpathOf` [1,2,3,4,5]
+True
+>>> [1,2,3] `isSubpathOf` [1,2,3]
+True
+-}
+isSubpathOf :: Path -> Path -> Bool
+isSubpathOf [] _  = True
+isSubpathOf _  [] = False
+isSubpathOf p q
+  | head p == head q = tail p `isSubpathOf` tail q
+  | otherwise        = p `isSubpathOf` tail q
+
+{-|
+>>> connectPath [1,2,3,10,11] [3,4,5,6]
+[1,2,3,4,5,6]
+>>> connectPath [1,2,3,10,11] [3,4]
+[1,2,3,4]
+-}
+connectPath :: Path -> Path -> Circle
+connectPath [] _  = []
+connectPath ps [] = ps
+connectPath (p:ps) (q:qs)
+  | p == q = q:qs
+  | p /= q = p : connectPath ps (q:qs)
+
+{-|
+>>> orderByLength [1,2] [3]
+GT
+>>> orderByLength [1,2] [3,4]
+EQ
+>>> orderByLength [1,2] [3,4,5]
+LT
+-}
+orderByLength :: Path -> Path -> Ordering
+orderByLength p q | lp >  lq = GT
+                  | lp <  lq = LT
+                  | lp == lq = EQ where
+  lp = length p
+  lq = length q
+
+{-|
+>>> pathsOf [2,3,4,1]
+[[1,2,3,4]]
+>>> List.sort $ pathsOf [3,3,4,3]
+[[1,3,4],[2,3,4]]
+>>> List.sort $ pathsOf [7,8,10,10,9,2,9,6,3,3]
+[[1,7,9,3,10],[2,8,6],[4,10,3],[5,9,3,10]]
+-}
+pathsOf :: Problem -> [Path]
+pathsOf = trimSubpath . trimSamePath . reverse . walkFromAllPoints
+
+{-|
+>>> walkFromAllPoints [2,3,4,1]
+[[1,2,3,4],[2,3,4,1],[3,4,1,2],[4,1,2,3]]
+-}
+walkFromAllPoints :: Problem -> [Path]
+walkFromAllPoints p = map (walk p) [1..length p]
+
+{-|
+>>> trimSamePath [[4,1,2,3],[3,4,1,2],[2,3,4,1],[1,2,3,4]]
+[[1,2,3,4]]
+-}
+trimSamePath :: [Path] -> [Path]
+trimSamePath [] = []
+trimSamePath (x:xs) | any (isRotation x) xs = next
+                    | otherwise             = x : next where
+  next = trimSamePath xs
+
+{-|
+>>> trimSubpath [[1,2,3,4],[2,3,4],[3,4]]
+[[1,2,3,4]]
+-}
+trimSubpath :: [Path] -> [Path]
+trimSubpath [] = []
+trimSubpath xs = filter (uniqPath xs) xs where
+  uniqPath :: [Path] -> Path -> Bool
+  uniqPath xs y = never (y `isSubpathOf`) [x | x<-xs, x/=y]
+
+{-|
+>>> never (>0) [0,0,0]
+True
+>>> never (>0) [0,0,1,0]
+False
+>>> never (>0) []
+True
+-}
+never :: Foldable t => (a -> Bool) -> t a -> Bool
+never f xs = not (any f xs)
+
+{-|
+>>> isRotation [1,2,3,4] [2,3,4,1]
+True
+>>> isRotation [1,2,3,4] [3,4,1,2]
+True
+>>> isRotation [1,2,3,4] [4,1,2,3]
+True
+>>> isRotation [1,2,3,4] [1,2,3,4]
+True
+>>> isRotation [1,2,3,4] [1,2,4,3]
+False
+>>> isRotation [1,2,3,4] [1,2,3]
+False
+-}
+isRotation :: (Eq a) => [a] -> [a] -> Bool
+isRotation x y
+  | length x /= length y = False
+  | otherwise              = y `elem` iterateRotations x where
+    iterateRotations :: [a] -> [[a]]
+    iterateRotations z = map (repeatF rotate z) [1..length z]
+    rotate :: [a] -> [a]
+    rotate xs = tail xs ++ [head xs]
+
+{-|
+>>> repeatF (*2) 1 10
+1024
+>>> repeatF (++".") "hmm" 3
+"hmm..."
+-}
+repeatF :: (a -> a) -> a -> Int -> a
+repeatF _ x 0 = x
+repeatF f x n = repeatF f (f x) (n-1)
+
+{-|
+>>> walk [2,3,4,1] 1
+[1,2,3,4]
+>>> walk [2,3,4,1] 3
+[3,4,1,2]
+>>> walk [7,8,10,10,9,2,9,6,3,3] 1
+[1,7,9,3,10]
+-}
+walk :: Problem -> Int -> Path
+walk p x = (reverse . internal) [x] where
+  internal :: [Int] -> Path
+  internal (x:xs) | next `notElem` xs = internal (next:x:xs)
+                  | otherwise      = x:xs where
+    edge = last xs
+    next = Maybe.fromJust (Map.lookup x (graph p))
+
+type Arrow = Map.Map Int Int
+
+{-|
+>>> graph [2,3,4,1]
+fromList [(1,2),(2,3),(3,4),(4,1)]
+>>> graph [3,3,4,3]
+fromList [(1,3),(2,3),(3,4),(4,3)]
+-}
+graph :: Problem -> Arrow
+graph = Map.fromList . zip [1..]

test/Spec.hs

@@ -1,6 +1,10 @@
+import           Data.List
+import           System.Directory
 import           Test.DocTest
 
 main :: IO ()
 main = do
-  doctest ["q1a/A.hs"]
-  doctest ["q1a/B.hs"]
+  ps <- getDirectoryContents "./q1a"
+  let files = map ("./q1a/"++) $ filter (isSuffixOf ".hs") ps
+      args = map (:[]) files
+  mapM_ doctest args

test/q1a/CSpec.hs

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