;; http://programmingpraxis.com/2015/07/24/one-swappable-array/
(defun one-swap-pair (unsorted-array)
(let* ((len (length unsorted-array))
(a
(loop for i from 0 upto (- len 2)
when (> (aref unsorted-array i) (aref unsorted-array (+ 1 i)))
do (return i)))
(b
(when a (loop for i from (- len 1) downto 1
when (< (aref unsorted-array i) (aref unsorted-array (- i 1)))
do (return i)))))
(if (and a b)
(cons a b)
nil)))
(defun is-sorted-between (unsorted-array a b)
(loop for i from (+ a 1) to (- b 2)
;;do (print i)
when (> (aref unsorted-array i) (aref unsorted-array (+ i 1)))
do (return nil)
finally (return T)))
(defun does-it-fit (unsorted-array val location)
(let ((left (if
(= location 0)
val
(aref unsorted-array (- location 1))))
(right (if
(= location (- (length unsorted-array) 1))
val
(aref unsorted-array (+ location 1)))))
(<= left val right)))
(defun is-pair-swapable (unsorted-array)
(let ((p (one-swap-pair unsorted-array)))
(if (not p)
nil
(let* ((a (car p))
(b (cdr p))
(ax (aref unsorted-array a))
(bx (aref unsorted-array b)))
(if (and
(is-sorted-between unsorted-array a b)
(does-it-fit unsorted-array ax b)
(does-it-fit unsorted-array bx a))
p
nil)))))
(defvar test1 #(1 2 6 4 5 3 7))
(defparameter tests
(list
#(5 4 3 2 1)
#(1 2 6 4 5 3 7)
#(7 6 5 4 3 2 1)
#(1 2 3 4 5 6 7)
#(7 2 3 4 5 6 1)
#(1 2 4 3 5 6 7)
#(2 7 3 4 5 1 6)
#(0 1)
#(1 0)
#(0)
#()))
(defun run-tests ()
(loop
for test in tests
do (format t "~a ~a~%" test (is-pair-swapable test))))