;;;; levenshtein-transpose-byte.scm -*- Scheme -*-
;;;; Kon Lovett, Mar '20
;;;; Kon Lovett, Apr '12
;;;; Kon Lovett, Sep '05

(module levenshtein-transpose-byte

(;export
  levenshtein-distance/transpose-byte)

(import scheme
	(chicken base)
	(chicken type)
	(chicken foreign)
	(chicken blob)
  (only type-errors-basic error-argument-type))

(define-type byte-sequence (or string blob))

(: levenshtein-distance/transpose-byte (byte-sequence byte-sequence -> fixnum))

(define (levenshtein-distance/transpose-byte s t)
	(unless (or (string? s) (blob? s))
		(error-argument-type 'levenshtein-distance/transpose-byte s "string or blob" "source") )
	(unless (or (string? t) (blob? t))
		(error-argument-type 'levenshtein-distance/transpose-byte t "string or blob" "target") )
  ((foreign-lambda* unsigned-int ((scheme-object os) (scheme-object ot)) #<<EOF

/* The purpose; otherwise use levenshtein-distance/byte */
#	define USE_TRANSPOSITION

/*
 From levenshtein.scm by Lorenzo Seidinari and Lars Rustemeier
 and a C++ levenstein distance example by Anders Sewerin Johansen.
*/

/*
 Computes Levenshtein distance between 8-bit per character strings Source (s) and Target (t).
 Uses O(nm) storage and O(nm) time.
*/

# define MIN(a, b)      (((a) < (b)) ? (a) : (b))
# define MIN3(a, b, c)  MIN(MIN((a), (b)), (c))

# define MAT_ALLOC(typ, nc, nr)     ((typ *) malloc(sizeof(typ) * (nc) * (nr)))
# define MAT_ELM_DEREF(p, c, r, nc) (*((p) + (c) + ((r) * ((nc) + 1))))
# define MAT_FREE(m)                free(m)

  /* Cost of edit operations; can be overridden at compile time */
# ifndef INS_COST
#   define INS_COST   1
# endif
# ifndef DEL_COST
#   define DEL_COST   1
# endif
# ifndef SUBST_COST
#   define SUBST_COST 1
# endif

  /* Step 1 */

	/* Get bytes */
	uint8_t *s = (C_truep(C_stringp(os)) ? (uint8_t *) C_c_string(os) : (uint8_t *) C_c_bytevector(os));
	uint8_t *t = (C_truep(C_stringp(ot)) ? (uint8_t *) C_c_string(ot) : (uint8_t *) C_c_bytevector(ot));

  /* N = # of columns, M = # of rows */
  uint32_t n = C_header_size(os);
  uint32_t m = C_header_size(ot);

  /* Handle empty string arguments */
  if (n == 0) {
    return(m);
  }
  if (m == 0) {
    return(n);
  }

  /* Matrix storage */
  uint32_t *d = MAT_ALLOC(uint32_t, n + 1, m + 1);

  /* Local matrix access macro */
# define D(c, r) MAT_ELM_DEREF(d, (c), (r), n)

  uint32_t i, j;

  /* Step 2 */
  for (j = 0; j <= m; ++j)
    D(0, j) = j;

  /* Step 3 */
  for (i = 1; i <= n; ++i) {

    D(i, 0) = i; /* Initialize in inner loop optimization */

    const uint32_t s_i = s[i-1];

    /* Step 4 */
    for (j = 1; j <= m; ++j) {

      const uint32_t t_j = t[j-1];

      /* Step 5 */
      const uint32_t above = D(i-1, j) + DEL_COST;
      const uint32_t left = D(i, j-1) + INS_COST;
      const uint32_t diag = D(i-1, j-1) + ((s_i == t_j) ? 0 : SUBST_COST);

      uint32_t cost = MIN3(above, left, diag);

#     ifdef USE_TRANSPOSITION

#       warning Built with Transposition. Might violate some useful upper & lower bounds.

        /* See <http://en.wikipedia.org/wiki/Levenshtein_distance> for a discussion */
        /* of some useful properties of the Levenshtein distance when not extended */
        /* to include-relative transposition as an edit operation. */

        /* Step 6A: Cover transposition, in addition to deletion, */
        /* insertion and substitution. This step is taken from: */
        /* Berghel, Hal ; Roach, David : `An Extension of Ukkonen's */
        /* Enhanced Dynamic Programming ASM Algorithm' */
        /* (http://www.acm.org/~hlb/publications/asm/asm.html) */

#       ifndef TRANS_COST
#         define TRANS_COST   1
#       endif

        if (i >= 2 && j >= 2) {
          uint32_t trans = D(i-2, j-2) + TRANS_COST;
          if (s[i-2] != t_j) trans += TRANS_COST;
          if (s_i != t[j-2]) trans += TRANS_COST;
          cost = MIN(cost, trans);
        }

#       undef TRANS_COST

#     endif

      /* Step 6 */
      D(i, j) = cost;
    }
  }

  /* Step 7 */
  uint32_t distance = D(n, m);

  MAT_FREE(d);

  return(distance);

# undef MIN
# undef MIN3

# undef MAT_ALLOC
# undef MAT_ELM_DEREF
# undef MAT_FREE

# undef INS_COST
# undef DEL_COST
# undef SUBST_COST

# undef D

#	undef USE_TRANSPOSITION
EOF
) s t) )

) ;module levenshtein-transpose-byte