Problem 79(2) - グラフ理論へ

の続きです。ちょっと考え方を変えて、グラフ理論で解いていこうかと。

最初の4つのデータで考えてみます。

キー情報を、経路問題と捕らえることにして、問題を解いていけばいいんじゃないかと。

まずは、最初の319,680

3 > 1 > 9

6 > 8 > 0

まだよくわかりません。

180が来ました。

3 > 1 > 9
    V
6 > 8 > 0

ここで経路情報(グラフ)と捕らえれば、間を表現できます。

3から1に行けます。
1からは、8と9に行けます。

その次に、690が来るので、

3 > 1 > 9
    V   V
6 > 8 > 0
V
9へ

この時点で、6の位置は確定出来ていないことがわかる。

経路は段々複雑化していきますが、セキュリティキーを経路情報と捉えれば、人間的な思考を取り入れる事が可能になるかと思います。

一番長い経路を辿れば、問題が解けることになりそうです。

ということで、経路情報の割り出しです。

(define *log* '(319 680 180 690 129 620 762 689 762 318 368 710 720 710 629 168 160
                689 716 731 736 729 316 729 729 710 769 290 719 680 318 389 162 289
                162 718 729 319 790 680 890 362 319 760 316 729 380 319 728 716))

(define (number->list n . base)
  (letrec ((b (if (null? base) 10 (car base)))
           (iter (lambda (acc n)
                   (let ((q (quotient n b))
                         (m (cons (modulo n b) acc)))
                        (if (zero? q)
                            m
                            (iter m q))))))
          (iter '() n)))


(define (problem79 data)
  (letrec
    ((flatmap (lambda (proc s)
                (apply append (map proc s))))
     (make-path (lambda (data)
                  (flatmap (lambda (x)
                             (map cons x (cdr x)))
                           data)))
     (adjoin-node (lambda (to from node)
                    (cond ((null? node) (list (list to from)))
                          ((eq? (caar node) to) (cons (cons (caar node)
                                                            (lset-adjoin eq? (cdar node) from))
                                                      (cdr node)))
                          (else
                            (cons (car node)
                                  (adjoin-node to from (cdr node)))))))
     (make-node (lambda (path)
                  (fold (lambda (p acc)
                          (adjoin-node (car p) (cdr p) acc))
                        '() path))))

    (make-node (make-path data))))

(problem79 (map number->list '(319 680 180 690)))
; ((3 1) (1 8 9) (6 9 8) (8 0) (9 0))

(problem79 (map number->list *log*))
; ((3 8 6 1) (1 6 0 2 8 9) (6 0 2 9 8) (8 9 0) (9 0) (2 8 0 9) (7 9 3 2 1 6))

adjoin-nodeはハッシュでもいいと思うんですが、リストのほうが可視化しやすいので。

グラフが出来たので、問題は最長経路をどう取るのかに絞られました。

さて、どうやって解くかな・・・。

最長経路

さて、真面目に最長経路問題を解くとひどい目に会いそうなので、ルールを絞り込みます。

先頭はいろいろ経路が出ていて大変そうですが、末尾は何処にも行く先が無い。つまり、経路が無い。

例えば、

A > B > C > Dへ
V   V
D > E

となっていたら、Eには経路が無い。Eに続く経路を除く。

A > B > C > Dへ
V
D

Dには経路が無いので、Dに続く経路を除く

A > B > C

末尾に繋がっている経路を除くと、また末尾が出てくる。気持ちいい。

全ての頂点を通る組合せは一種類しかないはずなので、末尾からどんどん経路を除いていけば答えが出るはずです。

有向グラフで、全ての頂点を通る経路(ハミルトン閉路)を探せばいい。

さて、最後がわからないので、

; ((3 8 6 1) (1 6 0 2 8 9) (6 0 2 9 8) (8 9 0) (9 0) (2 8 0 9) (7 9 3 2 1 6) (0))
                                                                              ↑追加

行く先も経路情報に加える事にすれば、経路が無いことがはっきりわかります。

ということで、コーディング。

(define (problem79 data)
  (letrec
    ((flatmap (lambda (proc s)
                (apply append (map proc s))))
     (make-path (lambda (data)
                  (flatmap (lambda (x)
                             (map cons x (cdr x)))
                           data)))
     (adjoin-node (lambda (to from node)
                    (cond ((null? node) (list (list to from)))
                          ((eq? (caar node) to) (cons (cons (caar node)
                                                            (lset-adjoin eq? (cdar node) from))
                                                      (cdr node)))
                          (else
                            (cons (car node)
                                  (adjoin-node to from (cdr node)))))))
     (make-node (lambda (path)
                  (fold (lambda (p acc)
                          (let* ((to (car p))
                                 (from (cdr p))
                                 (to-res (adjoin-node to from acc)))
                                (if (find (lambda (x) (eq? (car x) from)) to-res)
                                    to-res
                                    (cons (list from) to-res))))
                          '() path)))
    (all-node-path (lambda (node)
                     (if (null? node)
                         '()
                         (let ((alone (car (find (lambda (x) (= (length x) 1)) node))))
                              (cons alone
                                    (all-node-path
                                      (fold (lambda (x acc)
                                              (let ((res (delete alone x)))
                                                   (if (null? res)
                                                       acc
                                                       (cons res acc))))
                                            '() node))))))))
    (reverse (all-node-path (make-node (make-path data))))))

(time (problem79 (map number->list *log*))) ; (7 3 1 6 2 8 9 0)

解けました。

選択肢が複数あらわれたときのエラーチェックはしてません。、

複雑な経路情報がどんどんシンプルになっていく様子は凄く面白いっす。

グラフ理論もオイラー・・・凄いな。

追記

Spaghetti Source - トポロジカルソート

与えられたグラフ g の位相的順序を求めるアルゴリズムをトポロジカルソートという。

知らなかった。

追記2

うは。

% tsort
a b
c d
b c
a
b
c
d

orz