Comment detail

PageRankの計算 (Nested Flatten)
c-wrapper経由でGSLを呼んでみました。
CのAPIそのままなので冗長になってしまう感じですね。
実用的にはこの上に高レベルAPIをかぶせたGauche-gslみたいなのがあると良さそうです。

実行例 (横にはみ出ないように出力は整形してあります):
gosh> (pagerank '((1 . (2 3 4 5 7))
                  (2 . (1))
                  (3 . (1 2))
                  (4 . (2 3 5))
                  (5 . (1 3 4 6))
                  (6 . (1 5))
                  (7 . (5))))
#f64(0.30351437699680506 0.16613418530351437 0.14057507987220447
     0.10543130990415332 0.17891373801916935 0.04472843450479234
     0.06070287539936102)

要Gauche-0.8.11, GSL-1.9です。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
(use srfi-1)
(use srfi-42)
(use gauche.uvector)
(use gauche.sequence)
(use c-wrapper)

(c-load '("gsl/gsl_eigen.h" "gsl/gsl_complex_math.h") :libs "-lgslcblas -lgsl")

(define (pagerank data)
  (let* ([dim (apply max (map car data))]
         [dvec (make-f64vector (* dim dim))])
    (do-ec (: r data) (: j (cdr r))
           (set! (ref dvec (+ (* (- j 1) dim) (- (car r) 1))) (/. (length (cdr r)))))
    (let ([eval (gsl_vector_complex_alloc dim)]
          [evec (gsl_matrix_complex_alloc dim dim)]
          [ws   (gsl_eigen_nonsymmv_alloc dim)]
          [mat  (gsl_matrix_view_array dvec dim dim)])
      (gsl_eigen_nonsymmv (ptr (ref mat 'matrix)) eval evec ws)
      (gsl_eigen_nonsymmv_free ws)
      (let* ([maxevi (find-max (iota dim)
                               :key (lambda (k)
                                      (gsl_complex_abs
                                       (gsl_vector_complex_get eval k))))]
             [ev (map-to <f64vector>
                         (lambda (k)
                           (gsl_complex_abs
                            (gsl_vector_complex_get
                             (ptr (ref (gsl_matrix_complex_column evec maxevi) 'vector))
                             k)))
                         (iota dim))])
        (gsl_vector_complex_free eval)
        (gsl_matrix_complex_free evec)
        (f64vector-div ev (f64vector-dot ev (make-f64vector dim 1.0)))))))

Index

Feed

Other

Link

Pathtraq

loading...