Creating a pair of pairs using Common Lisp - common-lisp

I need to create a pair that contains two pairs inside using Common Lisp.
The output needs to be:
((1 . 2) . (3 . 4))
Literature states (cons (cons 1 2) (cons 3 4)) should output what I need but when I run that I obtain:
((1 . 2) 3 . 4)
Any help is appreciated.

In Lisp
((1 . 2) . (3 . 4))
and
((1 . 2) 3 . 4)
are exactly the same thing. You can check by evaluating '((1 . 2) . (3 . 4)).
If you think about it the 3 is the car of the cdr, so it's the second element of the improper list, so the pair (1 . 2) is the first element, 3 as second element and that has 4 instead of NIL to terminate it.
They're just two ways to see the very same cons cells configuration:

CL-USER 4 > (equal '((1 . 2) . (3 . 4))
'((1 . 2) 3 . 4 ))
T

#xA is the exact same as 10, but when it's printed it's system settings that dictates how a number is to be printed. The reason is that the fixnum doesn't have a base, but the visual representation does. Just as #xA is the same as 10, ((1 . 2) . (3 . 4)) is the same as ((1 . 2) 3 . 4).
The illusion is that we have lists. In order to do that we display pairs with either nil or a pair as tails differently than pairs that has other values as their tail.. A list (1 2) is modeled as (1 . (2 . ())). The rules are something like this: Whenever the tail is nil or a pair you can omit this pair dot and the first parenthesis of the tail. Apply it recursively and (1 . (2 . ())) displays as (1 2) and ((1 . 2) . (3 . 4)) displays as `((1 . 2) 3 . 4).
To make the illusion complete the reader does the reverse so when it reads (1 2) it creates (1 . (2 . ())) in memory.
To really be a good Lisp programmer (in any dialect) you need to be able to see the omitted dot and parentheses in (1 2). When you do it becomes obvious what you need to do with (a (b c) d) in order to retrieve c (It's obviously (cadadr '(a (b c) d))). When you do master this you'll "see" ((1 . 2) . (3 . 4)).

This will do it: (cons (cons 1 2) (cons (cons 3 4) empty))
Good luck!

Related

Not sure why let function isn't properly returning the value in sbcl lisp

So I have written a function to sort a list of Unordered pairs by their 'value' (the second part of the pair). Here is my attempt at a recursive function (I know it has a rudimentary design):
*Edit function design: the function works by:
Taking a list of unordered pairs, a list of sorted frequencies, and an optional startList for recursive calls. It first sets listRet equal to the startList.
If the unordered list has only one element, that element is pushed to listRet.
If the list is larger than 1 each pair of the unordred list is looped through and checked if it equals the first element of the ordered frequency list.
If it is not the last element, it is pushed to the listRet.
The loop then continues until it hits the last element and then the function is called recursively with the pushed pair removed from the unordered list since it has been properly placed into the listRet and the top most frequency. The listRet is put in place as the optional startList parameter.
Now in the case when the unordered list has more than one element and the last element is the correct frequency to sort, I opt to move that element to the front of the list and make a recursive call.
The first element of the unordered list can now be pulled off and then I abuse the do loop to reach the end of the list and again make a recursive function call as in step 5.
First If statement exits after unordered list is length one (as in step 2) and the listRet should be returned.
Function:
(defun sort-by-freq (listUnord listOrdFreqs &optional startList)
(print startList)
(let ((listRet startList)) ;; step 1
(if (equal (length listUnord) 1) ;;step 2
;;(print listRet)
(push (car listUnord) listRet)
(loop for pair in listUnord ;;step 3
do (if (and (equal (cdr pair) (car listOrdFreqs))
(not (equal (last-element-by-pair listUnord)(car pair))))
(push pair listRet) ;;step 4
(if (and (equal (cdr pair) (car listOrdFreqs))
(equal (last-element-by-pair listUnord)(car pair)))
(sort-by-freq (append (list (cons (car pair) (cdr pair)))
(remove-element listUnord pair))
listOrdFreqs listRet) ;;step 6
(if (equal (last-element-by-pair listUnord)(car pair))
(sort-by-freq (remove-element listUnord (car listRet))
(cdr listOrdFreqs)
listRet)))))) ;; step 5
listRet)) ;;step 8
So if I call:
(sort-by-freq (list(cons 'c 2)(cons 'b 3)(cons 'a 1)) '(3 2 1))
I expect the result:
((A . 1) (C . 2) (B . 3))
But for some reason, in the return I am getting only:
((B . 3))
Using the (print startList) statement I can confirm that the startList is building as I hoped. It outputs:
NIL
((B . 3))
((B . 3))
((C . 2) (B . 3))
And I have confirmed via the commented out ;;(print retList) that the exit condition is being reached after ((C . 2) (B . 3)) is output. (push (car listUnord) listRet) should be pushing the third element (A . 1) to the front of the list and returning listRet. This is consistent with how I have designed other functions with outputs and it has worked.
What am I missing?
*Edit here are the two helper functions I use:
(defun remove-element (origPairList origPair)
(let ((retlist (list)))
(loop for pair in origPairList
do (if (not(equal(car origPair)(car pair)))
(push pair retlist)))
retlist))
(defun last-element-by-pair (pairList)
(let ((lastEl (car (car pairList))))
(if (not (null (cdr pairList)))
(loop for el in pairList
do (setf lastEl (car el))))
lastEl))
Some hints...
Simplify things:
(defun remove-element (origPairList origPair)
(let ((retlist (list)))
(loop for pair in origPairList
do (if (not(equal(car origPair)(car pair)))
(push pair retlist)))
retlist))
to
(defun remove-element (list pair)
(remove (car pair) list :key #'car))
and
(defun last-element-by-pair (pairList)
(let ((lastEl (car (car pairList))))
(if (not (null (cdr pairList)))
(loop for el in pairList
do (setf lastEl (car el))))
lastEl))
to
(defun last-element-by-pair (pair-list)
(caar (last pair-list)))
Awful car/cdr mess. Use destructuring in LOOP.
(loop for pair in foo ... (car pair) ... (cdr pair) ... (car pair) ...)
is
(loop for (head . tail) in foo ... head ... tail ... head ...)
Don't walk lists all the time
Then
(if (equal (length foo) 1) ...)
is
(if (and (consp foo) (rest foo)) ...) ; no need to traverse the list
Further Problems:
You also need to make sure that your code is correctly indented. Typically a keystroke in an editor to do that. Also your code was missing closing parentheses. The code is thus syntactically not correct.
(defun sort-by-freq (listUnord listOrdFreqs &optional startList)
(print startList)
(let ((listRet startList))
(if (equal (length listUnord) 1)
(push (car listUnord) listRet) ;; <- this makes no sense.
;; since you quit the function
;; there is no useful effect
(loop for pair in listUnord
do (if (and (equal (cdr pair) (car listOrdFreqs))
(not (equal (last-element-by-pair listUnord)(car pair) )))
(push pair listRet)
(if (and (equal (cdr pair) (car listOrdFreqs))
(equal (last-element-by-pair listUnord)(car pair)))
;; this call to sort-by-freq makes no sense.
;; you are not using the return value
(sort-by-freq ;; what are you appending here, only one list?
(append (list (cons (car pair) (cdr pair))
(remove-element listUnord pair)))
listOrdFreqs
listRet)
(if (equal (last-element-by-pair listUnord)(car pair))
;; this call to sort-by-freq makes no sense.
;; you are not using the return value
(sort-by-freq (remove-element listUnord (car listRet))
(cdr listOrdFreqs)
listRet))))))
listRet))
Basically in
(loop for e in list
do (compute-some-thing-and-return-it e))
it makes no sense to call the function, since the return value is not used. The only reason to call the function would be if it had side-effects.
Example:
CL-USER 310 > (loop for e in '(1 2 3 4)
do (if (evenp e)
(* e 10)
(* e 100)))
NIL
As you see, it returns NIL. Probably not what you want.
Main problem
You are evaluating expressions inside a loop, in a do clause. The
returned value is never going to be used anywhere.
The function's return value is given by the local variable listRet,
which is set at the beginning of the function and affected at exactly
2 places, the two calls to push. The first one happens only for an
input list of size 1. The second push happen only at step 4.
We can easily see that all other operations have no effect whatsoever
on the local listRet variable. Also, because sort-by-freq as well
as your auxiliary functions are pure (they never destroy parts of the
list structure pointed by listRet), you know also that the list is
not going to be modified by having its cons cells linked differently
over time.
Let's confirm this by tracing your code with your example:
(trace sort-by-freq last-element-by-pair remove-element)
When you evaluate your test, the following trace is emitted (output varies among implementations, here it is using SBCL):
0: (SORT-BY-FREQ ((C . 2) (B . 3) (A . 1)) (3 2 1))
1: (LAST-ELEMENT-BY-PAIR ((C . 2) (B . 3) (A . 1)))
1: LAST-ELEMENT-BY-PAIR returned A
1: (LAST-ELEMENT-BY-PAIR ((C . 2) (B . 3) (A . 1)))
1: LAST-ELEMENT-BY-PAIR returned A
1: (LAST-ELEMENT-BY-PAIR ((C . 2) (B . 3) (A . 1)))
1: LAST-ELEMENT-BY-PAIR returned A
1: (REMOVE-ELEMENT ((C . 2) (B . 3) (A . 1)) (B . 3))
1: REMOVE-ELEMENT returned ((A . 1) (C . 2))
1: (SORT-BY-FREQ ((A . 1) (C . 2)) (2 1) ((B . 3)))
2: (LAST-ELEMENT-BY-PAIR ((A . 1) (C . 2)))
2: LAST-ELEMENT-BY-PAIR returned C
2: (LAST-ELEMENT-BY-PAIR ((A . 1) (C . 2)))
2: LAST-ELEMENT-BY-PAIR returned C
2: (LAST-ELEMENT-BY-PAIR ((A . 1) (C . 2)))
2: LAST-ELEMENT-BY-PAIR returned C
2: (REMOVE-ELEMENT ((A . 1) (C . 2)) (C . 2))
2: REMOVE-ELEMENT returned ((A . 1))
2: (SORT-BY-FREQ ((C . 2) (A . 1)) (2 1) ((B . 3)))
3: (LAST-ELEMENT-BY-PAIR ((C . 2) (A . 1)))
3: LAST-ELEMENT-BY-PAIR returned A
3: (LAST-ELEMENT-BY-PAIR ((C . 2) (A . 1)))
3: LAST-ELEMENT-BY-PAIR returned A
3: (REMOVE-ELEMENT ((C . 2) (A . 1)) (C . 2))
3: REMOVE-ELEMENT returned ((A . 1))
3: (SORT-BY-FREQ ((A . 1)) (1) ((C . 2) (B . 3)))
3: SORT-BY-FREQ returned ((A . 1) (C . 2) (B . 3))
2: SORT-BY-FREQ returned ((C . 2) (B . 3))
1: SORT-BY-FREQ returned ((B . 3))
0: SORT-BY-FREQ returned ((B . 3))
A minor point that can be seen right there is that
last-element-by-pair is called many times with the same input, which
is wasteful. It could be called once before looping.
At level 0, the function iterates over pairs until it finds (B . 3),
whose frequency equals the first frequency in the second list. This is
step 4, and the pair is pushed in front of the list designated by the
local variable listRet in that invocation of sort-by-freq.
When the loop reaches the last element of the unordered list, the
functions is called recursively with (i) a new list of unordered pairs,
computed using remove-element, (ii) one less frequency, and (iii) the current
list bound to listRet.
But whatever happens during the recursive steps, and in particular no matter what result the recursive calls yield, the binding currently
in scope for listRet is not going to be modified anymore. Also, the
structure of the list currently pointed by listRet is not modified
(e.g. using nconc or rplacd).
All the work that is done at level 2 and below is about pushing values in
front of temporary variables locally named listRet, and then discarding them.
What am I missing?
The data flow from recursive invocations of sort-by-freq to the
current invocation of that function is broken, you have to express the
current result in terms of recursive results, OR you need to mutate
things (but this is discouraged).
Naming and user interfaces
Taking a list of unordered pairs, a list of sorted frequencies, and
an optional startList for recursive calls. It first sets listRet
equal to the startList.
Based on your specification, I would define the function as follows:
(defun sort-pairs-by-frequencies (pairs frequencies)
...)
Whether or not there need to be additional parameters for recursive
invocations is not a concern for the user of the function. That kind
of details should be left hidden, except if you really want your user
to be able to pass a list as a third argument.
Complex corner cases
If the unordered list has only one element, that element is pushed
to listRet. [...] If it is not the last element, it is pushed to the
listRet.
Functions that recurses over lists typically need only consider two
cases: empty and non-empty lists. The fact that you consider more
corner cases, like a list of one element or like when you check if an
element is the last one, is a huge red flag. There are problems that
needs to have complex base conditions, but this one can be done in a
simpler way.
Redundant tests
In addition to the many calls to last-element-by-pair, notice also
that you repeat tests at different points of your functions, even when
they are necessarily true in a given context.
(if (and (equal (cdr pair) (car listOrdFreqs))
(not (equal (last-element-by-pair listUnord)(car pair))))
(push pair listRet) ;;step 4
(if (and (equal (cdr pair) (car listOrdFreqs))
(equal (last-element-by-pair listUnord)(car pair)))
(sort-by-freq (append (list (cons (car pair) (cdr pair)))
(remove-element listUnord pair))
listOrdFreqs listRet) ;;step 6
(if (equal (last-element-by-pair listUnord)(car pair))
(sort-by-freq (remove-element listUnord (car listRet))
(cdr listOrdFreqs)
listRet))))
Given appropriate definitions, the above could be written:
(if (and A (not B))
(step-4)
(if (and A B)
(step-6)
(if B (step-5))))
Let's write what conditions are true for each step, based on which
branch they belong in the trees of if expressions:
For step 4: (and a (not b)) necessarily holds since it is in the "then" branch of the if.
For step 5: (and b (not a)), based on the following simplifications over the path predicate:
(and b
(not (and a b))
(not (and a (not b))))
=> (and b
(or (not a) (not b))
(or (not a) b))
=> (and b (or (not a) nil) t)
=> (and b (not a))
For step 6: (and a b)
Thus, you could write the test as:
(cond
(a (if b (step-6) (step-4)))
(b (step-5)))
Simpler version
If the list is larger than 1 each pair of the unordred list is
looped through and checked if it equals the first element of the
ordered frequency list.
This above is the core of the algorithm. For each frequency F, you
partition the unordered elements into two lists: the one where the
frequency equals to F, and the other ones.
Let's define just this: how to remove or keep an item based on whether
their frequency matches a given frequency. The following is not
necessarily efficient, but it works and is simple. Also, it errs on
the side of caution by using immutable operations only:
(defun remove-frequency (pairs frequency)
(remove frequency pairs :test #'= :key #'cdr))
(defun keep-frequency (pairs frequency)
(remove frequency pairs :test-not #'= :key #'cdr))
(remove-frequency '((a . 20) (b . 10) (c . 5) (d . 20)) 20)
=> ((B . 10) (C . 5))
(keep-frequency '((a . 20) (b . 10) (c . 5) (d . 20)) 20)
=> ((A . 20) (D . 20))
Then, your main function recurses over frequencies:
(defun sort-pairs-by-frequencies (pairs frequencies)
(if (null frequencies)
pairs
(destructuring-bind (frequency . frequencies) frequencies
(append (keep-frequency pairs frequency)
(sort-pairs-by-frequencies (remove-frequency pairs frequency)
frequencies)))))
When given no frequencies to sort by, the unsorted list of pairs is
returned. Otherwise, frequencies can be destructured as a cons cell,
where the first item is a frequency, and the remaining items are
frequencies. Note that the previous binding of frequencies is
shadowed, because from this point on we do not need to refer to the
whole list of frequencies anymore.
Then, the function's return value in the general case is computed by
appending pairs that have the given frequency and the list of
pairs that did not match frequency, recursively sorted according to
the remaining frequencies.
(sort-pairs-by-frequencies '((a . 20) (b . 10) (c . 5) (d . 20))
'(5 10 20))
=> ((C . 5) (B . 10) (A . 20) (D . 20))
By evaluating first (trace sort-pairs-by-frequencies), you also
obtain the following trace:
0: (SORT-PAIRS-BY-FREQUENCIES ((A . 20) (B . 10) (C . 5) (D . 20)) (5 10 20))
1: (SORT-PAIRS-BY-FREQUENCIES ((A . 20) (B . 10) (D . 20)) (10 20))
2: (SORT-PAIRS-BY-FREQUENCIES ((A . 20) (D . 20)) (20))
3: (SORT-PAIRS-BY-FREQUENCIES NIL NIL)
3: SORT-PAIRS-BY-FREQUENCIES returned NIL
2: SORT-PAIRS-BY-FREQUENCIES returned ((A . 20) (D . 20))
1: SORT-PAIRS-BY-FREQUENCIES returned ((B . 10) (A . 20) (D . 20))
0: SORT-PAIRS-BY-FREQUENCIES returned ((C . 5) (B . 10) (A . 20) (D . 20))
The above functions were written so that they could be easily readable
and "trivially" correct, but they are still wasting memory and stack. Other approaches are possible to sort elements in place (no memory allocation) using a loop (constant stack usage).
I figured it out using a less complex solution. While I acknowledge that the other posters here have written more elegant solutions, they are very unrelated to my attempt. I wanted to take on the problem using basic syntax that I understand at this point.
Here is what my new sort-by-frequency function looks like:
(defun sort-by-frequency (pairs frequencies)
(let ((retList (list)))
(loop for freq in frequencies
do (push (extract-pair-match pairs freq (extract-keys retList)) retList))
retList))
I now use a simple loop to iterate through the list of frequencies and then find a match based on the frequency using the function extract-pair-match, which also takes the keys (extract-keys) from the variable retList so that it can search through and make sure that the same key doesn't appear twice.
Here is the function:
(defun extract-pair-match(pairs match keys)
(if (and (equal (cdr(car pairs)) match) (not (search-keys keys (car(car pairs)))))
(car pairs)
(extract-pair-match (cdr pairs) match keys)))
First it checks the first term of the list pairs to see if its key matches match, it then uses the function search-keys on the keys list (which is passed at the retList in sort-by-frequency to make sure that the key is not already part of the list. If it is it continues to the next term. The assumption made is that each frequency will have one match.
Here is the search-keys function:
(defun search-keys (keys match)
(if (null keys)
nil
(if (equal (car keys) match)
(car keys)
(search-keys (cdr keys) match))))
Here is the extract-keys function:
(defun extract-keys (pairList)
(let ((retlist (list (car (car pairList)))))
(loop for pair in (cdr pairList)
do (push (car pair) retlist))
retlist))
So now if I do:
(sort-by-frequency (list(cons 'c 2)(cons 'b 3)(cons 'a 1)) '(1 2 3))
I get:
((A . 1) (C . 2) (B . 3))

Scheme: given a list of lists and a permutation, permute

I am practicing for my programming paradigms exam and working through problem sets I come to this problem. This is the first problem after reversing and joining lists recursively, so I suppose there is an elegant recursive solution.
I am given a list of lists and a permutation. I should permute every list including a list of lists with that specified permutation.
I am given an example:
->(permute '((1 2 3) (a b c) (5 6 7)) '(1 3 2))
->((1 3 2) (5 7 6) (a c b))
I have no idea even how to start. I need to formulate the problem in recursive interpretation to be able to solve it, but I can not figure out how.
Well, let's see how we can break this problem down. We are given a list of lists, and a list of numbers, and we want to order each list according to the order specified by the list of numbers:
=>(permute '((1 2 3) (4 5 6)) '(3 2 1))
'((3 2 1) (6 5 4))
We can see that each list in the list of lists can be handled separately, their solutions are unrelated to each other. So we can have a helper permute1 that handles the case of one list, then use map to apply this function to each of the lists (with the same ordering each time):
(define (permute lists ordering)
(map (lambda (xs) (permute1 xs ordering))
lists))
(define (permute1 items ordering)
...)
Now, to calculate (permute1 '(4 5 6) '(3 2 1)), what we mean is:
The first item of the new list will be the 3rd item of items, because the first number in ordering is 3.
The rest of the items of the new list will be determined by using the rest of the numbers in the ordering.
If the ordering is the empty list, return the empty list.
This forms the base case (3), the recursive case (1), and the steps to recur deeper (2). So a sketch of our solution would look like:
(define (permute1 items ordering)
(if (empty? ordering)
'()
(let ([next-item ???])
(??? next-item
(permute1 items (rest ordering))))))
Where the ???s represent getting the item based on the first number in ordering and combining this item with the remainder of the calculation, respectively.
Here's another option, using higher-order functions. This is the idiomatic way to think about a solution in a functional language - we split the problem in sub-problems, solve each one using existing procedures and finally we compose the answer:
(define (atom? x)
(and (not (null? x))
(not (pair? x))))
(define (perm lst order)
(foldr (lambda (idx acc)
(cons (list-ref lst (sub1 idx)) acc))
'()
order))
(define (permute lst order)
(if (atom? lst)
lst
(perm (map (lambda (x) (permute x order)) lst)
order)))
We start by defining atom?, a generic predicate and perm, a helper that will reorder any given list according to the ordering specified in one of its parameters. It uses foldr to build the output list and list-ref to access elements in a list, given its 0-based indexes (that's why we subtract one from each index).
The main permute function takes care of (recursively) mapping perm on each element of an arbitrarily nested input list, so we can obtain the desired result:
(permute '((1 2 3) (a b c) (5 6 7)) '(1 3 2))
=> '((1 3 2) (5 7 6) (a c b))
I am given an example:
(permute ('(1 2 3) '(a b c) '(5 6 7)) '(1 3 2))
((1 3 2) (5 7 6) (a c b))
The syntax you've given isn't correct, and will cause an error, but it's fairly clear what you mean. You want that
(permute '((1 2 3) (a b c) (5 6 7)) '(1 3 2))
;=> ((1 3 2) (5 7 6) (a c b))
Now, it's not clear how you're indicating the permutation. Is '(1 3 2) a permutation because it has some (1-based) indices, and indicates the way to rearrange elements, or is it because it is actually a permutation of the elements of the first list of the first list? E.g., would
(permute '((x y z) (a b c) (5 6 7)) '(1 3 2))
;=> ((x z y) (5 7 6) (a c b))
work too? I'm going to assume that it would, because it will make the problem much easier.
I have no idea even how to start. I need to formulate the problem in
recursive interpretation to be able to solve it, but I can not figure
out how.
You need to write a function that can take a list of indices, and that returns a function that will perform the permutation. E.g,.
(define (make-permutation indices)
…)
such that
((make-permutation '(3 1 2)) '(a b c))
;=> (c a b)
One you have that, it sounds like your permute function is pretty simple:
(define (permute lists indices)
(let ((p (make-permutation indices)))
(p (map p lists))))
That would handle the case you've given in your example, since (map p lists) will return ((1 3 2) (a b c) (5 7 6)), and then calling p with that will return ((1 3 2) (5 7 6) (a c b)). If you need to be able to handle more deeply nested lists, you'll need to implement a recursive mapping function.
Here's my take, which seems to be shorter than the previous examples:
(define (permute lst ord)
(define ord-1 (map sub1 ord)) ; change from 1-based to 0-based indexes
(define (perm elts) ; recursive sub-procedure
(if (list? elts)
(map perm (map (curry list-ref elts) ord-1)) ; list -> recurse
elts)) ; else return unchanged
(perm lst)) ; initial call
testing
> (permute '((1 2 3) (a b c) (5 6 7)) '(1 3 2))
'((1 3 2) (5 7 6) (a c b))
> (permute '((1 (i permute did) 3) (a b (scheme cool is)) (5 6 7)) '(1 3 2))
'((1 3 (i did permute)) (5 7 6) (a (scheme is cool) b))

How to flatten nested series?

Using SERIES library from CLTL2 appendix A, I want a flat series from nested series. For example:
(map-fn t (lambda (x)
(map-fn t (lambda (y)
(cons x y))
(scan '(1 2 3))))
(scan '(4 5 6)))
=> #Z( #Z( (4 . 1) (4 . 2) (4 . 3) )
#Z( (5 . 1) (5 . 2) (5 . 3) )
#Z( (6 . 1) (6 . 2) (6 . 3) ) )
I want to make this series of series to one series as below:
=> #Z( (4 . 1) (4 . 2) (4 . 3)
(5 . 1) (5 . 2) (5 . 3)
(6 . 1) (6 . 2) (6 . 3) )
If I would have an appropriate series concatenation function, it would be good. Although the series library has CATENATE function, it takes just some series in its &rest parameter. I could
(apply #'catenate list-of-series)
but it accepts a list of series, not series of series. Unfortunately, there are not any functions for folding series, while there are for mapping and filtering. The PRODUCING macro shown on A.4. Primitives section in CLTL2 does not work for me because it also seems not to flatten a nested loop. I cannot use NEXT-OUT macro in nested situation.
(apply #'catenate
(collect (map-fn t (lambda (x)
(map-fn t (lambda (y)
(cons x y))
(scan '(1 2 3))))
(scan '(4 5 6)))))
But that is bit of a cheat. To do it properly in series:
(producing (prod) ((zz (generator (map-fn t (lambda (x)
(map-fn t (lambda (y)
(cons x y))
(scan '(1 2 3))))
(scan '(4 5 6)))))
cur)
(loop
(tagbody
redo
(if (null cur)
(setq cur (generator (next-in zz (terminate-producing)))))
(next-out prod (next-in cur (progn
(setq cur nil)
(go redo)))))))
=> #Z((4 . 1) (4 . 2) (4 . 3)
(5 . 1) (5 . 2) (5 . 3)
(6 . 1) (6 . 2) (6 . 3))

How can I recursively print the elements of a list twice?

I need to write a recursive function that prints out the elements of a list twice. For example, rdouble '(1 2 3) would print (1 1 2 2 3 3) and rdouble'(1 (2 3) 4) would print (1 1 (2 2 3 3) 4 4).
So far I have:
(defun rdouble(struct)
(cond
((atom struct) struct)
(t (cons (rdouble (car struct)) (cons (car struct)
(rdouble (cdr struct))
)))))
This works fine for the first example but prints
(1 1 (2 2 3 3) (2 3) 4 4)
for the second example. How do I continue to print out each element twice but not reprint (2 3)? What am I doing wrong and how can I fix it?
The expression has THREE different cases:
an atom -> return it
a cons with an atom as the CAR -> double it
a cons with a cons as the CAR -> walk down
Your code handles only two cases, where your second case mixes 2 and 3.
the reason it is causing the problems you are experiencing is that given ((1 2) 3) your code recurses into (1 2), which correctly becomes (1 1 2 2) and then adds (1 2) (being the car in the first call) after the (1 1 2 2) giving ((1 1 2 2) (1 2) ...)
what would be best is to make rdouble always return a list, and append those lists together instead of consing them

Function Table in Scheme using Association List

I am attempting to build a rudimentary interpreter in Scheme, and I want to use an association list to map to arithmetic functions. This is what i have so far:
; A data type defining an abstract binary operation
(define binoptable
'(("+" . (+ x y)))
("-" . (- x y))
("*" . (* x y))
("/" . (/ x y)))
)
The problem is the elements on the RHS of the table are stored as lists of symbols. Does anyone have any ideas as to how to remedy his. Thanks in advance.
You probably want:
(define binoptable
`(("+" . ,+)
("-" . ,-)
("*" . ,*)
("/" . ,/)))
Also, you can use a macro to make it easier to specify:
(define-syntax make-binops
(syntax-rules ()
[(make-binops op ...)
(list (cons (symbol->string 'op) op) ...)]))
(define binoptable (make-binops + - * /))

Resources