mutable data in scheme to return pairs where right element is the largest suffix matching a condition

I have this definition "sort left list" which is a list of pairs sorted according to the left element of each pair the left element must be a non-negative integer and the right component may be a value of any type

I have to write a procedure mkjump which takes as an 开发者_Python百科argument a sorted list of non-negative integers, sorted-lst = (x1 ... xn) and returns a left-sorted list: sort left list = ((x1.y1)...(xn.yn)) such that: yi is the largest suffix of sort left list, ((xj . yj)...(xn . yn)) in which xk>(xi)^2 for all xk. For example:

   >(define lst (list 2 3 4 15 16 17))
   >(mkjump lst)
   >lst
    ( (2 (15) (16) (17))
    (3 (15) (16) (17))
    (4 (17))
    (15)
    (16)
    (17) )

The 6th element in res is (x6 . y6) where x6=17 and y6=null. The 3rd element in res is (x3 . y3), where x3=4 and y3 is the list containing (x6 . y6), which is the largest suffix of res in which xk>(xi)^2 for all xk

How to write it?

---

As stated previously you do not need mutable state to do your job. However, if you really want to use them you can easily change Keen's solution to get what you want. First you have to translate his code in a tail recursive way. You can begin with mkjump

(define (mkjump lst) (reverse (mkjump-tr lst '())))

(define (mkjump-tr lst sol)
  (if (null? lst)
      sol
      (mkjump-tr (cdr lst) 
                 (cons (cons (car lst) (wrapper (car lst) (cdr lst)))
                       sol)) ))

Then you can change modmap

(define (modmap proc lst) (reverse (modmap-tr proc lst '())))

(define (modmap-tr proc lst sol)
  (cond ((null? lst) sol)
        ((proc (car lst)) (modmap-tr proc 
                                     (cdr lst) 
                                     (cons (proc (car lst)) sol) ))
        (else (modmap-tr proc (cdr lst) sol)))) 

The tail recursive mkjump-tr will be translated in an iterative process. This is because it can be seen as a while loop. This enable you to create this loop with the do construction. This way mkjump-tr can be write as

(define (mkjump-tr lst sol)
  (do ((lst lst (cdr lst))
       (sol sol (cons (cons (car lst) (wrapper (car lst) (cdr lst)))
                       sol)) )
    ((null? lst) sol)
    ))

and modmap-tr can be translated as

(define (modmap-tr proc lst sol)
  (do ((lst lst (cdr lst))
       (sol sol (if (proc (car lst)) (cons (proc (car lst)) sol) sol)) )
    ((null? lst) sol)
    ))

But since we do not have recursive form, we can directly write these do's in the former functions mkjump and modmap. So we get

(define (mkjump lst) 
  (do ((lst lst (cdr lst))
       (sol '() (cons (cons (car lst) (wrapper (car lst) (cdr lst)))
                       sol)) )
    ((null? lst) (reverse sol))
    ))

(define (modmap proc lst) 
  (do ((lst lst (cdr lst))
       (sol '() (if (proc (car lst)) (cons (proc (car lst)) sol) sol)) )
    ((null? lst) (reverse sol))
    ))

You could see some slight changes: reverse is added before sol and sol is initialize by the empty list in both case.

Finally, if you really want to see some set! somewhere, just add them by breaking the do-loop construction. Here is the solution for mkjump

(define (mkjump lst)
  (let ((elt 'undefined)
        (lst lst)
        (sol '()))
  (do () 
    ((null? lst) (reverse sol))
    (set! elt (car lst))
    (set! lst (cdr lst))
    (set! sol (cons (cons elt (wrapper elt lst)) sol))
    )))

I will let you change modmap. These two last modifications obfuscate the idea behind the algorithm. Therefore, it is a bad idea to change them this way, since they will not improve anything. The first modification can be a good idea however. So I will suggest you to keep the first modification.

Is this what have you expected ?

---

I did this in MIT-scheme, hopefully it works in racket too. I'm assuming you don't actually have to use mutation, given that your example doesn't depend upon it.

(define (square x) (* x x))

(define (mkjump lst)
  (if (null? lst)
      '()
      (cons (cons (car lst) (wrapper (car lst) (cdr lst)))
        (mkjump (cdr lst)))))

(define (wrapper item lst)
  (modmap (lambda (x) 
         (if (< (square item) x)
             (list x)
             #f))
         lst))

(define (modmap proc lst)
  (cond ((null? lst) '())
        ((proc (car lst)) (cons (proc (car lst)) (modmap proc (cdr lst))))
        (else (modmap proc (cdr lst)))))