One-swap sorting problem in common lisp.

One-swap sorting problem in common lisp.

Given an array of unique integers, determine if it is possible to sort the array by swapping two elements of the array. For instance, the array [1,2,6,4,5,3,7] can be sorted by swapping 3 and 6, but there is no way to sort the array [5,4,3,2,1] by swapping two of its elements. You may use O(n) time, where the array has n integers, and constant additional space.

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