Racket accumulator list function - scheme

I'm working on a specific step in creating the 2048 game which you may have played. It's on a bunch of websites online.
Basically all this function does is:
1) All blank spaces move to the back
and 2) if the first two numbers are equal then it doubles and checks every two numbers
These are the instructions for the step I'm stuck on:
Design a slide-left function so that it runs a single pass over the given row using an APS (accumulator passing style) helper. You will need to maintain two accumulators. The first accumulator remembers the last unmerged number. Initially, this value is false, meaning that we have not yet seen a number. The second accumulator is where we pile up the blanks as we come across them (a blank is '-) The easiest thing to do is to use a list for this purpose and, thus, its initial value is empty.
Do it in a single pass: You might think, at first, that it would be a good idea to use an accumulator for the solution. But then there is a problem with order. You could add new elements to the end of the current solution using something like (append solution (list number)), but that append operation is recursive and takes time proportional to the length of the solution list. We definitely want to avoid non-trivial operations during an APS recursion if we can. You could, instead, decide to add new numbers to the front of the current solution (using cons), with the intention of reversing the solution at the end. This is certainly better than the append approach. The drawback is that it requires a second pass over the data to do the reversal. We want to do this in one pass, and we can. So, the easiest and fastest thing to do is to just construct the solution, in the right order, as you back out of the recursion.
I added a bunch of check-expects here so you can see what it's doing:
(check-expect (slide-row-left '(2 2 4 -))(list 4 4 '- '-))
(check-expect (slide-row-left '(2 2 - 4))(list 4 4 '- '-))
(check-expect (slide-row-left '(2 - 2 4))(list 4 4 '- '-))
(check-expect (slide-row-left '(- 2 2 4))(list 4 4 '- '-))
(check-expect (slide-row-left '(2 2 2 2))(list 4 4 '- '-))
(check-expect (slide-row-left '(4 2 2 2))(list 4 4 2 '-))
(check-expect (slide-row-left '(2 4 2 2))(list 2 4 4 '-))
(check-expect (slide-row-left '(2 2 4 2))(list 4 4 2 '-))
(check-expect (slide-row-left '(2 2 4 4))(list 4 8 '- '-))
Alright, so here is what I have:
(define (blank? item) (equal? item '-))
(define (slide-row-left b)
(blank-help (slide-row-left/help b false) '()))
(define (slide-row-left/help ls acc)
(cond [(empty? ls) acc]
[(not (equal? (first ls) (first (rest ls))))
(slide-row-left/help (rest (rest ls))
(cons (first (rest ls)) (cons (first ls) acc)))]
[else (slide-row-left/help (rest (rest ls)) acc)]))
(define (blank-help ls acc)
(cond [(empty? ls) acc]
[(blank? (first ls)) (blank-help (rest ls) (cons (first ls) acc))]
[else (cons (first ls) (blank-help (rest ls) acc))]))
The first accumulator slide-row-left/help creates a list of the numbers that are not going to be merging. It checks that the first number and second are not equal and adds them to the list. If they are equal (which means they merge to double the original amount) then it just recurs. The second accumulator blank-help pushes all of the blank spaces '- to the end of the list, so all the numbers move left.
The problem is that I don't know how to make the pieces merge using these, especially in a single pass.
I'm about to head off for the night so hopefully you guys respond by tomorrow. Any help would be so great. Also this is for ISL+

I think I found your problem. You were not quite there yet frankly. The assignment clearly states that you have to build up the result while coming back from your recursion. This is because you don't want to reverse at the end of your program, or do an append while doing tail recursion.
Below are a few examples that explain each approach:
;; Using an accumulator
(define (double ls acc)
(if (empty? ls)
acc
(double (rest ls) (cons (* 2 (first ls)) acc))))
(double '(1 2 3) '())
;; = '(6 4 2)
;; So you could reverse the result: (reverse '(1 2 3) '()))
;; but this requires looping over the list again!
;; Using append
(define (double2 ls acc)
(if (empty? ls)
acc
(double2 (rest ls) (append acc (list (* 2 (first ls)))))))
(double2 '(1 2 3) '())
;; = '(2 4 6)
;; But the append operation is very expensive and you don't want that!
(define (double3 ls)
(if (empty? ls)
'()
(cons (* 2 (first ls)) (double3 (rest ls)))))
(double3 '(1 2 3))
;; Cons *after* the recursive call.
;; Requires more memory though, becuase you can not do tail call optimisation!
;; Info: http://c2.com/cgi/wiki?TailRecursion
So for different inputs to the function slide-row-left/help:
Case 1: First two numbers are equal
Input: '(2 2 4 -)
Result: '(4 4 '- '-)
What you want to do here is sum both first elements (4). Then you want to calculate the rest of the list. The rest of the list should now also contain an extra blank, because summing two elements makes the list one element shorter. So you pass a new blank to the acc value in your recursive call. So what you want to do here first is calculate the rest of the list. Hence, call recursively with (drop ls 2) and (cons '- acc). This drops the first 2 elements form the list. Once you get that result back (result will be '(4 '- '-), you just cons your sum in front of it. This results in a total result of '(4 4 '- '-).
Case 2: First two numbers differ
Input: '(4 2 2 2)
Result: '(4 4 2 '-)
If the first two numbers differ we can not do anything. We take the first number off of the list (4), which leaves you with '(2 2 2). You can not drop the first two because the second and third element might be able to be summed. You remember the first element and call the function recursively to calculate the rest of the result. The function returns and gives you '(4 2 '-). Now all you need to do is cons the first element back in front of it, yielding '(4 4 2 '-).
Case 3: First element is a blank
Input: '(- 2 2 4)
Result: '(4 4 '- '-)
If the first number is a blank you can not do anything with it. You might think that in this case case 2 applies but it doesn't. A blank should be put in the back of your solution. But how can you do that? Simple, you put the blank in your accumulator. As you will soon see, the accumulator is basically the end of your list. So, take the blank away from the list, which leaves you with '(2 2 4). Put '- in front of the accumulator, which makes the accumulator equal to '('- <rest of acc>) and do your recursive call. So you call it with the list '(2 2 4) and the accumulator '('- <rest of acc>). Your recursive call will yield '(4 4 '- '-). Ergo, you don't have to cons anything in front of it anymore, it is just your result.
Case 4: Second element is a blank
Input: '(2 - 2 4)
Result: '(4 4 '- '-)
If the second number is a blank, the situation is a bit more tricky. You will have to cut out the blank from the list. So you would want (2 2 4). To do this you can do (cons (first ls) (rest (rest ls))). The blank can again, not be discarded. You will need it to put it at the end of the list. Where is the end of the list? Indeed, the accumulator. So you cons the element you want at the back of the solution (the blank) to the acc as such: (cons (second ls) acc). Again, you have put the blank at the end and you make your recursive call. There is no element that has to be put in front of of the solution of the recursive call so that call gives you the total answer.
Case 5: Input is empty
Input: '()
Result: acc
If your input is empty you need to return the acc value. Since your input is empty, you need to return the end of the list, which we know is the acc value.
Case 6: Input is length 1
Input: '(4)
Result: (cons 4 acc)
If the input is only one element you can not apply any sum or something to it. You only have one element. So, the result is that element, consd in front of the acc.
Source
#lang racket
;; A shorthand for (first (rest ls))
(define (second ls) (first (rest ls)))
(define (blank? item) (equal? item '-))
(define (slide-row-left b)
(blank-help (slide-row-left/help b '()) '()))
(define (slide-row-left/help ls acc)
(cond [(empty? ls) acc]
[(= (length ls) 1) (cons (first ls) acc)]
;; When the first element is blank (e.g., '(- 2 4))
;; -> Discard the blank
;; -> call the function on the rest of the list.
[(blank? (first ls))
(slide-row-left/help (rest ls) (cons (first ls) acc))]
;; When the second element is blank (e.g., '(2 - 2 4))
;; -> Discard the second element
;; -> Run the function again with the entire list (without the blank)
[(blank? (second ls))
(slide-row-left/help (cons (first ls) (drop ls 2)) (cons (second ls) acc))]
;; If the first two elements are not equal:
;; -> drop 1 element from the list
;; -> cons this element to the result of the recursive call
[(not (equal? (first ls) (second ls)))
(let ([fst (first ls)]
[snd (second ls)]
[rst (rest ls)])
(cons fst (slide-row-left/help rst acc)))]
;; If the first two elements are the same:
;; -> drop 2 elements from the list
;; -> Sum them
;; -> cons the sum in front of the recursive call
[else
(let ([fst (first ls)]
[snd (second ls)]
[rst (drop ls 2)])
(cons (* 2 snd) (slide-row-left/help rst (cons '- acc))))]))
(define (blank-help ls acc)
(cond [(empty? ls) acc]
[(blank? (first ls)) (blank-help (rest ls) (cons (first ls) acc))]
[else (cons (first ls) (blank-help (rest ls) acc))]))
(define (check-expect x y)
(display x)
(display y)
(equal? x y))
(check-expect (slide-row-left '(2 2 4 -))(list 4 4 '- '-))
(check-expect (slide-row-left '(2 2 - 4))(list 4 4 '- '-))
(check-expect (slide-row-left '(2 - 2 4))(list 4 4 '- '-))
(check-expect (slide-row-left '(- 2 2 4))(list 4 4 '- '-))
(check-expect (slide-row-left '(2 2 2 2))(list 4 4 '- '-))
(check-expect (slide-row-left '(4 2 2 2))(list 4 4 2 '-))
(check-expect (slide-row-left '(2 4 2 2))(list 2 4 4 '-))
(check-expect (slide-row-left '(2 2 4 2))(list 4 4 2 '-))
(check-expect (slide-row-left '(2 2 4 4))(list 4 8 '- '-))
Edit
The drop function is used to remove the n first elements of a list. It can be implemented as shown below. However, you can just as well use (rest (rest ls)) instead. I used it for brevity.
drop
(define (drop ls n)
(cond [(empty? ls)
ls]
[(>= 0 n)
ls]
[else
(drop (rest ls) (- n 1))]))

Related

Creating a Scheme list from a box and pointer

For anyone who knows Scheme: how would you make a list using this box and pointer image?
I've tried a lot of different things, but I don't think I really understand scheme.
The box and pointer image is simply the visual equivalent of
(cons (cons 1 '())
(cons 2
(cons (cons 3 (cons 4 '()))
(cons 5 '()))))
Knowing that a list is a succession of conses ending in the empty list, e.g.,
(list 1 2 3) would return the same as
(cons 1 (cons 2 (cons 3 '())))
namely the list '(1 2 3)
the structure in the box and pointer diagram can also be seen (and created) as a list of lists:
(list (list 1)
2
(list 3 4)
5)

How to invert the predicate here?

I have the following filter procedure:
; (2) filter
(define (filter test sequence)
; return a list of the elements that pass the predicate test
(let ((elem (if (null? sequence) nil (car sequence)))
(rest (if (null? sequence) nil (cdr sequence))))
(cond ((null? sequence) nil)
((test elem) (cons elem (filter test rest)))
(else (filter test rest)))))
And here would be an example of using it to return the even-numbered elements of a list:
(define even? (lambda (x) (= (modulo x 2) 0)))
(define sequence '(1 2 3 4 5 8 9 11 13 14 15 16 17))
(filter even? sequence)
; (2 4 8 14 16)
Is there a simple way to use the not test to invert the selection? For example, I thought the following might work:
(filter (not even?) sequence)
But it returns an error. I can define odd separately, of course:
(define odd? (lambda (x) (not (even? x))))
But I'm trying not to do this. Is there a way to write the odd procedure without defining it directly, but instead using the not directly like I'm trying to do above?
There is a complement function in Common Lisp that does what I think you are looking for. complement is a higher-order procedure that takes a procedure as its argument, and returns a procedure that takes the same arguments as the input procedure and performs the same actions, but the returned truth value is inverted.
Racket has a similar procedure, negate, and it is easy enough to implement this in Scheme:
(define (complement f)
(lambda xs (not (apply f xs))))
> (filter even? '(1 2 3 4 5))
(2 4)
> (filter (complement even?) '(1 2 3 4 5))
(1 3 5)
> (> 1 2 3 4 5)
#f
> ((complement >) 1 2 3 4 5)
#t
And in Racket:
scratch.rkt> (filter even? '(1 2 3 4 5))
'(2 4)
scratch.rkt> (filter (negate even?) '(1 2 3 4 5))
'(1 3 5)
scratch.rkt> (> 1 2 3 4 5)
#f
scratch.rkt> ((negate >) 1 2 3 4 5)
#t
The general answer to this is to simply compose not and the function you care about. Racket has a compose function which does this, but you can easily write a simple one yourself:
(define (compose-1 . functions)
;; simple-minded compose: each function other than the last must
;; take just one argument; all functions should return just one
;; value.
(define (compose-loop fns)
(cond
((null? fns)
(λ (x) x))
((null? (cdr fns))
(car fns))
(else
(λ (x) ((car fns) ((compose-loop (cdr fns)) x))))))
(compose-loop functions))
Making it efficient and more general takes more work of course.
Then you can define odd? (which is already defined of course):
(define odd? (compose-1 not even)
Or in fact define a more general CL-style complement function:
(define (complement f)
(compose-1 not f))
One option is to write an invert function which will curry things along (so the initial function still accepts one argument) until the final evaluation occurs:
(define invert (lambda (func) (lambda (x) (not (func x)))))
(define sequence '(1 2 3 4 5 6 8 9 11 13 14 15 16 17))
(filter (invert even?) sequence)
; (1 3 5 9 11 13 15 17)

Scheme recursive

Deos anyone know, how I can make this funktion recursive by inserting the function somewhere? I am not allowed to use implemented functions for lists except append, make-pair(list) and reverse.
(: split-list ((list-of %a) -> (tuple-of (list-of %a) (list-of %a))))
(check-expect (split-list (list 1 2)) (make-tuple (list 1) (list 2)))
(check-expect (split-list (list 1 2 3 4)) (make-tuple (list 1 3) (list 2 4)))
(check-expect (split-list (list 1 2 3)) (make-tuple (list 1 3) (list 2)))
(check-expect (split-list (list 1 2 3 4 5)) (make-tuple (list 1 3 5) (list 2 4)))
(check-expect (split-list (list 1 2 3 4 5 6)) (make-tuple (list 1 3 5) (list 2 4 6)))
(define split-list
(lambda (x)
(match x
(empty empty)
((make-pair a empty) (make-tuple a empty))
((make-pair a (make-pair b empty)) (make-tuple (list a) (list b)))
((make-pair a (make-pair b c)) (make-tuple (list a (first c)) (list b (first(rest c))))))))
Code for make-tuple:
(define-record-procedures-parametric tuple tuple-of
make-tuple
tuple?
(first-tuple
rest-tuple))
Here's a way you can fix it using match and a named let, seen below as loop.
(define (split xs)
(let loop ((xs xs) ;; the list, initialized with our input
(l empty) ;; "left" accumulator, initialized with an empty list
(r empty)) ;; "right" accumulator, initialized with an empty list
(match xs
((list a b rest ...) ;; at least two elements
(loop rest
(cons a l)
(cons b r)))
((cons a empty) ;; one element
(loop empty
(cons a l)
r))
(else ;; zero elements
(list (reverse l)
(reverse r))))))
Above we use a loop to build up left and right lists then we use reverse to return the final answer. We can avoid having to reverse the answer if we build the answer in reverse order! The technique used here is called continuation passing style.
(define (split xs (then list))
(match xs
((list a b rest ...) ;; at least two elements
(split rest
(λ (l r)
(then (cons a l)
(cons b r)))))
((cons a empty) ;; only one element
(then (list a) empty))
(else ;; zero elements
(then empty empty))))
Both implementations perform to specification.
(split '())
;; => '(() ())
(split '(1))
;; => '((1) ())
(split '(1 2 3 4 5 6 7))
;; => '((1 3 5 7) (2 4 6))
Grouping the result in a list is an intuitive default, but it's probable that you plan to do something with the separate parts anyway
(define my-list '(1 2 3 4 5 6 7))
(let* ((result (split my-list)) ;; split the list into parts
(l (car result)) ;; get the "left" part
(r (cadr result))) ;; get the "right" part
(printf "odds: ~a, evens: ~a~n" l r))
;; odds: (1 3 5 7), evens: (2 4 6)
Above, continuation passing style gives us unique control over the returned result. The continuation is configurable at the call site, using a second parameter.
(split '(1 2 3 4 5 6 7) list) ;; same as default
;; '((1 3 5 7) (2 4 6))
(split '(1 2 3 4 5 6 7) cons)
;; '((1 3 5 7) 2 4 6)
(split '(1 2 3 4 5 6 7)
(λ (l r)
(printf "odds: ~a, evens: ~a~n" l r)))
;; odds: (1 3 5 7), evens: (2 4 6)
(split '(1 2 3 4 5 6 7)
(curry printf "odds: ~a, evens: ~a~n"))
;; odds: (1 3 5 7), evens: (2 4 6)
Oscar's answer using an auxiliary helper function or the first implementation in this post using loop are practical and idiomatic programs. Continuation passing style is a nice academic exercise, but I only demonstrated it here because it shows how to step around two complex tasks:
building up an output list without having to reverse it
returning multiple values
I don't have access to the definitions of make-pair and make-tuple that you're using. I can think of a recursive algorithm in terms of Scheme lists, it should be easy to adapt this to your requirements, just use make-tuple in place of list, make-pair in place of cons and make the necessary adjustments:
(define (split lst l1 l2)
(cond ((empty? lst) ; end of list with even number of elements
(list (reverse l1) (reverse l2))) ; return solution
((empty? (rest lst)) ; end of list with odd number of elements
(list (reverse (cons (first lst) l1)) (reverse l2))) ; return solution
(else ; advance two elements at a time, build two separate lists
(split (rest (rest lst)) (cons (first lst) l1) (cons (second lst) l2)))))
(define (split-list lst)
; call helper procedure with initial values
(split lst '() '()))
For example:
(split-list '(1 2))
=> '((1) (2))
(split-list '(1 2 3 4))
=> '((1 3) (2 4))
(split-list '(1 2 3))
=> '((1 3) (2))
(split-list '(1 2 3 4 5))
=> '((1 3 5) (2 4))
(split-list '(1 2 3 4 5 6))
=> '((1 3 5) (2 4 6))
split is kind of a de-interleave function. In many other languages, split names functions which create sublists/subsequences of a list/sequence which preserve the actual order. That is why I don't like to name this function split, because it changes the order of elements in some way.
Tail-call-rescursive solution
(define de-interleave (l (acc '(() ())))
(cond ((null? l) (map reverse acc)) ; reverse each inner list
((= (length l) 1)
(de-interleave '() (list (cons (first l) (first acc))
(second acc))))
(else
(de-interleave (cddr l) (list (cons (first l) (first acc))
(cons (second l) (second acc)))))))
You seem to be using the module deinprogramm/DMdA-vanilla.
The simplest way is to match the current state of the list and call it again with the rest:
(define split-list
(lambda (x)
(match x
;the result should always be a tuple
(empty (make-tuple empty empty))
((list a) (make-tuple (list a) empty))
((list a b) (make-tuple (list a) (list b)))
;call split-list with the remaining elements, then insert the first two elements to each list in the tuple
((make-pair a (make-pair b c))
((lambda (t)
(make-tuple (make-pair a (first-tuple t))
(make-pair b (rest-tuple t))))
(split-list c))))))

Output Elements in List That Are Not Incommon

I've created a function that should return the elements that the two lists do not have in common. Currently, they are outputting exactly what is passed into it. Any suggestions on how to fix this?
(define (findDifference lst1 lst2)
(if (null? lst1) lst2
(cons (car lst1) (findDifference (cdr lst1) lst2))))
(findDifference '(2 3 4 (2 3) 2 (4 5)) '(2 4 (4 5))
Current Output: (2 3 4 (2 3) 2 (4 5) 2 4 (4 5))
Desired Output: (3 (2 3))
You're asking for the symmetric difference of two lists. Try this:
(define (diff list1 list2)
(union (complement list1 list2)
(complement list2 list1)))
Using the following helper procedures:
(define (union list1 list2)
(cond ((null? list1) list2)
((member (car list1) list2) (union (cdr list1) list2))
(else (cons (car list1) (union (cdr list1) list2)))))
(define (complement list1 list2)
(cond ((null? list1) '())
((member (car list1) list2) (complement (cdr list1) list2))
(else (cons (car list1) (complement (cdr list1) list2)))))
Also notice that if you're using Racket you can simply use the built-in set-symmetric-difference procedure for the same effect. For example:
(diff '(2 3 4 (2 3) 2 (4 5)) '(2 4 (4 5)))
=> '(3 (2 3))
Since it seems like homework and I do not want to spoil the fun, here is the brute force algorithm, with some bits left out. If you are really stuck I will give you the full source.
(define (sym-diff xs ys)
;; Since we have the helper function we can determine all the elements that are in the first list,
;; but not in the second list.
;; Then we can pass this intermediate result to the second call to sym-diff-helper.
;;This will return us all the elements that are in the second list but not the first.
(let ((in-first-not-second ...))
(sym-diff-helper ys xs in-first-not-second)))
;; This function will return all the elements from the first list that are not in the second list!
(define (sym-diff-helper xs ys acc)
(cond
;; If the first list is empty we have checked it.
(...
acc)
;; If the first list is not empty yet, check if the first element
;; is in the second list.
;; If so, discard it and continue with the rest of the list.
((member ... ...)
(sym-diff-helper ... ... ...)
;; If the first element of the first list is not in the second list,
;; add it to the accumulator and continue with the rest of the list.
(else
(sym-diff-helper ... ... ...)))
(sym-diff-helper '(1 2 3) '(2 3 4) '())
;; == (1)
(sym-diff-helper '(1 2 (3 4) 5) '(2 3 4) '())
;; == (5 (3 4) 1)
(sym-diff '(2 3 4 (2 3) 2 (4 5)) '(2 4 (4 5)))
;; == ((2 3) 3)
Note that I have chosen to use member. There are a few other search functions but they were not well suited in this case. Hence, I left it there. More info on the search functions can be found here: http://docs.racket-lang.org/reference/pairs.html#%28part..List.Searching%29

Insert-everywhere procedure

I am trying to write a procedure that takes a a symbol and a list and inserts the symbol at every possible position inside the given list (thus generating a list of lists). I have coded the following definitions, which I must implement:
1
(define (insert-at pos elmt lst)
(if (empty? lst) (list elmt)
(if (= 1 pos)
(cons elmt lst)
(cons (first lst)
(insert-at (- pos 1) elmt (rest lst))))))
2
(define (generate-all-pos start end)
(if (= start end)
(list end)
(cons start (generate-all-pos (+ start 1) end))))
1 takes a position in a list (number), a symbol and the list itself and inserts the symbol at the requested position.
2 takes a start and a target position (numbers) and creates a sorted list with numbers from start to target.
So far I have got this:
(define (insert-everywhere sym los)
(cond
[(empty? los) (list sym)]
[else (cons (insert-at (first (generate-all-pos (first los)
(first (foldl cons empty los)))) sym los) (insert-everywhere sym (rest los)))
]
)
)
Which results in
> (insert-everywhere 'r '(1 2 3))
(list (list 'r 1 2 3) (list 2 'r 3) (list 3 'r) 'r)
so I actually managed to move the 'r' around. I'm kind of puzzled about preserving the preceding members of the list. Maybe I'm missing something very simple but I've stared and poked at the code for quite some time and this is the cleanest result I've had so far. Any help would be appreciated.
Óscar López's answer shows how you can do this in terms of the procedures that you've already defined. I'd like to point out a way to do this that recurses down the input list. It uses an auxiliary function called revappend (I've taken the name from Common Lisp's revappend). revappend takes a list and a tail, and efficiently returns the same thing that (append (reverse list) tail) would.
(define (revappend list tail)
(if (null? list)
tail
(revappend (rest list)
(list* (first list) tail))))
> (revappend '(3 2 1) '(4 5 6))
'(1 2 3 4 5 6)
The reason that we're interested in such a function is that as we recurse down the input list, we can build up a list of the elements we've already seen, but it's in reverse order. That is, as we walk down (1 2 3 4 5), it's easy to have:
rhead tail (revappend rhead (list* item tail))
----------- ----------- -----------------------------------
() (1 2 3 4 5) (r 1 2 3 4 5)
(1) (2 3 4 5) (1 r 2 3 4 5)
(2 1) (3 4 5) (1 2 r 3 4 5)
(3 2 1) (4 5) (1 2 3 r 4 5)
(4 3 2 1) (5) (1 2 3 4 r 5)
(5 4 3 2 1) () (1 2 3 4 5 r)
In each of these cases, (revappend rhead (list* item tail)) returns a list with item inserted in one of the positions. Thus, we can define insert-everywhere in terms of rhead and tail, and revappend, if we build up the results list in reverse order, and reverse it at the end of the loop.
(define (insert-everywhere item list)
(let ie ((tail list)
(rhead '())
(results '()))
(if (null? tail)
(reverse (list* (revappend rhead (list* item tail)) results))
(ie (rest tail)
(list* (first tail) rhead)
(list* (revappend rhead (list* item tail)) results)))))
(insert-everywhere 'r '(1 2 3))
;=> '((r 1 2 3) (1 r 2 3) (1 2 r 3) (1 2 3 r))
What's interesting about this is that the sublists all share the same tail structure. That is, the sublists share the structure as indicated in the following “diagram.”
;=> '((r 1 2 3) (1 r 2 3) (1 2 r 3) (1 2 3 r))
; ----- +++ o
; +++ o
; o
The insert-everywhere procedure is overly complicated, a simple map will do the trick. Try this:
(define (insert-everywhere sym los)
(map (lambda (i)
(insert-at i sym los))
(generate-all-pos 1 (add1 (length los)))))
Also notice that in Racket there exists a procedure called range, so you don't need to implement your own generate-all-pos:
(define (insert-everywhere sym los)
(map (lambda (i)
(insert-at i sym los))
(range 1 (+ 2 (length los)))))
Either way, it works as expected:
(insert-everywhere 'r '(1 2 3))
=> '((r 1 2 3) (1 r 2 3) (1 2 r 3) (1 2 3 r))

Resources