Purely Functional Data Structures 第2章
演習問題を解いたのでメモ.
ex 2.1
suffixes :: [a] -> [[a]] suffixes [] = [[]] suffixes xss@(_:xs) = xss : suffixes xs
ex 2.2
data Set a = Leaf | Branch a (Set a) (Set a) deriving Show empty :: Set a empty = Leaf insert :: Ord a => a -> Set a -> Set a insert x Leaf = Branch x Leaf Leaf insert x tree@(Branch y left right) | x < y = Branch y (insert x left) right | x > y = Branch y left (insert x right) | otherwise = tree member :: Ord a => a -> Set a -> Bool member x set = member' Nothing set where member' c Leaf = maybe False (>= x) c member' c (Branch y left right) | x < y = member' c left | otherwise = member' (Just y) right
ex 2.3
「Establish only one handler per insertion rather than one handler per iteration」の意味がわからなかったので,この文は無視して解いた.
import Data.Maybe data Set a = Leaf | Branch a (Set a) (Set a) deriving Show empty :: Set a empty = Leaf insert :: Ord a => a -> Set a -> Set a insert x set = fromMaybe set (insert' set) where insert' Leaf = Just (Branch x Leaf Leaf) insert' (Branch y left right) | x < y = fmap (\new -> Branch y new right) (insert' left) | x > y = fmap (\new -> Branch y left new) (insert' right) | otherwise = Nothing member :: Ord a => a -> Set a -> Bool member x set = member' Nothing set where member' c Leaf = maybe False (>= x) c member' c (Branch y left right) | x < y = member' c left | otherwise = member' (Just y) right
ex 2.4
import Data.Maybe data Set a = Leaf | Branch a (Set a) (Set a) deriving Show empty :: Set a empty = Leaf insert :: Ord a => a -> Set a -> Set a insert x set = fromMaybe set (insert' Nothing set) where insert' c Leaf | isNothing c || x > fromJust c = Just (Branch x Leaf Leaf) | otherwise = Nothing insert' c (Branch y left right) | x < y = fmap (\new -> Branch y new right) (insert' c left) | otherwise = fmap (\new -> Branch y left new) (insert' (Just y) right) member :: Ord a => a -> Set a -> Bool member x set = member' Nothing set where member' c Leaf = maybe False (>= x) c member' c (Branch y left right) | x < y = member' c left | otherwise = member' (Just y) right
ex 2.5
data Tree a = Empty | Node a (Tree a) (Tree a) deriving Show makeCompleteBinaryTree :: a -> Int -> Tree a makeCompleteBinaryTree _ 0 = Empty makeCompleteBinaryTree x d = let subtree = makeCompleteBinaryTree x (d-1) in Node x subtree subtree makeBinaryTree :: a -> Int -> Tree a makeBinaryTree x n = fst (make2 n) where make2 0 = (Empty, Node x Empty Empty) make2 n | n `mod` 2 == 0 = let (t1, t2) = make2 (n `div` 2 - 1) in (Node x t1 t2, Node x t2 t2) | otherwise = let (t1, t2) = make2 (n `div` 2) in (Node x t1 t1, Node x t1 t2)
ex 2.6
import Data.Maybe data FinateMap k v = Leaf | Branch k v (FinateMap k v) (FinateMap k v) deriving Show empty :: FinateMap k v empty = Leaf bind :: Ord k => k -> v -> FinateMap k v -> FinateMap k v bind k v m = fromMaybe m (bind' Nothing m) where bind' c Leaf | isNothing c || k > fromJust c = Just (Branch k v Leaf Leaf) | otherwise = Nothing bind' c (Branch k' v' left right) | k < k' = fmap (\new -> Branch k' v' new right) (bind' c left) | otherwise = fmap (\new -> Branch k' v' left new) (bind' (Just k') right) lookup :: Ord k => k -> FinateMap k v -> Maybe v lookup k m = lookup' Nothing m where lookup' (Just (k', v')) Leaf | k' >= k = Just v' lookup' c (Branch k' v' left right) | k < k' = lookup' c left | otherwise = lookup' (Just (k', v')) right lookup' _ _ = Nothing