project euler problem 18

下から上がっていった方が楽。

(define (f seq)
  (define (iter result rest)
    (match rest
           ((a b . _) (iter (cons (cons a b) result) (cdr rest)))
           (_  (reverse result))))
  (iter '() seq))

(f '(1 2 3)) ;;=> ((1 . 2) (2 . 3))

(define (g seq1 seq2)
  (let ((fs (f seq1)))
    ;;(= (length fs) (length seq2))))
    (map (lambda (xs)
           (match xs ((item (x . y)) (+ item (max x y)))))
         (zip seq2 fs))))

;(g '(3 4 5 6) '(1 2 3)) ;;=> (5 7 9)

(define (h t)
  (let1 rt (reverse! t)
        (fold (lambda (above below) (g below above)) (car rt) (cdr rt))))
(h t)

追記

ocamlでも同じようなことをするコードを書いてみた。

let t =
  [[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 tail (_::t) = t;;
let head (t::_) = t;;

let f seq =
  let rec iter result rest =
    match rest with
	a :: b :: _ ->   iter ((a, b) :: result) (tail rest)
      | _ -> List.rev result
  in iter [] seq;;

f [1;2;3] ;;   (* - : (int * int) list = [(1, 2); (2, 3)]       *)
      
let g seq1 seq2 =
  let fs1 = f seq1 in
    List.map (fun xs ->
		match xs with
		    (item, (x, y)) -> (max x y) + item)
      (List.combine seq2 fs1);;

g [4;5;6;7] [1;2;3] ;;   (* - : int list = [6; 8; 10] *)

let h t = 
  let rt = List.rev t in
    List.fold_left g (head rt) (tail rt);;