("Sq36" "Sq64" "Sq81" "Sq4" "Sq25" "Sq1" "Sq100" "Sq16" "Sq9" "Sq49")

then:

(sort *squares* #'string-lessp)

gives:

`("Sq1" "Sq100" "Sq16" "Sq25" "Sq36" "Sq4" "Sq49" "Sq64" "Sq81" "Sq9")`

which is the order that the strings would appear in a dictionary.

However, for many applications, such as sorting filenames, we might prefer a more logical sort order which takes account of the numeric ordering of the numbers represented by the digits. How much work is it to produce versions of the string comparison routines to accomodate this feature?

For example, we want a routine **string-digits-lessp** which treats sequences of digits within the strings as numbers, and compares these numerically, so:

(sort *squares* #'string-digits-lessp)

should give:

("Sq1" "Sq4" "Sq9" "Sq16" "Sq25" "Sq36" "Sq49" "Sq64" "Sq81" "Sq100")

At first sight it looks as if we might have to parse the sequence of digits, convert them into the corresponding integer, and then compare these. However, what size integer do we need to store the value? The strings could contain a sequence of 100 digits.

Before I give the answer I came up with you may like to try the problem yourself.

Fortunately the solution turns out to be much easier than you might expect, and requires a fairly small modification to the standard string comparison routine.

As a first step in approaching this problem I wrote my own simple implementation of **string-lessp**:

(defun string-lessp* (s1 s2 &key (start1 0) (start2 0) (end1 (length s1)) (end2 (length s2))) (let ((lt t) (gt nil) (eq nil)) (loop (when (and (= start1 end1) (= start2 end2)) (return eq)) (when (= start1 end1) (return lt)) (when (= start2 end2) (return gt)) (when (char-lessp (char s1 start1) (char s2 start2)) (return lt)) (when (char-greaterp (char s1 start1) (char s2 start2)) (return gt)) (incf start1) (incf start2))))

My version **string-lessp*** isn't quite identical to **string-lessp**; for example, it returns **t** rather than the index of the first mismatch. But for practical purposes it's equivalent, and on LispWorks it appears to run as quickly as the system function.

To accommodate strings of digits the approach is as follows:

- As we are scanning the strings, testing the alphabetic ordering of pairs of characters, check whether the characters we are comparing are both digits.
- If so, scan past the sequence of digits in each string, until we either get to the end of the string, or a non-digit character.
- If one sequence of digits is longer than the other one, this is then the greater string, and we can return immediately.
- Otherwise resume testing the alphabetic ordering of pairs of characters from the start of each sequence of digits.

Here's the implementation; it uses two additional pointers **d1** and **d2** to span each sequence of digits:

(defun string-digits-lessp (s1 s2 &key (start1 0) (start2 0) (end1 (length s1)) (end2 (length s2))) (let ((lt t) (gt nil) (eq nil) (d1 0) (d2 0)) (loop (when (and (= start1 end1) (= start2 end2)) (return eq)) (when (= start1 end1) (return lt)) (when (= start2 end2) (return gt)) ;; (when (and (> start1 d1) (> start2 d2) (digit-char-p (char s1 start1)) (digit-char-p (char s2 start2))) (setq d1 (1+ start1)) (setq d2 (1+ start2)) (loop (when (or (= d1 end1) (not (digit-char-p (char s1 d1)))) (return)) (incf d1)) (loop (when (or (= d2 end2) (not (digit-char-p (char s2 d2)))) (return)) (incf d2)) (when (> (- d1 start1) (- d2 start2)) (return gt)) (when (< (- d1 start1) (- d2 start2)) (return lt))) ;; (when (char-lessp (char s1 start1) (char s2 start2)) (return lt)) (when (char-greaterp (char s1 start1) (char s2 start2)) (return gt)) (incf start1) (incf start2))))

Testing it:

> (sort *squares* #'string-digits-lessp) ("Sq1" "Sq4" "Sq9" "Sq16" "Sq25" "Sq36" "Sq49" "Sq64" "Sq81" "Sq100")

It also works for strings containing multiple sequences of digits, such as:

> (string-digits-lessp "Volume100File9" "Volume100File10") T]]>

First we need a function to construct an empty array. Here is a function **makearray** that recursively creates an x by y array and returns it. It uses a helper function **makelist**:

(defun makearray (x y e) (makelist x (makelist y e))) (defun makelist (n e) (if (zerop n) nil (cons e (makelist (1- n) e))))

The third parameter, **e**, specifies the initial value of each element. Here's an example of its use:

> (setq c (makearray 3 4 0)) ((0 0 0 0) (0 0 0 0) (0 0 0 0))

To access an arbitrary element of a two-dimensional array we use **arrayref**:

(defun arrayref (a x y) (nth y (nth x a)))

Changing an arbitrary element is a bit trickier. Here's one way using a function **changearrayref**, which uses a recursive helper function **changenth**:

(defun changearrayref (a x y n) (changenth a x (changenth (nth x a) y n))) (defun changenth (list x n) (if (null list) nil (cons (if (zerop x) n (car list)) (changenth (cdr list) (1- x) n))))

Here's an example of its use on the array **c** we defined above:

> (changearrayref c 1 2 7) ((0 0 0 0) (0 0 7 0) (0 0 0 0))

Note that this is non-destructive; **c** still has its original value:

> c ((0 0 0 0) (0 0 0 0) (0 0 0 0))

We can write a destructive version of **changearrayref** much more easily, and this was my original attempt at solving this problem:

(defun setarrayref (a x y n) (setf (nth y (nth x a)) n))

I've called it **setarrayref** to distinguish it from the non-destructive version.

Trying this out:

> (setq d (makearray 3 4 0)) ((0 0 0 0) (0 0 0 0) (0 0 0 0)) > (setarrayref d 1 2 7) 7 > d ((0 0 7 0) (0 0 7 0) (0 0 7 0))

Now something's gone seriously wrong – we wanted to change one element but we've ended up changing three. What's the explanation?

The answer is that **makearray** creates a list with shared structure; each occurrence of **(0 0 0 0)** in the result is actually a pointer to the same list, so changing one element of this list appears to change three occurrences in **d**.

One solution would be to use destructive operations, but to disallow creating lists with shared structure; however, shared list structure is one of the aspects of Lisp that makes it highly efficient in list and tree processing tasks.

Therefore the traditional approach to programming in Lisp is to avoid destructive operations, and only use them cautiously only when there's a significant performance benefit in doing so. As I found to my cost in this example, using them can introduce puzzling errors that are hard to track down.

By the way, the modification to **makearray** to ensure that it doesn't create a list with shared structure is:

(defun makearray2 (x y e) (mapcar #'copy-list (makelist x (makelist y e))))

I'd be interested in comments, or suggestions for improvements to the non-destructive version of **changenth**.

For example:

(next '(2 1 3 4 5))

will give:

(2 1 3 5 4)

The permutations are generated in lexical order; in other words, the order they would be listed in a telephone directory, so if we are generating the permutations of the first five digits, the first permutation will be (1 2 3 4 5) and the last one will be (5 4 3 2 1). Calling:

(next '(5 4 3 2 1))

will return **nil** to indicate that there are no more permutations.

The recursive algorithm works as follows:

- We divide the current permutation into the head element, and the remaining elements.

For example, for (2 1 3 4 5) we get 2 and (1 3 4 5).

- Unless the remaining elements are in descending order, the next permutation is the head element followed by the next permutation of the remaining elements.

So, in this case, the next permutation is 2 followed by the next permutation of (1 3 4 5).

- If the remaining elements
*are*in descending order, we need to change the head element to give the next permutation, and follow it with the first permutation of the remaining elements.

For example, for (2 5 4 3 1) calling next on (5 4 3 1) will return **nil**, because there's no next permutation. We therefore need to swap the head element, 2, with the next available digit, and follow it by the first permutation of the remaining digits.

To get the first permutation of the remaining elements we need to arrange them in ascending order. However, we don't need to sort them, because we know they were originally in descending order, so we just need to reverse them: in this example (1 3 4 5).

Now we find the first digit in this list that's greater than the head element. In this case it's 3.

Finally we swap this with the head element to give (3 1 2 4 5) as the next permutation.

To check whether the elements in the list **list** are descending order we can use:

(apply #'> list)

To find the first item in a list **list** that's greater than **item** we use:

(find item list :test #'<)

For example:

> (find 3 '(1 2 4 5 6)) 4

Finally, we use **substitute** to swap the items **old** and **new** in **list**:

(substitute new old list)

For example:

> (substitute 2 3 '(1 3 4 5)) (1 2 4 5)

Finally, here's the definition of **next**, following the recursive definition given above:

(defun next (lst) (cond ((not (apply #'> (cdr lst))) (cons (car lst) (next (cdr lst)))) ((> (car lst) (cadr lst)) nil) (t (let* ((rst (reverse (cdr lst))) (old (find (car lst) rst :test #'<))) (cons old (substitute (car lst) old rst))))))

To test it, here's a routine **all** that repeatedly applies a function to the next permutation of a list until it returns **nil**:

(defun all (function lst) (when lst (funcall function lst) (all function (next lst))))

For example:

> (all print '(1 2 3)) (1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1) nil]]>