Skip to content

Instantly share code, notes, and snippets.

@chrisyco
Created January 19, 2012 04:16
Show Gist options
  • Save chrisyco/1637814 to your computer and use it in GitHub Desktop.
Save chrisyco/1637814 to your computer and use it in GitHub Desktop.
Bird tree solution in linear time
import Data.ByteString.Char8 ( ByteString )
import qualified Data.ByteString.Char8 as B
import Control.Applicative ( (<$>), (<*>) )
import Data.Char ( isSpace )
import Data.List ( intercalate )
import Data.Maybe ( catMaybes )
import Data.Ratio ( (%), numerator, denominator )
{-
A bird tree is an infinite binary tree, whose definition is as follows:
bird = 1/1
/ \
/ \
/ \
1/(bird+1) (1/bird)+1
-}
------------------------------------------------------------------------
-- Entry point
------------------------------------------------------------------------
main :: IO ()
main = (run <$> B.readFile "bird.in") >>= B.writeFile "bird.out"
where
run = convey . contemplate . consume
consume :: ByteString -> [Rational]
consume = readAll . drop 1 . B.lines
where
readAll :: [ByteString] -> [Rational]
readAll = catMaybes . map (fmap fst . readRational . skipSpaces)
contemplate :: [Rational] -> [[Direction]]
contemplate = map findInTree
convey :: [[Direction]] -> ByteString
convey = B.unlines . map (B.pack . map directionToChar)
directionToChar :: Direction -> Char
directionToChar L = 'L'
directionToChar R = 'R'
readRational :: ByteString -> Maybe (Rational, ByteString)
readRational str = do
(x, str' ) <- B.readInteger str
(_, str'' ) <- checkChar '/' str'
(y, str''') <- B.readInteger str''
return (x % y, str''')
skipSpaces :: ByteString -> ByteString
skipSpaces = B.filter (not . isSpace)
checkChar :: Char -> ByteString -> Maybe (Char, ByteString)
checkChar c str = do
(x, xs) <- B.uncons str
if x == c
then Just (x, xs)
else Nothing
------------------------------------------------------------------------
-- Main code
------------------------------------------------------------------------
data Direction = L | R
deriving (Enum, Eq, Ord, Show)
findInTree :: Rational -> [Direction]
findInTree = doMagicalStuff <$> numerator <*> denominator
-- | Magic begins here.
doMagicalStuff :: Integer -> Integer -> [Direction]
doMagicalStuff 0 _ = []
doMagicalStuff _ 0 = []
doMagicalStuff a b | b > a = L : doMagicalStuff (b - a) a
| a > b = R : doMagicalStuff b (a - b)
| otherwise = []
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment