git.fiddlerwoaroof.com
Raw Blame History
(defpackage :fwoar.decision-table
  (:use :cl )
  (:export ))
(in-package :fwoar.decision-table)

(defun array= (array1 array2 &optional (element-compare 'eql))
  (and (= (length array1)
          (length array2))
       (every element-compare array1 array2)))

(defun apply-decision-table (table inputs)
  (destructuring-bind (row col) (array-dimensions table)
    (loop with input-length = (length inputs)
          for cur-row from 0 below row
          for array-accessor = (make-array input-length
                                           :displaced-to table
                                           :displaced-index-offset (array-row-major-index table cur-row 0))
            then (adjust-array array-accessor input-length
                               :displaced-to table
                               :displaced-index-offset (array-row-major-index table cur-row 0))
          while (not (array= inputs array-accessor))
          finally (return
                    (aref table cur-row (1- col))))))

(defmacro let-order ((min max) (a b) &body body)
  (alexandria:once-only (a b)
    `(destructuring-bind (,min ,max) (if (<= (length ,a) (length ,b))
                                         (list ,a ,b)
                                         (list ,b ,a))
       ,@body)))

(defmacro let-by-length ((a b) &body body)
  `(let-order (,a ,b) (,a ,b)
     ,@body))

;; 
;;
;;
;;

(defun levehnstein-1-p (a b)
  (let-by-length (a b)
    (if (equal a b)
        t
        (cond ((= (length b)
                  (length a))
               (= (loop
                    for x from 0 below (length a)
                    when (not (eql (elt a x)
                                   (elt b x)))
                      count 1)
                  1))
              ((= (- (length b)
                     (length a))
                  1)
               (some 'identity
                     (map 'list
                          (op (equal a
                                     (remove _1 b
                                             :start _2
                                             :count 1)))
                          b (alexandria:iota (length b)))))))))