;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this software; see the file COPYING.  If not, write to
;; the Free Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111, USA.
;;
;; As a special exception, the Free Software Foundation gives permission
;; for additional uses of the text contained in its release of SCM.
;;
;; The exception is that, if you link the SCM library with other files
;; to produce an executable, this does not by itself cause the
;; resulting executable to be covered by the GNU General Public License.
;; Your use of that executable is in no way restricted on account of
;; linking the SCM library code into it.
;;
;; This exception does not however invalidate any other reasons why
;; the executable file might be covered by the GNU General Public License.
;;
;; This exception applies only to the code released by the
;; Free Software Foundation under the name SCM.  If you copy
;; code from other Free Software Foundation releases into a copy of
;; SCM, as the General Public License permits, the exception does
;; not apply to the code that you add in this way.  To avoid misleading
;; anyone as to the status of such modified files, you must delete
;; this exception notice from them.
;;
;; If you write modifications of your own for SCM, it is your choice
;; whether to permit this exception to apply to your modifications.
;; If you do not wish that, delete this exception notice.

;;;; Linear-space O(PN) sequence comparison.
;;; "Idiffer.scm" Top-level sequence-comparison functions.
;;; Author: Aubrey Jaffer

(define (diff:invert-edits! edits)
  (define cost (car (array-dimensions edits)))
  (do ((idx (+ -1 cost) (+ -1 idx)))
      ((negative? idx))
    (array-set! edits (- (array-ref edits idx)) idx)))

(define (edits2lcs! lcs edits A)
  (define cost (car (array-dimensions edits)))
  (define len-a (car (array-dimensions A)))
  (let loop ((edx 0)
	     (sdx 0)
	     (adx 0))
    (let ((edit (if (< edx cost) (array-ref edits edx) 0)))
      (cond ((>= adx len-a))
	    ((positive? edit)
	     (loop (+ 1 edx) sdx adx))
	    ((zero? edit)
	     (array-set! lcs (array-ref A adx) sdx)
	     (loop edx (+ 1 sdx) (+ 1 adx)))
	    ((>= adx (- -1 edit))
	     (loop (+ 1 edx) sdx (+ 1 adx)))
	    (else
	     (array-set! lcs (array-ref A adx) sdx)
	     (loop edx (+ 1 sdx) (+ 1 adx)))))))

(define (diff:longest-common-subsequence A B . p-lim)
  (define M (car (array-dimensions A)))
  (define N (car (array-dimensions B)))
  (set! p-lim (if (null? p-lim) -1 (car p-lim)))
  (let ((edits (if (< N M)
		   (diff:edits B A p-lim)
		   (diff:edits A B p-lim))))
    (and edits
	 (let* ((cost (car (array-dimensions edits)))
		(lcs (make-array A (/ (- (+ N M) cost) 2))))
	   (edits2lcs! lcs edits (if (< N M) B A))
	   lcs))))

(define (diff:edits A B . p-lim)
  (define M (car (array-dimensions A)))
  (define N (car (array-dimensions B)))
  (define est (diff:edit-length A B (if (null? p-lim) -1 (car p-lim))))
  (and est
       (let ((CCRR (make-array (A:fixZ32b) (* 2 (+ (max M N) 1))))
	     (edits (make-array (A:fixZ32b) est)))
	 (define fp (make-array (A:fixZ32b)
				(+ (max (- N (quotient M 2))
					(- M (quotient N 2)))
				   (- est (abs (- N M))) ; 2 * p-lim
				   3)))
	 (cond ((< N M)
		(diff2edits! edits fp CCRR B A)
		(diff:invert-edits! edits))
	       (else
		(diff2edits! edits fp CCRR A B)))
	 edits)))

(define (diff:edit-length A B . p-lim)
  (define M (car (array-dimensions A)))
  (define N (car (array-dimensions B)))
  (set! p-lim (if (null? p-lim) -1 (car p-lim)))
  (let ((fp (make-array (A:fixZ32b) (if (negative? p-lim)
					(+ 3 M N)
					(+ 3 (abs (- N M)) p-lim p-lim)))))
    (if (< N M)
	(diff2editlen fp B A p-lim)
	(diff2editlen fp A B p-lim))))