document.write('
Data hosted with ♥ by Pastebin.com - Download Raw - See Original
  1. ;; http://programmingpraxis.com/2015/07/24/one-swappable-array/
  2.  
  3. (defun one-swap-pair (unsorted-array)
  4.   (let* ((len (length unsorted-array))
  5.      (a
  6.       (loop for i from 0 upto (- len 2)
  7.          when (> (aref unsorted-array i) (aref unsorted-array (+ 1 i)))
  8.          do (return i)))
  9.      (b
  10.       (when a (loop for i from (- len 1) downto 1
  11.          when (< (aref unsorted-array i) (aref unsorted-array (- i 1)))
  12.          do (return i)))))
  13.     (if (and a b)
  14.     (cons a b)
  15.     nil)))
  16.  
  17. (defun is-sorted-between (unsorted-array a b)
  18.   (loop for i from (+ a 1) to (- b 2)
  19.      ;;do (print i)
  20.      when (> (aref unsorted-array i) (aref unsorted-array (+ i 1)))
  21.      do (return nil)
  22.      finally (return T)))
  23.  
  24.  
  25. (defun does-it-fit (unsorted-array val location)
  26.   (let ((left (if
  27.            (= location 0)
  28.            val
  29.            (aref unsorted-array (- location 1))))
  30.          
  31.     (right (if
  32.         (= location (- (length unsorted-array) 1))
  33.         val
  34.         (aref unsorted-array (+ location 1)))))
  35.     (<= left val right)))
  36.  
  37. (defun is-pair-swapable (unsorted-array)
  38.   (let ((p (one-swap-pair unsorted-array)))
  39.     (if (not p)
  40.     nil
  41.     (let* ((a (car p))
  42.            (b (cdr p))
  43.            (ax (aref unsorted-array a))
  44.            (bx (aref unsorted-array b)))
  45.       (if (and
  46.            (is-sorted-between unsorted-array a b)
  47.            (does-it-fit unsorted-array ax b)
  48.            (does-it-fit unsorted-array bx a))
  49.           p
  50.           nil)))))
  51.      
  52.  
  53.          
  54.    
  55.  
  56. (defvar test1 #(1 2 6 4 5 3 7))
  57.  
  58. (defparameter tests
  59.   (list
  60.    #(5 4 3 2 1)
  61.    #(1 2 6 4 5 3 7)
  62.    #(7 6 5 4 3 2 1)
  63.    #(1 2 3 4 5 6 7)
  64.    #(7 2 3 4 5 6 1)
  65.    #(1 2 4 3 5 6 7)
  66.    #(2 7 3 4 5 1 6)
  67.    #(0 1)
  68.    #(1 0)
  69.    #(0)
  70.    #()))
  71.  
  72. (defun run-tests ()
  73.   (loop
  74.      for test in tests
  75.      do (format t "~a ~a~%" test (is-pair-swapable test))))
');