haskell-jp / questions #1

import qualified Data.ByteString.Char8 as C

chomp :: C.ByteString -> C.ByteString
chomp str | C.length str < 1   = str
          | C.last str == '\r' = C.init str
          | otherwise = str

chomp :: C.ByteString -> C.ByteString
chomp str = chompCRLF $ chompCRLF str
  where chompCRLF s =
          case C.unsnoc s of
            Nothing -> s
            Just (s_c, '\r') -> s_c
            Just (s_c, '\n') -> s_c
            Just _ -> s

log2Int :: Int -> Int
log2Int x = truncate $ logBase 2 $ fromIntegral x

logBase2 x = finiteBitSize x - 1 - countLeadingZeros x

import Data.Bits
import Data.List

data Tree a = Leaf a
            | Node (Tree a) (Tree a) deriving (Eq, Show)

singleton :: a -> Tree a
singleton = Leaf

join :: Tree a -> Tree a -> Tree a
join = Node

fromList :: [a] -> Tree a
fromList xs = reduce $ snd $ foldl' add (0,[]) $ map singleton xs
  where
    add (i,ts) t = (i+1, merge (mergeCount i) (t:ts))
    merge 0 ts        = ts
    merge n (t1:t2:ts) = merge (n - 1) (join t2 t1:ts)
    merge _ _ = error "merge"
    reduce [t] = t
    reduce (t1:t2:ts) = reduce (join t2 t1:ts)
    reduce _ = error "reduce"

mergeCount :: Int -> Int
mergeCount = countTrailingZeros . complement

{-# LANGUAGE DeriveFoldable #-}
import Data.Foldable

data Tree a = Leaf a
            | Node (Tree a) (Tree a) deriving (Eq, Show, Foldable)

fromList :: [a] -> Tree a
fromList xs = case foldl' (flip $ push 0 . Leaf) [] xs of
  [] -> error "empty"
  [(_, r)] -> r
  ts -> error "incomplete"
  where
    push :: Int -> Tree a -> [(Int, Tree a)] -> [(Int, Tree a)]
    push m x ys'@((n, y) : ys)
      | m == n = push (m + 1) (Node y x) ys
      | otherwise = (m, x) : ys'
    push m x [] = [(m, x)]

data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Show)

fromList :: [a] -> Tree a
fromList [] = error "No Element"
fromList xs = construct (map Leaf xs)

construct :: [Tree a] -> Tree a
construct [t] = t
construct ts  = construct (pairing ts)

pairing :: [Tree a] -> [Tree a]
pairing (t:u:vs) = Node t u : pairing vs
pairing ts       = ts