B-Baum

gistfile1.txt

-- http://www.haskell.org/pipermail/haskell-cafe/2005-November/012009.html only def
data BTree = BTree [Int] [BTree] deriving (Show, Eq)

t = 2 -- t ist die minimale anzahl an kindknoten
if' :: Bool -> a -> a -> a
if' True  x _ = x
if' False _ y = y

isLeaf (BTree x y) = length y == 0
       
search :: Int -> BTree -> (Int, BTree)
search s t@(BTree x y) = if' (isLeaf t) (searchLeaf s t) (searchInnerNode s t)
                            
searchInnerNode s t@(BTree x y) = if' (firstPos s x 0 == -2) (search s (last y)) (if' (x !! (firstPos s x 0) == s) (((firstPos s x 0),t)) (search s (y !! firstPos s x 0)))
    where
        firstPos s (x:xs) i 
            | x >= s = i
            | otherwise = firstPos s xs (i+1)
        firstPos s [] _ = -2
        
 
searchLeaf :: Int -> BTree -> (Int, BTree)
searchLeaf s t@(BTree x y) = if' ((s' s x 0) == -1) (-1,(BTree [] [])) ((s' s x 0),t) 
    where
        s' s (x:xs) i
            | x == s = i
            | otherwise = s' s xs (i+1) 
        s' s [] i = -1 
            
insert value (BTree [] _) = (BTree [value] [])
insert value t@(BTree x y ) = if' (fst (search value t) == -1) (t) t

--search bis zu der Position wo es eingefügt werden sollte rekursiv
-- füge es ein, und beim rausgehen aus der rekursion gucken ob zu viele da sind und wenn nötig splitten
splitChild :: BTree -> Int -> BTree
splitChild root@(BTree x y) i = split' root (y !! i) 
    where
        split' (BTree x y) c@(BTree x1 y1) = (BTree (insertInRightPos x (middleValue x1)) (replace y c (BTree (take (t-1) x1) (take (t-1) y1)) (BTree (drop t x1) (drop t y1))))

middleValue :: [Int] -> Int
middleValue x =  x !! (t-1)

insertInRightPos :: [Int] -> Int -> [Int]
insertInRightPos x y = i' x y []
    where 
        i' (x:xs) y n
            | x < y = i' xs y (n ++ [x])
            | otherwise = n ++ [y,x] ++ xs
        i' [] y n = n ++ [y]
    
replace :: [BTree] -> BTree -> BTree -> BTree -> [BTree]
replace y c new1 new2 = replace' y c new1 new2 []
    where
        replace' (y:ys) c new1 new2 pre
            | y == c = pre ++ [new1,new2] ++ ys
            | otherwise = replace' ys c new1 new2 ( pre ++ [y])


testTree = BTree [23,55] [(BTree [5,6,13] []),(BTree [41] []),(BTree [60,72,91] [])]
emptyTree = BTree [] []