Project Euler: Problem 18

scheme euler

By starting at the top of the triangle below and moving to adjacent numbers on the row below, the maximum total from top to bottom is 23.

    3
   7 5
  2 4 6
 8 5 9 3

That is, 3 + 7 + 4 + 9 = 23.

Find the maximum total from top to bottom of the triangle below:

                       75
                     95 64
                   17 47 82
                  18 35 87 10
                20 04 82 47 65
               19 01 23 75 03 34
             88 02 77 73 07 63 67
            99 65 04 28 06 16 70 92
          41 41 26 56 83 40 80 70 33
         41 48 72 33 47 32 37 16 94 29
       53 71 44 65 25 43 91 52 97 51 14
      70 11 33 28 77 73 17 78 39 68 17 57
    91 71 52 38 17 14 91 43 58 50 27 29 48
   63 66 04 68 89 53 67 30 73 16 69 87 40 31
 04 62 98 27 23 09 70 98 73 93 38 53 60 04 23

NOTE: As there are only 16384 routes, it is possible to solve this problem by trying every route. However, Problem 67, is the same challenge with a triangle containing one-hundred rows; it cannot be solved by brute force, and requires a clever method! ;o)

http://projecteuler.net/index.php?section=problems&id=18

数字でできたピラミッドを上から下まで巡って、通った数字の合計値のうち最大のものを求めよ。

Gauche で書いてみた。木を作って上から下に総当たり。あたまわるい。

#!/usr/bin/env gosh

(use srfi-1)
(use util.queue)

(define-class <node> ()
              [(value :init-keyword :value :init-value #f)
               (nodes :init-keyword :nodes :init-value '())])

(define-method insert! ((self <node>) (other <node>))
               (slot-set! self 'nodes (cons other (slot-ref self 'nodes))))

(define-method child-ref ((self <node>) id)
               (let ((nl (length (slot-ref self 'nodes))))
                 (if (or (<  id 0)
                         (<= nl id))
                   (error "index out of range")
                   (list-ref (slot-ref self 'nodes) (- nl id 1)))))

(define-method children-of ((self <node>))
               (reverse (slot-ref self 'nodes)))

(define-method children-count ((self <node>))
               (length (slot-ref self 'nodes)))

(define-method length ((self <node>))
               (let loop ((node self)
                          (nlen 1))
                 (if (and (equal? (class-of node) <node>)
                          (< 0 (children-count node)))
                   (loop (child-ref node 0) (+ 1 nlen))
                   nlen)))

(define-method traverse ((self <node>))
               (let ((zero  (make <node> :value 0))
                     (depth (length self)))
                 (let loop ((que (list->queue `((,self))))
                            (res '()))
                   (if (not (queue-empty? que))
                     (let1 line (dequeue! que)
                       (if (zero? (children-count (car line)))
                         (loop que
                               (cons line res))
                         (begin
                           (for-each (cut enqueue! que <>)
                                     (let1 next (map (cut cons <> line)
                                                     (children-of (car line)))
                                       next ; TODO: フィルタかまして枝を刈る
                                       ))
                           (loop que res))))
                     res))))

(define (main args)
  (define pyramid (map (lambda (str)
                         (map string->number
                              (string-split str char-whitespace?)))
                       (list
"75"
"95 64"
"17 47 82"
"18 35 87 10"
"20 04 82 47 65"
"19 01 23 75 03 34"
"88 02 77 73 07 63 67"
"99 65 04 28 06 16 70 92"
"41 41 26 56 83 40 80 70 33"
"41 48 72 33 47 32 37 16 94 29"
"53 71 44 65 25 43 91 52 97 51 14"
"70 11 33 28 77 73 17 78 39 68 17 57"
"91 71 52 38 17 14 91 43 58 50 27 29 48"
"63 66 04 68 89 53 67 30 73 16 69 87 40 31"
"04 62 98 27 23 09 70 98 73 93 38 53 60 04 23"
  )))

  (let ((root (make <node> :value (caar pyramid))))
    (let loop ((plis (list root))
               (rest (cdr pyramid)))
      (if (pair? rest)
        (let ((clis (map (cut make <node> :value <>)
                         (car rest))))
          (for-each (lambda (p clis)
                      (for-each (cut insert! p <>) clis)) ; 子ノードの追加
                    plis
                    (zip clis (cdr clis))) ; 子ノードを 2 つ取り出す

          (loop clis (cdr rest))
        )
        (print (apply max
                      (map (lambda (line) (fold + 0
                                                  (map (cut slot-ref <> 'value) line)))
                           (traverse root)))))))

  0)

どうやら Problem 67 も入力値は違えども同様の問題らしいので気合いを入れようかと思ったけど、結局のところ普通に総当たりで解いたところで終わってしまっている。

途中で良い感じに枝を刈っていけばもっと速くなることが見込めると思うけど実装できてない。Gauche のクラスを使ってみたけど、オブジェクトの定義は Problem 67 までに見直したほうが良いかも知れない。