赤黒木 (6) - yamanetoshi's diary

赤黒木 (5) に Shiro さんからフォロー頂いた。曰く

test/treemap.scm に(現在のGaucheの実装で)全てのパスを通過するようなテストケースがあります。元のRuiさんのrbtree.scmだと場合分けが違って全部のパスを通らないって可能性はありますが。全部のパスを通るテストケースを作るのに苦労した覚えはあります。

とのこと。これはこれは、と言いつつソース取得して云々。

$ wget http://prdownloads.sourceforge.net/gauche/Gauche-0.9.3.3.tgz

確かに test/treemap.scm なるソレがあるのですが中身を見てみるに tree-map なるソレの試験になってます。

;;
;; test for tree-map
;;

(use gauche.test)
(test-start "treemap")

ええと、lib/util/rbtree.scm はありますね。て中身を見てみたら以下なコメントが。

;; Red-black tree is now provided as a builtin <tree-map> object.
;; This module is for backward compatibility.

ほほう。つうことは src 配下にいらっしゃるのか、と言いつつ中を覗いてみたら treemap.c なるソレがありますね。
んーと、builtin にした、ってことは内部で赤黒木を使ってたりするのだろうか。

とりあえず

実装ではなくて試験を確認しないと、なんでした (汗
順に見てみます。ちょい体調がアレなのであまりがっつりアレできないかも。

;; The following test sequence is carefully assembled so that
;; it goes through every path in the rbtree manipulation routine.
;; The "case" numbers corresponds to BALANCE_CASE/DELETE_CASE macros
;; in treemap.c.

(let1 tree (make-tree-map = <)
  (define (i . args) (dolist (k args) (tree-map-put! tree k k)))
  (define (d . args) (dolist (k args) (tree-map-delete! tree k)))
  (define (c) (%tree-map-check-consistency tree))
  
  ;; Insertion
  ;;  case 0. adding to an empty tree
  ;;    B:0
  (test* "insertion case 0" #t (begin (i 0) (c)))

とりあえず %tree-map-check-consistency を確認。

$ find|xargs grep tree-map-check-consistency
./test/treemap.scm:           (%tree-map-check-consistency new)
./test/treemap.scm:  (define (c) (%tree-map-check-consistency tree))
./src/libdict.scm:(define-cproc %tree-map-check-consistency (tm::<tree-map>)
./src/libdict.c:      SCM_STRING_CONST_INITIALIZER("%tree-map-check-consistency", 27, 27),
./src/libdict.c:  SCM_ENTER_SUBR("%tree-map-check-consistency");
./src/libdict.c:  Scm_MakeBinding(SCM_MODULE(SCM_OBJ(Scm_GaucheModule())), SCM_SYMBOL(SCM_INTERN("%tree-map-check-consistency")), SCM_OBJ(&libdict_25tree_map_check_consistency__STUB), 0);
./lib/util/rbtree.scm:(define rbtree-check %tree-map-check-consistency)
$

ええと、src/libdict.c ですか。以下なあたりらしい。

static ScmObj libdict_25tree_map_check_consistency(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
{
  ScmObj tm_scm;
  ScmTreeMap* tm;
  ScmObj SCM_SUBRARGS[1];
  int SCM_i;
  SCM_ENTER_SUBR("%tree-map-check-consistency");
  for (SCM_i=0; SCM_i<1; SCM_i++) {
    SCM_SUBRARGS[SCM_i] = SCM_ARGREF(SCM_i);
  }
  tm_scm = SCM_SUBRARGS[0];
  if (!SCM_TREE_MAP_P(tm_scm)) Scm_Error("tree map required, but got %S", tm_scm);
  tm = SCM_TREE_MAP(tm_scm);
  {
{
ScmObj SCM_RESULT;

#line 281 "libdict.scm"
Scm_TreeCoreCheckConsistency(SCM_TREE_MAP_CORE(tm));

#line 282 "libdict.scm"
SCM_RESULT=(SCM_TRUE);
SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
}
  }
}

これって C の手続きが生成されてるんでしたっけ。とりあえず、Scm_TreeCoreCheckConsistency を探してみます。

$ find|xargs grep Scm_TreeCoreCheckConsistency
./src/gauche/treemap.h:SCM_EXTERN void          Scm_TreeCoreCheckConsistency(ScmTreeCore *tc);
./src/libdict.scm:  (Scm_TreeCoreCheckConsistency (SCM_TREE_MAP_CORE tm))
./src/libdict.c:Scm_TreeCoreCheckConsistency(SCM_TREE_MAP_CORE(tm));
./src/treemap.c:void Scm_TreeCoreCheckConsistency(ScmTreeCore *tc)
$

ええと、treemap.c に定義がありますね。

void Scm_TreeCoreCheckConsistency(ScmTreeCore *tc)
{
    Node *r = ROOT(tc);
    int cnt = 0;

    if (!BLACKP(r)) Scm_Error("[internal] tree map root node is not black.");
    if (r) check_traverse(r, 1, &cnt);
    if (cnt != tc->num_entries) {
        Scm_Error("[internal] tree map node count mismatch: record %d vs actual %d", tc->num_entries, cnt);
    }
}

む、これって Scm_Error にならん限りは true が戻る形なのかな。check_traverse は src/treemap.c に定義があるんですが、微妙に限界。
ええとメモベースで以下に列挙しときます。

node の数が count に
黒 node なら depth++ してますね。
ある場所から右と左を手繰って黒 node の数を比較してます
- マッチしない場合、Scm_Error 呼び出し
最後に左の黒 node の数を戻してます

駄目な場合はきっぱり Scm_Error してますね。つうかだんだん赤黒木じゃなくて Gauche のソース読みなリハビリになりつつあるんだけど、どうなるんだろw
今日はとりあえずクタバります。