1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% %
% Frown --- An LALR(k) parser generator for Haskell 98 %
% Copyright (C) 2001-2005 Ralf Hinze %
% %
% This program is free software; you can redistribute it and/or modify %
% it under the terms of the GNU General Public License (version 2) as %
% published by the Free Software Foundation. %
% %
% This program is distributed in the hope that it will be useful, %
% but WITHOUT ANY WARRANTY; without even the implied warranty of %
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the %
% GNU General Public License for more details. %
% %
% You should have received a copy of the GNU General Public License %
% along with this program; see the file COPYING. If not, write to %
% the Free Software Foundation, Inc., 59 Temple Place - Suite 330, %
% Boston, MA 02111-1307, USA. %
% %
% Contact information %
% Email: Ralf Hinze <ralf@cs.uni-bonn.de> %
% Homepage: http://www.informatik.uni-bonn.de/~ralf/ %
% Paper mail: Dr. Ralf Hinze %
% Institut für Informatik III %
% Universität Bonn %
% Römerstraße 164 %
% 53117 Bonn, Germany %
% %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
> module SearchTree ( FM, fromList, fromList_C, fromOrdList, toList
> , length, lookup, unsafeLookup )
> where
> import MergeSort ( mergeSortBy )
> import Data.Maybe ( fromMaybe )
> import Prelude hiding ( length, lookup )
> import qualified Prelude
%-------------------------------------------------------------------------------
\section{Binary search trees}
%-------------------------------------------------------------------------------
> data FM a v = Leaf
> | Node (FM a v) a v (FM a v)
>
> instance Functor (FM a) where
> fmap _f Leaf = Leaf
> fmap f (Node l a v r) = Node (fmap f l) a (f v) (fmap f r)
>
> instance (Eq a, Eq v) => Eq (FM a v) where
> fm1 == fm2 = toOrdList fm1 == toOrdList fm2
Construction.
> fromList :: (Ord a) => [(a, v)] -> FM a v
> fromList = fromOrdList . mergeSortBy (\ (a1, _) (a2, _) -> a1 <= a2)
> fromOrdList :: [(a, v)] -> FM a v
> fromOrdList avs = fst (build (Prelude.length avs) avs)
> where
> build 0 x = (Leaf, x)
> build n x = (Node l a v r, z)
> where m = (n-1) `div` 2
> (l, (a, v) : y) = build m x
> (r, z) = build (n - 1 - m) y
> fromList_C :: (Ord a) => (v -> v -> v) -> [(a, v)] -> FM a v
> fromList_C combine = fromOrdList . group . mergeSortBy (\ (a1, _) (a2, _) -> a1 <= a2)
> where
> group [] = []
> group ((a, v) : x) = case group x of
> [] -> [(a, v)]
> y@((a', v') : y')
> | a == a' -> (a, combine v v') : y'
> | otherwise -> (a, v) : y
> toOrdList :: FM a v -> [(a, v)]
> toOrdList t = traverse t []
> where
> traverse Leaf x = x
> traverse (Node l a v r) x = traverse l ((a, v) : traverse r x)
> toList :: FM a v -> [(a, v)]
> toList t = toOrdList t
> length :: FM a v -> Int
> length Leaf = 0
> length (Node l _a _v r) = length l + 1 + length r
Lookup.
> lookup :: (Ord a) => FM a v -> a -> Maybe v
> lookup Leaf _x = Nothing
> lookup (Node l a v r) x = case compare a x of
> LT -> lookup r x
> EQ -> Just v
> GT -> lookup l x
> unsafeLookup :: (Ord a, Show a) => FM a v -> a -> v
> unsafeLookup fm a = fromMaybe (error ("unsafeLookup: key not found: " ++ show a)) (lookup fm a)
|