bigsleepの日記

 | 

2013-03-23

23:07

日記

データベースファイルシステムなんかでB木を改良したB+木というのが使われているらしいです。

まずはB木を勉強しようということで調べたりコードを書いたりしました。

B木

  • 二分木ではない多分木。
  • 平衡木で、要素がソートされた状態に保持される。
  • 要素が複数まとまったページという構造を持つ。
  • n次のB木のページあたりの要素数はn以上2n以下。ただしルートは1以上2n以下。
  • ルートからリーフまでの深さが全て等しい。
  • ページは|子1|要素1|子2|要素2|子3|みたいな感じで、リーフでないk要素のページにはk+1の子ページにつながる辺がある。
  • 挿入とか削除とかが多分比較的速い。

挿入

ルートから比較していって挿入を試みるリーフページを探す。

挿入位置のリーフ要素数が2n以下ならそこに挿入して終わり。

素数2nのときは、統合分割して二つのページと、一つの要素を作って、親のページに挿入を試みる。

同じように繰り返してルートまで来たら木の深さが1増える。

削除

まだやってない。

コード

Haskellで書いてみました。

ページの型をどうするかとか、結構難しいような気がします。

単純にリストにしたけれど、要素の数や子の数は制限できてないので、挿入や削除のコードを間違うと変な状態ができてしまう場合がある。

あとB木のオーダーを表すのもどうしたものか、よくわかりません。

import Data.List (sort, break, splitAt, insert)
import Data.Foldable (Foldable, foldMap, toList)
import Data.Monoid (mempty, mappend)
import Data.Traversable (Traversable(..), traverse, fmapDefault, foldMapDefault, mapAccumL, mapAccumR)
import Control.Applicative ((<*>), pure)
import Data.Functor ((<$>), fmap)
import System.Random

data BTree o a = BTree o [a] (Maybe [BTree o a]) deriving (Show)

class BTreeOrder a where
    getOrder :: a -> Int

instance BTreeOrder Second where
    getOrder Second = 2

data Second = Second deriving (Show)

main = do writeFile "btree.dot" (drawBTree mytree)
    where
        gen = mkStdGen 1
        nums = (take 40 $ randomRs (1, 1000) gen) :: [Int]
        mytree = foldr Main.insert (BTree Second [] Nothing) nums

insert :: (Ord a, BTreeOrder o) =>  a -> BTree o a -> BTree o a
tryInsert :: (Ord a, BTreeOrder o) =>  a -> BTree o a -> Either (BTree o a) (a, BTree o a, BTree o a)

insert a (BTree o xs c) = f $ tryInsert a (BTree o xs c)
    where
        f (Left t) = t
        f (Right (m, l, r)) = BTree o [m] (Just [l, r])

tryInsert a (BTree o xs Nothing)
    | sz < order * 2 = Left $ BTree o ys Nothing
    | otherwise = Right (m, lt, rt)
    where
        order = getOrder o
        sz = length xs
        ys = Data.List.insert a xs
        (l, m : r) = splitAt order ys
        lt = BTree o l Nothing
        rt = BTree o r Nothing

tryInsert a (BTree o xs (Just ys)) = what $ tryInsert a mc
    where
        order = getOrder o
        p = length $ takeWhile (<= a) xs
        (lc, mc : rc) = splitAt p ys
        space = length xs < order * 2
        what (Left t) = Left $ BTree o xs (Just $ lc ++ (t : rc))
        what (Right (m, l, r))
            | space = Left $ BTree o nodes (Just children)
            | otherwise = Right (mid, lt, rt)
            where
                nodes = Data.List.insert m xs
                children = lc ++ (l : r : rc)
                mid = nodes !! order
                lt = BTree o (take order nodes) (Just $ take (order + 1) children)
                rt = BTree o (drop (order + 1) nodes) (Just $ drop (order + 1) children)



instance Functor (BTree o) where
    fmap = fmapDefault

instance Foldable (BTree o) where
    foldMap = foldMapDefault

instance Traversable (BTree o) where
    traverse f (BTree o [] Nothing) = pure $ BTree o [] Nothing
    traverse f (BTree o xs Nothing) = BTree o <$> traverse f xs <*> pure Nothing
    traverse f (BTree o xs (Just (y:ys))) = g <$> traverse f y <*> h (xs `zip` ys)
        where
            g t zs = BTree o a (Just $ t:b)
                where
                    (a, b) = unzip zs
            h zs = traverse k zs
                where
                    k (a, b) = (,) <$> f a <*> traverse f b

eachPage :: (Ord a, Show a, BTreeOrder o) => (BTree o a) -> [BTree o a]
drawBTree :: (Ord a, Show a, BTreeOrder o) => (BTree o a) -> String
drawBTree' :: (Ord a, Show a, BTreeOrder o) => (BTree o (a, Int)) -> String
drawDiGraph :: String -> String
drawBTreePage :: (Ord a, Show a, BTreeOrder o) => (BTree o (a, Int)) -> String
drawBTreeEdge :: (Ord a, Show a, BTreeOrder o) => (BTree o (a, Int)) -> String

eachPage (BTree o xs Nothing) = [(BTree o xs Nothing)]
eachPage (BTree o xs (Just ys)) = (BTree o xs (Just ys)) : (concatMap eachPage ys)

drawDiGraph s = "digraph {\n" ++ s ++ "}\n"

drawBTree bt = drawBTree' $ snd $ mapAccumL f 1 bt
    where f a b = (a + 1, (b, a))

drawBTree' bt = drawDiGraph $ nodes ++ edges
    where
        pages = eachPage bt
        nodes = concatMap drawBTreePage pages 
        edges = concatMap drawBTreeEdge pages

drawBTreePage (BTree o ((x, i):xs) _) =
    "p" ++ show i ++ "[shape=record," ++ zs ++ "|<n" ++ show k ++ ">\"];\n"
    where
        f (m, s) (a, j) = (m + 1, s ++ "|<n" ++ show m ++ ">|" ++ show a)
        (k, zs) = foldl f (2, "label=\"<n1>|" ++ show x) xs

drawBTreeEdge (BTree o ((x, i):xs) Nothing) = ""

drawBTreeEdge (BTree o ((x, i):xs) (Just ys)) = str
    where
        page = "p" ++ show i ++ ":n"
        f (k, s) (BTree _ ((y, j):_) _) = (k + 1, s ++ page ++ show k ++ " -> " ++ "p" ++ show j ++ ";\n")
        (sum, str) = foldl f (1, "") ys

できた木を図にしたかったので、graphvizにして出力する関数を書きました。

要素に番号を振りたかったので、Traversableのインスタンスにもして見ました。

でも必要だったのはページに番号を振ることだったので、なくてもよかったかも。

図は下のような感じになりました。

図にしてみて間違ってるのがわかってコードなおしたりに役立ったりもしました。

あとZipperにしてみたりもしたんですが、なんか間違ってそうなんでその辺はまた今度にします。

f:id:bigsleep:20130323231044p:image

トラックバック - http://d.hatena.ne.jp/bigsleep/20130323/1364047669
リンク元
 |