データベース検索エンジン

youtube データベース検索の話の続きです。

当初は

(and (and "wa" "bi") (not "wasabi"))

のように、タイトルもしくはコメントを対象として検索式を組む仕様だったんですが、より自在な検索ができるよう、DB レコードのフィールド名を明示的に指定して検索する方式に変更することにしました。

例えばこんな感じです:

(and (user "somebody")
     (or (title (and (and "wa" "bi") (not "wasabi")))
         (desc (and (and "wa" "bi") (not "wasabi")))))

あるいは、これだと式が煩雑になり過ぎるきらいがあるので、次のように省略形式で記述できるようにもしたいです:

(and (user "somebody")
     ((title desc)
      (and (and "wa" "bi") (not "wasabi"))))

参考までに、データは以下の形式でファイルに書き込んであり、

(U2Os-ypN0Uw
 (title . "ホントのじぶん/Buono!")
 (user . "3u10")
 (desc . "もうすぐ６歳になる娘が突然「私アイドルになるから」と言い出して・・・只今、自宅でなりきり練習中！")
 (date . "March 10, 2008"))

次の (load-db)

(define-values (load-db save-db init-db)
  (let ((db #f))
    (define (init-db) (set! db (hash)))
    (define (load-db)
      (or db
          (begin
            (init-db)
            (when (file-exists? db-file)
              (with-input-from-file db-file
                (lambda ()
                  (port-for-each (lambda (data)
                                   (db (car data) (cdr data)))
                                 read))))
            db)))
    ...
    (values load-db save-db init-db)))

によってハッシュ表にロードされます (このように多値を使うのはローカル変数を共有する関数を定義する時の Scheme 的流儀です)。

DB 検索の仕組みについてですが、ユーザーが入力した検索式を Scheme 関数に変換し、それを次の filter-db 関数に渡すことで行います。

(define (iter-db-if p? f)
  (hash-for-each (load-db)
                 (lambda (k v)
                   (if (p? v) (f k v)))))

(define (find-db p?)
  (let/ec return
    (iter-db-if p? return)
    (values #f #f)))

(define (filter-db p?)
  (let ((vids '()))
    (iter-db-if p?
                (lambda (k v)
                  (set! vids (cons k vids))))
    vids))  ; list of video ids

次に検索式を関数に変換する仕組みです。ここから話がややこしくなります。

まず、検索式を Scheme 関数に変換する関数を返す関数を新たに定義しました:

(define (q:compiler-maker string->regexp)
  (define (qhead? x)
    (let ((qhead (car x)))
      (and (or (symbol? qhead) (complex? qhead))
           qhead)))
  (define (complex? x)
    (and (pair? x) (andmap symbol? x)))
  (define (qhead=? x)
    (lambda (y)
      (and (symbol? y)
           (string-ci=? (symbol->string x) (symbol->string y)))))
  (define and? (qhead=? 'and))
  (define or?  (qhead=? 'or))
  (define not? (qhead=? 'not))
  (define rxp?
    (fun byte-regexp? byte-pregexp? regexp? pregexp?))
  (define (compile query)
    (cond ((rxp? query)
           (lambda (k) (k query)))
          ((string? query)
           (compile (string->regexp query)))
          ((pair? query)
           (cond
            ((qhead? query)
             => (lambda (qhead)
                  (cond
                   ((and? qhead)
                    (let ((procs (map compile (cdr query))))
                      (lambda (x)
                        (andmap (lambda (proc) (proc x))
                                procs))))
                   ((or? qhead)
                    (let ((procs (map compile (cdr query))))
                      (lambda (x)
                        (ormap (lambda (proc) (proc x))
                               procs))))
                   ((not? qhead)     ; unary operator
                    (complement (compile (cadr query))))
                   ;; Symbols other than (and or not)
                   ((complex? qhead) ; ((desc title) query-expr)
                    (let ((proc (compile (cdr query))))
                      (lambda (data)
                        (proc
                         (lambda (rx)
                           (ormap (lambda (key)
                                    (cond
                                     ((lookup key data)
                                      => (lambda (val)
                                           (regexp-match rx val)))
                                     (else #f)))
                                  qhead))))))
                   (else
                    (let ((proc (compile (cdr query))))
                      (lambda (data)
                        (proc
                         (lambda (rx)
                           (cond ((lookup qhead data)
                                  => (lambda (val)
                                       (regexp-match rx val)))
                                 (else #f))))))))))
            ((single? query)
             (compile (car query)))
            (else
             (compile (cons 'and query)))))
          (else
           (compile (format "~a" query)))))
  (lambda (query)
    (if (eq? query 'done)
        (string->regexp 'done)  ; to call migemo_close()
        (compile query))))

前回長ったらしかった youtube-search/db 関数がさらに長くなったため、分離して別関数としたものです。

最大のポイントは、正規表現型のオブジェクトを、継続渡しで自分自身を返す関数に変換しているところです:

(cond ((rxp? query)
       (lambda (k) (k query))

これは、前回

(lambda (data)
  (or (regexp-match query (lookup 'title data))
      (regexp-match query (lookup 'desc data))))

と変換していた部分です。

'title や 'desc の部分をユーザーが指定できるようにするための変更なんですが、この「継続渡し」にたどり着くまでにはもの凄く頭を使いました。

ここで、再び冒頭の検索式に立ち返ってみましょう:

((title desc)
 (and (and "wa" "bi") (not "wasabi")))

この式を組んだユーザーの意図は何でしょうか？

(and (and "wa" "bi") (not "wasabi")) の式を title と desc の両方にまたがって適用したい、ということではないでしょうか。

即ち、

((title . "wabi to sabi")
 (desc . "wasabi to wabi sabi"))

という項目があったとき、マッチに失敗してほしいはずなんです。

なぜなら、title に関してはマッチが成立していますが、desc は "wasabi" を含んでいるため (not "wasabi") の条件に反しているからです。

ところが、上式を安直に次のように展開してコンパイルしてしまうと、title でのマッチが成立してしまい、全体の結果が真になってしまうんですよね。

(or (title (and (and "wa" "bi") (not "wasabi")))
    (desc (and (and "wa" "bi") (not "wasabi"))))

また、別の例ですが、

((title . "wa") (desc . "bi"))

という項目があったとき、ユーザーとしてはフィールドをまたいでマッチに成功してほしいところでしょう。が、上のような式展開では明らかに失敗になってしまいます。

これらの問題点を踏まえると、件の検索式は次のように展開されるのが望ましいわけです:

(and
  (and (or (title "wa") (desc "wa"))
       (or (title "bi") (desc "bi")))
  (not (or (title "wasabi") (desc "wasabi"))))

or の位置が外側に一つだけだったのは間違いで、こんな風に内側に分散して置かなければならない、ということです。難しそうでしょう？

そして、これを実現するために (何故か) 継続渡しが必要だったんです。

詳しくは q:compiler-maker 関数の (and? qhead) と (complex? qhead) の節を参照してください。

ということで、youtube-search/db 関数はこのように短くなりました:

(define youtube-search/db
  (let ((c #f))
    (lambda (query)
      (unless c
        (set! c (q:compiler-maker
                 ((dynamic-require "migemo.ss" 'migemo)))))
      (cond ((c query) => filter-db)
            (else (set! c #f))))))

(c query) によって関数化された検索式が filter-db に渡されている流れがお分かりかと思います。検索式の代わりに 'done というシンボルを渡すと migemo オブジェクトを開放して false を返す仕様になっています。

また、検索だけでなく、スパム・フィルター的な感じで動画を無視する述語関数も

(define ignore-video?
  (cond (((read-conf dot-conf) 'ignore)
         => (q:compiler-maker
             (lambda (x)
               (pregexp (format "(?i:~a)" x)))))
        (else (constantly #f))))

のようにして定義できます。こちらは検索式を設定ファイルから読み込むという方式です。