123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388 |
- ;; ==================
- ;; BOTTOM UP APPROACH
- ;; ==================
- ;; OK, lets try the constructive bottom up approach.
- (import
- (except (rnrs base) let-values map)
- (only (guile)
- lambda* λ
- ;; printing
- display
- simple-format
- ;; command line arguments
- command-line
- current-input-port
- current-output-port)
- (ice-9 textual-ports)
- (ice-9 match) ; let-match
- (ice-9 exceptions)
- (ice-9 pretty-print)
- (srfi srfi-1)
- ;; for functional structs (not part of srfi-9 directly)
- (srfi srfi-9 gnu)
- ;; hash tables
- (srfi srfi-69)
- (fileio)
- (list-helpers)
- (function-combinators))
- ;; =====
- ;; MODEL
- ;; =====
- (define make-inappropriate-value-exception
- (record-constructor
- (make-exception-type '&inappropriate-value
- &programming-error
- '(val))))
- (define-immutable-record-type <position>
- (construct-position row col)
- position?
- (row position-row set-position-row)
- (col position-col set-position-col))
- (define-immutable-record-type <path-element>
- (construct-path-element pos val)
- path-element?
- (pos path-element-pos set-path-element-pos)
- (val path-element-val set-path-element-val))
- (define-immutable-record-type <path>
- (construct-path elems sum)
- path?
- (elems path-elements set-path-element-elems)
- (sum path-sum set-path-element-sum))
- (define make-position
- (λ (row col)
- (cond
- [(not (integer? row))
- (raise-exception
- (make-exception
- (make-inappropriate-value-exception row)
- (make-exception-with-message "row must be a positive integer")
- (make-exception-with-irritants (list row))
- (make-exception-with-origin 'make-position)))]
- [(not (integer? col))
- (raise-exception
- (make-exception
- (make-inappropriate-value-exception col)
- (make-exception-with-message "col must be a positive integer")
- (make-exception-with-irritants (list col))
- (make-exception-with-origin 'make-position)))]
- [else
- (construct-position row col)])))
- (define position=?
- (λ (p1 p2)
- (and (= (position-row p1) (position-row p2))
- (= (position-col p1) (position-col p2)))))
- (define make-path-element
- (λ (pos val)
- (cond
- [(not (position? pos))
- (raise-exception
- (make-exception
- (make-inappropriate-value-exception pos)
- (make-exception-with-message "pos must be a <position>")
- (make-exception-with-irritants (list pos))
- (make-exception-with-origin 'make-path-element)))]
- [else
- (construct-path-element pos val)])))
- (define make-path
- (λ (elems sum)
- (construct-path elems sum)))
- (define make-empty-path
- (λ ()
- (make-path '() 0)))
- (define path-prepend
- (λ (path elem)
- (make-path (cons elem (path-elements path))
- (+ (path-sum path)
- (path-element-val elem)))))
- ;; navigating
- (define go-up-left
- (λ (pos)
- (make-position (- (position-row pos) 1)
- (- (position-col pos) 1))))
- (define go-up
- (λ (pos)
- (make-position (- (position-row pos) 1)
- (position-col pos))))
- ;; triangle abstraction
- (define triangle-dimensions
- (λ (triangle)
- (array-dimensions triangle)))
- (define in-triangle?
- (λ (triangle pos)
- (match-let ([(height width) (triangle-dimensions triangle)]
- [row (position-row pos)]
- [col (position-col pos)])
- (and (< row height)
- (< col width)
- (<= col row)
- (>= col 0)
- (>= row 0)))))
- (define triangle-ref
- (λ (triangle pos)
- (array-ref triangle
- (position-row pos)
- (position-col pos))))
- (define triangle-height
- (λ (triangle)
- (match-let ([(height _) (triangle-dimensions triangle)])
- height)))
- (define triangle-width
- (λ (triangle)
- (match-let ([(_ width) (triangle-dimensions triangle)])
- width)))
- (define triangle-up-element
- (λ (triangle pos)
- (let* ([element-pos (make-position (- (position-row pos) 1) (position-col pos))]
- [element-val (triangle-ref triangle element-pos)])
- (make-path-element element-pos element-val))))
- (define triangle-up-left-element
- (λ (triangle pos)
- (let* ([element-pos
- (make-position (- (position-row pos) 1)
- (- (position-col pos) 1))]
- [element-val
- (triangle-ref triangle element-pos)])
- (make-path-element element-pos element-val))))
- ;; =========
- ;; ALGORITHM
- ;; =========
- (define max-parent-element
- (λ (triangle pos)
- ;; Problem: cannot go up left for example, from col 0.
- (let ([up-left-pos (go-up-left pos)]
- [up-pos (go-up pos)])
- (cond
- ;; If both positions should exist in the triangle, return the maximum
- ;; element.
- [(and (in-triangle? triangle up-left-pos)
- (in-triangle? triangle up-pos))
- (cond
- [(> (triangle-ref triangle up-left-pos)
- (triangle-ref triangle up-pos))
- (list
- (make-path-element up-pos (triangle-ref triangle up-left-pos)))]
- ;; If both elements are equal, we need to consider both paths
- ;; up the triangle, in order to not leave out any potentially
- ;; maximum path.
- [(= (triangle-ref triangle up-left-pos)
- (triangle-ref triangle up-pos))
- (list
- (make-path-element up-pos (triangle-ref triangle up-left-pos))
- (make-path-element up-left-pos (triangle-ref triangle up-pos)))]
- [else
- (list
- (make-path-element up-pos (triangle-ref triangle up-pos)))])]
- ;; Otherwise return the one that does exist.
- [(in-triangle? triangle up-left-pos)
- (list
- (make-path-element up-left-pos (triangle-ref triangle up-left-pos)))]
- [(in-triangle? triangle up-pos)
- (list
- (make-path-element up-pos (triangle-ref triangle up-pos)))]
- ;; Otherwise raise an exception.
- [else
- (raise-exception
- (make-exception
- (make-exception-with-message "unexpected error")
- (make-exception-with-irritants (list triangle pos))
- (make-exception-with-origin 'max-parent-element)))]))))
- (define parent-elements
- (λ (triangle pos)
- (let ([up-left-pos (go-up-left pos)]
- [up-pos (go-up pos)])
- (cond
- ;; If both positions should exist in the triangle, return the maximum
- ;; element.
- [(and (in-triangle? triangle up-left-pos)
- (in-triangle? triangle up-pos))
- (list
- (make-path-element up-pos (triangle-ref triangle up-pos))
- (make-path-element up-left-pos (triangle-ref triangle up-left-pos)))]
- ;; Otherwise return the one that does exist.
- [(in-triangle? triangle up-left-pos)
- (list
- (make-path-element up-left-pos (triangle-ref triangle up-left-pos)))]
- [(in-triangle? triangle up-pos)
- (list
- (make-path-element up-pos (triangle-ref triangle up-pos)))]
- ;; Otherwise raise an exception.
- [else
- (raise-exception
- (make-exception
- (make-exception-with-message "unexpected error")
- (make-exception-with-irritants (list triangle pos))
- (make-exception-with-origin 'max-parent-element)))]))))
- (define triangle-base-paths
- (λ (triangle)
- (match-let ([(height width) (triangle-dimensions triangle)])
- (let ([base-row (- height 1)])
- (let iter ([col 0])
- (cond
- [(>= col width) '()]
- [else
- (let* ([pos (make-position base-row col)]
- [val (triangle-ref triangle pos)]
- [one-elem-path
- (path-prepend (make-empty-path) (make-path-element pos val))])
- (cons one-elem-path (iter (+ col 1))))]))))))
- (define reduce-paths
- (λ (paths)
- "Idea: If paths have the same top element, but different sums,
- then keep only the one with the maximum sum. If there are equal sums,
- keep only one of them."
- (let ([pos-to-max-path-table (make-hash-table position=?)])
- (for-each (λ (path)
- (let ([pos-key (path-element-pos (first (path-elements path)))])
- (hash-table-update!/default pos-to-max-path-table
- pos-key
- ;; Compare with the
- ;; old path.
- (λ (old-path)
- (if (> (path-sum path)
- (path-sum old-path))
- path
- old-path))
- ;; Set the current
- ;; path as the first
- ;; value for a
- ;; position in the
- ;; hash table.
- path)))
- paths)
- (hash-table-values pos-to-max-path-table))))
- (define expand-paths
- (λ (triangle paths)
- (flatten
- ;; For each path prepend parent elements to the path.
- (map (λ (path)
- (match-let ([(elem . others) (path-elements path)]
- [sum (path-sum path)])
- (let ([parents
- ;; There can be multiple maximum parents, if both
- ;; parents have the same value.
- (parent-elements triangle (path-element-pos elem))])
- ;; Prepend the maximum parent element(s) to the path.
- (map (λ (parent) (path-prepend path parent))
- parents))))
- paths))))
- (define find-max-sum-bottom-up
- (λ (triangle)
- (match-let ([(height width) (triangle-dimensions triangle)])
- ;; Iterate through the rows from bottom to top.
- (let iter ([current-row (- height 1)]
- [paths (triangle-base-paths triangle)])
- ;; The higher we get in the triangle, the thinner the triangle gets and
- ;; there are no more numbers on higher indices we need to look at.
- (let ([current-width (+ current-row 1)])
- (cond
- ;; If all rows have been looked at, we will know the maximum sum
- ;; path. In fact, there should only be one path left in the list of
- ;; paths.
- [(= current-row 0)
- (let iter-max ([remaining-paths (drop paths 1)]
- [max-path (first paths)])
- (cond
- [(null? remaining-paths) max-path]
- [else
- (let ([path (first remaining-paths)])
- (cond
- [(> (path-sum path)
- (path-sum max-path))
- (iter-max (drop remaining-paths 1) path)]
- [else
- (iter-max (drop remaining-paths 1) max-path)]))]))]
- ;; Otherwise go to the next column.
- [else
- ;; TODO: next idea: take all parents and implement reduce
- ;; for paths to keep paths from becoming too many.
- (let ([updated-paths (expand-paths triangle paths)])
- (iter (- current-row 1)
- updated-paths))]))))))
- ;; read in the data
- (define input-lines (get-lines-from-file (cadr (command-line))))
- (define input
- (let* ([as-list-of-lists
- (map (combine (λ (line) (string-split line (λ (c) (char=? c #\space))))
- (λ (num-strs) (map string->number num-strs)))
- input-lines)]
- [max-width
- (fold (λ (acc elem) (max elem acc))
- 0
- (map length as-list-of-lists))]
- [padded-list-of-lists
- (map (λ (lst) (list-right-pad lst max-width 0))
- as-list-of-lists)]
- [as-array
- (list->array '(0 0) padded-list-of-lists)])
- as-array))
- (display
- (simple-format
- #f "max sum (bottom-up): ~a\n"
- (find-max-sum-bottom-up input)))
|