Longest Increasing Subsequence

最近「Longest Increasing Subsequence」という問題を知りました。問題の内容は、

　自然数からなるランダムな数列の中から最長の増加部分列（Longest Increasing Subsequence）を探す

という単純なものでグラフ問題の一種だそうです（http://en.wikipedia.org/wiki/Longest_increasing_subsequence_problem）。例えば、次の数列が与えられた場合、

  1 23 14 43 80 42 16 46 58 36

その最長増加部分列は、

  1 14 16 46 58

となります。

今回、この問題を解くプログラムをLongest Increasing Subsequence - Algorithmistで公開されているC++実装を元にScheme（Gauche）で書き直してみました。おそらく冗長で非効率な記述が多々あると思うので、どなたか添削していただけると幸甚です。

(use gauche.sequence)

(define (size-of vec) (vector-length vec))

(define (tail-of vec)
  (ref vec (- (size-of vec) 1)))

(define (push vec . obj)
  (list->vector (append (vector->list vec) obj)))

(define (update vec index obj)
  (begin
    (set! (ref vec index) obj)
    vec))

(define (backtrace v1 v2 v3)
  (let loop ((i (- (size-of v2) 1))
	     (j (tail-of v2))
	     (result (list (ref v1 (tail-of v2)))))
    (if (= i 0)
	result
	(let ((k (ref v3 j)))
	  (loop (- i 1) k (cons (ref v1 k) result))))))

(define (loop i v1 v2 v3)
  (let ((j (tail-of v2)))
    (cond ((>= i (size-of v1))
	   (backtrace v1 v2 v3))
	  ((< (ref v1 j) (ref v1 i))
	   (loop (+ i 1) v1 (push v2 i) (update v3 i j)))
	  (else
	   (letrec ((finder
		     (lambda (u v)
		       (let ((c (floor (/ (+ u v) 2))))
			 (cond ((>= u v)
				(if (and (= u v) (< (ref v1 i) (ref v1 (ref v2 u))))
				    (loop (+ i 1) v1 (update v2 u i)
					  (if (> u 0)
					      (update v3 i (ref v2 (- u 1)))
					      v3))
				    (loop (+ i 1) v1 v2 v3)))
			       ((< (ref v1 (ref v2 c)) (ref v1 i))
				(finder (+ c 1) v))
			       (else (finder u c)))))))
	     (finder 0 (- (size-of v2) 1)))))))

;; l.i.s = longest increasing subsequence
(define (find-lis seq)
  (let ((v (list->vector seq)))
    (loop 1 v (vector 0) (make-vector (size-of v)))))

(define (random-number min max)
  (+ (modulo (sys-random) (+ max 1)) min))

(define (make-random-sequence n)
  (let loop ((i 0) (seq '()))
    (if (= i n)
	seq
	(loop (+ i 1) (cons (random-number 1 100) seq)))))

(define (try-to-find-lis n) 
  (begin
    (sys-srandom (sys-time))
    (let ((seq (make-random-sequence n)))
      (format #t "~a \n~a \n" seq (find-lis seq)))))

(define (main args)
  (if (null? (cdr args))
      (try-to-find-lis 100)
      (try-to-find-lis (string->number (cadr args)))))