Let's write β

プログラミング中にできたことか、思ったこととか

PKU Common Subsequence

さき程のコードをつかって
PKU Common Subsequence
http://poj.org/problem?id=1458

(defun create-lcs-table (i j)
  (make-array `(,(1+ i) ,(1+ j))))

(defun last1 (sequence)
  (typecase sequence
    (string (aref sequence (1- (length sequence))))
    (list   (nth (1- (length sequence)) sequence))
    (vector (aref sequence (1- (length sequence))))))

(defun lcs-table (seq1 seq2)
  (let* ((i (length seq1))
	 (j (length seq2))
	 (lcs-table (create-lcs-table i j)))
    (loop for ci from 0 upto i
       do
	 (loop for cj from 0 upto j
	      do
	      (cond ((or (zerop ci) (zerop cj))
		     (setf (aref lcs-table ci cj) 0))
		    ((and (> ci 0) (> cj 0)
			  (equal (last1 (subseq seq1 0 ci))
				 (last1 (subseq seq2 0 cj))))
		     (setf (aref lcs-table ci cj)
			   (1+ (aref lcs-table (1- ci) (1- cj)))))
		    ((and (> ci 0) (> cj 0)
			  (not (equal (last1 (subseq seq1 0 ci))
				      (last1 (subseq seq2 0 cj)))))
		     (setf (aref lcs-table ci cj)
			   (max (aref lcs-table (1- ci) cj)
				(aref lcs-table ci (1- cj))))))))
    lcs-table))

(defun lcs-length (seq1 seq2)
  (let ((table (lcs-table seq1 seq2)))
    (aref table (length seq1) (length seq2))))

(defun read-two-strings ()
  (let ((line (read-line t nil)))
    (when (not (string= "" line))
      (multiple-value-bind (first pos)
	  (read-from-string line)
	`(,(string first)
	   ,(string (read-from-string (subseq line pos))))))))

(defun main ()
  (loop for two-str = (read-two-strings)
        for seq1 = (car two-str)
        for seq2 = (cadr two-str)
       while (and seq1 seq2)
       do
       (format t "~A~%" (lcs-length seq1 seq2))))