a8cd04b5 |
(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)))))))))
|