Skip to content

Instantly share code, notes, and snippets.

@ConnorBaker
Created May 23, 2020 23:27
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save ConnorBaker/4d1f0166e748a4518718822d7730cfd5 to your computer and use it in GitHub Desktop.
Save ConnorBaker/4d1f0166e748a4518718822d7730cfd5 to your computer and use it in GitHub Desktop.
{-# LANGUAGE DeriveFoldable, DeriveFunctor, ScopedTypeVariables #-}
module Main where
import Data.List hiding ( insert )
import Control.Monad
data BTree a = Leaf | Branch (BTree a) a (BTree a)
deriving (Eq, Foldable, Functor, Ord, Show)
insert :: (Ord a) => a -> BTree a -> BTree a
insert x Leaf = Branch Leaf x Leaf
insert x (Branch leftys y rightys)
| x < y = Branch (insert x leftys) y rightys
| otherwise = Branch leftys y (insert x rightys)
mkTree :: (Ord a) => [a] -> BTree a
mkTree = foldl (flip insert) Leaf
countShapes :: [BTree a] -> Int
countShapes = length . group . sort . fmap void
main :: IO ()
main = do
-- The first line of the input contains two integers, n (1 <= n <= 50),
-- which is the number of ceiling prototypes to analyze, and k
-- (1 <= k <= 20), which is the number of layers in each of the prototypes.
[n, k] :: [Int] <- map read . words <$> getLine
-- The next n lines describe the ceiling prototypes. Each of these lines
-- contains k distinct integers (between 1 and 10^6, inclusive), which
-- are the collapse-resistance values of the layers in a ceiling prototype,
-- ordered from top to bottom.
rows :: [[Int]] <- map (map read . words) <$> replicateM n getLine
let malformed = filter ((/= k) . length) rows
when
((not . null) malformed)
( error
$ "Expected rows of length "
++ show k
++ " but saw:\n"
++ show malformed
)
let trees = map mkTree rows
(print . countShapes) trees
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment