3
votes

I'm trying to create a program that sorts a list and then groups each portion of the list that is sorted into separate lists and output it into a list of lists. Here's a check that should make it more clear:

> (sort-lists > '())
empty

> (sort-lists < '(1 2 3))
(list (list 1 2 3))

> (sort-lists >= '(2 2 2 2))
(list (list 2 2 2 2))

> (sort-lists < '(5 4 3 2 1))
(list (list 5) (list 4) (list 3) (list 2) (list 1))

> (sort-lists < '(1 2 3 4 2 3 4 5 6 1 2 9 8 7))
(list
 (list 1 2 3 4)
 (list 2 3 4 5 6)
 (list 1 2 9)
 (list 8)
 (list 7))

Here's what I have:

(define (sort-lists rel? ls)
  (cond
    [(empty? ls) '()]
    [(rel? (first ls) (first (rest ls)))
     (list (cons (first ls) (sort-lists rel? (rest ls))))]
    [else (cons (first ls) (sort-lists rel? (rest (rest ls))))]))

I'm having a problem with the (first (rest ls)) part because if there is no first of rest then it gives an error, same with rest of rest.

Also this has to be a single pass function without any helpers in ISL+. Any help would be great.

Is there a way to use local to merge the solution to the recursive subproblem to an ans variable, and then complete the answer. So for (sort-lists < '(1 2 3 4 2 3 4 5 6 1 2 9 8 7)), you would define ans be the result of running (sort-lists < '(2 3 4 2 3 4 5 6 1 2 9 8 7)), which is '((2 3 4) (2 3 4 5 6) (1 2 9) (8) (7)).

2

2 Answers

7
votes

I wouldn't really call this a sort so much as some type of partitioning. You're trying to collect the longest contiguous sequences of elements that are already sorted according to the predicate. I know you said that you have to bundle this all into one function, but it's probably much easier to first write it as separate functions, and then combine them into one.

In tackling this problem, it's probably helpful to break it down into subtasks. First, at the highest level, when the list comes in, there's some initial prefix of ascending elements, and then there's the rest of the elements after that. The result should be a list of that first prefix and then the result of processing the rest of the elements. That gives us a structure like this:

(define (slice predicate lst)
  (if (empty? lst)
      ;; If lst is empty, then there no contiguous 
      ;; subsequences within it, so we return '() 
      ;; immediately.
      '()
      ;; Otherwise, there are elements in lst, and we 
      ;; know that there is definitely a prefix and
      ;; a tail, although the tail may be empty. Then
      ;; the result is a list containing the prefix,
      ;; and whatever the sliced rest of the list is.
      (let* ((prefix/tail (ordered-prefix predicate lst))
             (prefix (first prefix/tail))
             (tail (second prefix/tail)))
        (list* prefix (slice predicate tail)))))

I hope the logic in that function is relatively clear. The only bits that might be a bit unusual are the let*, which performs sequential bindings, and list**, which the same as **cons. There's also a reference to a function, ordered-prefix, that we haven't defined yet. Its task is to return a list of two values; the first is the ordered prefix of the list, and the second is the tail of the list after that prefix. Now we just need to write that function:

(define (ordered-prefix predicate lst)
  (cond
    ;; If the list is empty, then there's no prefix,
    ;; and the tail is empty too.
    ((empty? lst)
     '(() ()))
    ;; If the list has only one element (its `rest` is
    ;; empty, then the prefix is just that element, and 
    ;; the tail is empty.
    ((empty? (rest lst))
     (list (list (first lst)) '()))
    ;; Otherwise, there are at least two elements, and the
    ;; list looks like (x y zs...).
    (else 
     (let ((x (first lst))
           (y (second lst))
           (zs (rest (rest lst))))
       (cond
         ;; If x is not less than y, then the prefix is (x),
         ;; and the tail is (y zs...).
         ((not (predicate x y))
          (list (list x) (list* y zs)))
         ;; If x is less than y, then x is in the prefix, and the 
         ;; rest of the prefix is the prefix of (y zs...).  
         (else 
          (let* ((prefix/tail (ordered-prefix predicate (list* y zs)))
                 (prefix (first prefix/tail))
                 (tail (second prefix/tail)))
            (list (list* x prefix) tail))))))))

Now, this is enough to make slice work:

(slice < '())                ;=> ()
(slice < '(1 2 3 4 2 3 4 5)) ;=> ((1 2 3 4) (2 3 4 5))

It's not all in one function, though. To get it there, you'll need to get the definition of ordered-prefix into the definition of slice. You can use let to bind functions within other functions, like:

(define (repeat-reverse lst)
  (let ((repeat (lambda (x)
                  (list x x))))
    (repeat (reverse lst))))

(repeat-reverse '(1 2 3)) ;=> ((3 2 1) (3 2 1))

However, that won't work for ordered-prefix, since ordered-prefix is recursive; it needs to be able to refer to itself. You can do that with letrec though, which allows functions to refer to themselves. E.g.:

(define (repeat-n-reverse lst n)
  (letrec ((repeat-n (lambda (x n)
                       (if (= n 0) 
                           '()
                           (list* x (repeat-n x (- n 1)))))))
    (repeat-n (reverse lst) n)))

(repeat-n-reverse '(1 2 3) 3)     ;=> ((3 2 1) (3 2 1) (3 2 1))
(repeat-n-reverse '(x y) 2)       ;=> ((y x) (y x))
(repeat-n-reverse '(a b c d e) 0) ;=> ()

OK, so now we're ready to put it all together. (Since ordered-prefix is now defined within slice, it will already have access to the predicate, and we can remove it from the argument list, but still use it.)

(define (slice predicate lst)
  (letrec ((ordered-prefix
            (lambda (lst)
              (cond
                ((empty? lst)
                 '(() ()))
                ((empty? (rest lst))
                 (list (list (first lst)) '()))
                (else 
                 (let ((x (first lst))
                       (y (second lst))
                       (zs (rest (rest lst))))
                   (cond
                     ((not (predicate x y))
                      (list (list x) (list* y zs)))
                     (else 
                      (let* ((prefix/tail (ordered-prefix (list* y zs)))
                             (prefix (first prefix/tail))
                             (tail (second prefix/tail)))
                        (list (list* x prefix) tail))))))))))
    (if (empty? lst)
        '()
        (let* ((prefix/tail (ordered-prefix lst))
               (prefix (first prefix/tail))
               (tail (second prefix/tail)))
          (list* prefix (slice predicate tail))))))

This is relatively efficient, too. It doesn't allocate any unnecessary data, except for the places where I used (list* y zs) for clarity, where that's the same value as (rest lst). You should probably change that, but I wanted to leave it as is for clarity.

The only performance consideration is that this is not tail recursive, so you use a lot more stack space. To get around that, you'd need to convert the recursion to a form that builds up the list in reverse, and then reverses it when its time to return it. That's what I was doing in the original (you can still view the edit history), but it's probably overkill for what appears to be an academic exercise.

1
votes

You want to break a list up into longest ascending sequences of numbers. And to do it in ISL+, in one pass.

This does it in a logic-programming pseudocode (well, Prolog):

runs([],  [[] ]).
runs([A], [[A]]).
runs([A,B|C], R) :- 
   (   A > B   ->  runs([B|C],  S  ), R=[[A  ]|S]   
   ;   true    ->  runs([B|C],[D|S]), R=[[A|D]|S]   ).

This does the same in a Scheme-like pseudocode (well, full Racket):

(define (runs xs)
   (match xs 
     ((list )  '(()))
     ((list A)  (list (list A)))
     ((list A B C ...)
        (cond
          ((> A B)
             (let ([S (runs (cons B C))])
                (cons (list A) S)))
          (else
             (let ([d_s (runs (cons B C))])
                (let ([D (car d_s)]
                      [S (cdr d_s)])
                   (cons (cons A D) S))))))))

All that's left for you to do is to fit this into the ISL+ language. I don't know what + stands for, but there's bound to be a lambda construct allowed in the "intermediate student with lambda" language. This lets us emulate the staged assignment of the nested lets as

          ( (lambda (d_s)
               ( (lambda (D S)
                     (cons (cons A D) S))
                 (car d_s)
                 (cdr d_s)))
            (runs (cons B C)))