root/lang/scheme/gauche/bindings/cabocha/trunk/test2.scm

;;;
;;; Test cabocha
;;;
;;;  2009.3.15 by naoya_t
;;;

(use gauche.test)
(use srfi-1)

(test-start "cabocha")
(use cabocha)
(test-module 'cabocha)

(define c (cabocha-new))
(test* "cabocha?" #t (cabocha? c))
;(test* "cabocha-destroyed?" #f (cabocha-destroyed? c))
;;

(define (cabocha-chunk-desc ch)
  (format "link:~d head:~d func:~d token-size:~d token-pos:~d score:~d feature:~a"
                  (cabocha-chunk-link ch)
                  (cabocha-chunk-head-pos ch)
                  (cabocha-chunk-func-pos ch)
                  (cabocha-chunk-token-size ch)
                  (cabocha-chunk-token-pos ch)
                  (cabocha-chunk-score ch)
                  (cabocha-chunk-feature-list ch)
;                 (cabocha-chunk-feature-list-size ch)
                  ))

(define (cabocha-token-desc tok)
  (format "surface:~a (~a) feature:~a feature-list:~a ne:~a chunk:~a"
                  (cabocha-token-surface tok)
                  (cabocha-token-normalized-surface tok)
                  (cabocha-token-feature tok)
                  (cabocha-token-feature-list tok)
;                 (cabocha-token-feature-list-size tok)
                  (cabocha-token-ne tok)
;                 (cabocha-chunk-desc (cabocha-token-chunk tok))
                  (cabocha-token-chunk tok)
                  ))
(define (cabocha-token->lisp tok)
  `(token ;(format "surface:~a (~a) feature:~a feature-list:~a ne:~a chunk:~a"
;       ( ,(cabocha-token-surface tok) . ,(cabocha-token-normalized-surface tok) )
        ,(cabocha-token-normalized-surface tok)
        ;(cabocha-token-feature tok)
        ,(cabocha-token-feature-list tok)
;                 (cabocha-token-feature-list-size tok)
        ;(cabocha-token-ne tok)
;                 (cabocha-chunk-desc (cabocha-token-chunk tok))
        ;(cabocha-token-chunk tok)
        ))

(define (vector-range vec from size)
  (let1 vec* (make-vector size)
        (dotimes (i size)
          (vector-set! vec* i (vector-ref vec (+ from i))))
        vec*))

(define (cabocha-chunk->lisp i ch tokens)
  (let* ([token-pos (cabocha-chunk-token-pos ch)]
                 [token-size (cabocha-chunk-token-size ch)]
                 [tokens-in-chunk (vector-range tokens token-pos token-size)]
                 [token-head-pos (cabocha-chunk-head-pos ch)]
                 [token-func-pos (cabocha-chunk-func-pos ch)]
                )
        `(chunk ;(format "link:~d head:~d func:~d token-size:~d token-pos:~d score:~d feature:~a"
          ,i
          ,(cabocha-chunk-link ch)
;         ,(map token-surface (vector->list tokens-in-chunk))
;         (head ,(token-surface (vector-ref tokens-in-chunk token-head-pos)))
;         (func ,(token-surface (vector-ref tokens-in-chunk token-func-pos)))
          ,tokens-in-chunk
          ,token-head-pos
          ,token-func-pos
;         ,token-size
;         ,token-pos
          ,(cabocha-chunk-score ch)
;         ,(cabocha-chunk-feature-list ch)
;                 (cabocha-chunk-feature-list-size ch)
          )))
(define (pp-chunk chunk)
;  (print " % " chunk)
  (let1 tokens-in-chunk (fourth chunk)
        (format #t "~d) => ~d ~a // head=~a func=~a score:~a\n"
                        (second chunk)
                        (third chunk)
                        (map token-surface (vector->list tokens-in-chunk))
                        (token-surface (vector-ref tokens-in-chunk (fifth chunk)))
                        (token-surface (vector-ref tokens-in-chunk (sixth chunk)))
                        (seventh chunk) )))

(define (token-surface token) (cadr token))

#|
(define (cabocha-tree-chunk-list t)
  (let loop ([i (- (cabocha-tree-chunk-size t) 1)] [lis '()])
        (if (< i 0) lis
                (loop (- i 1)
                          (cons (cabocha-chunk->lisp i (cabocha-tree-chunk t i)) lis) ))))

(define (cabocha-tree-token-list t)
  (let loop ([i (- (cabocha-tree-token-size t) 1)] [lis '()])
        (if (< i 0) lis
                (loop (- i 1)
                          (cons (cabocha-token->lisp (cabocha-tree-token t i)) lis) ))))
|#

(define (cabocha-tree-chunks t)
  (let* ([tokens (cabocha-tree-tokens t)]
                 [chunk-size (cabocha-tree-chunk-size t)]
                 [vec (make-vector chunk-size)])
        (dotimes (i chunk-size)
          (vector-set! vec i (cabocha-chunk->lisp i (cabocha-tree-chunk t i) tokens) ))
        vec))

(define (cabocha-tree-tokens t)
  (let* ([token-size (cabocha-tree-token-size t)]
                 [vec (make-vector token-size)])
        (dotimes (i token-size)
          (vector-set! vec i (cabocha-token->lisp (cabocha-tree-token t i)) ))
        vec))

(define (cparse sentence)
  (let* ([s (string-append sentence "。")]
                 [tree (cabocha-sparse-totree c s)]
                 )
        (format #t "\n「~a」\n" s)

;       (cabocha-tree-dump tree)
        (let* ([token-size (cabocha-tree-token-size tree)]
                   [chunk-size (cabocha-tree-chunk-size tree)]
                   [chunks (cabocha-tree-chunks tree)]
                   )
          (format #t "token size: ~d, " token-size)
          (format #t "chunk size: ~d\n" chunk-size)
          (dotimes (i chunk-size)
                (pp-chunk (vector-ref chunks i)))
          )))
                                                                                ;                               (format #t " - ~s\n" (cabocha-tree-sentence tree))
                                                                                ;                         (display (cabocha-sparse-tostr c s)))

(load "sentences.scm")
(for-each cparse sentences)

;;
(cabocha-destroy c)
;(test* "cabocha-destroyed?" #t (cabocha-destroyed? c))
(test-end)