Iterate over 2 lists in parallel in CLISP - lisp

I'm newbie trying to iterate over 2 lists in parallel, like this:
(defun test-do* (l1 l2)
(do* ((temp1 l1 (cdr l1))
(var1 (car temp1) (car temp1))
(temp2 l2 (cdr l2))
(var2 (car temp2) (car temp2)))
((endp temp1) 'end-of-l1) ))
The problem is that I got an infinite loop in my code and I don't know why.
Your help would be appreciated.

I'm not certain exactly what you're trying to do, but this modification to your code fixes the infinite loop:
(defun test-do* (l1 l2)
(do* ((temp1 l1 (cdr temp1))
(var1 (car temp1) (car temp1))
(temp2 l2 (cdr temp2))
(var2 (car temp2) (car temp2)))
((endp temp1) 'end-of-l1) ))
Consider one of the statements in your do* loop:
(temp1 l1 (cdr l1))
Translated to english (in the context of a do* loop), this means: " This is not what you want, as the value of l1 is never changing, and so temp1 is assigned the same value on every iteration after the first. Consider this modification:
(temp1 l1 (cdr temp1))
This means: "On the first iteration, set temp1 to the value of l1. On each subsequent iteration, set temp1 to the value of (cdr temp1)." This way, the value of temp1 on each iteration depends on the value of temp1 on the previous iteration, and your loop steps through the list like you intended.

(loop for x in '(a b c d e)
for y in '(1 2 3 4 5)
collect (list x y) )
((A 1) (B 2) (C 3) (D 4) (E 5))

Related

How the map function implemeted in racket

How does the map function implemented in racket and why, recursion or iteration.
Maybe some implementation example
How to implement map
The map function walks a list (or multiple lists), and applies a given function to every value of a list. For example mappiing add1 to a list results in:
> (map add1 '(1 2 3 4))
'(2 3 4 5)
As such, you can implement map as a recursive function:
(define (map func lst)
(if (empty? lst)
'()
(cons (func (first lst)) (map func (rest lst)))))
Of course, map can accept any number of arguments, with each element passed to the given prop. For example, you can zip two lists together using map list:
> (map list '(1 2 3) '(a b c))
'((1 a) (2 b) (3 c))
To implement this variable arity map, we need to make use of the apply function:
(define (map proc lst . lst*)
(if (empty? lst)
'()
(cons (apply proc (first lst) (map first lst*))
(apply map proc (rest lst) (map rest lst*)))))
Now, this does assume all of the given lists have the same length, otherwise you will get some unexpected behavior. To do that right you would want to run empty? on all lists, not just the first one. But...when you use it, you get:
> (map list '(a b c) '(1 2 3))
'((a 1) (b 2) (c 3))
Note that map here calls itself recursively 3 times. A faster implementation might do some unrolling to run faster. A better implementation would also do proper error checking, which I have elided for this example.
How Racket's map is implemented
If you open up DrRacket (using the latest Racket 7 nightly) and make the following file:
#lang racket
map
You can now right click on map and select Open Defining File. From here, you can see that map is renamed from the definition map2. The definition of which is:
(define map2
(let ([map
(case-lambda
[(f l)
(if (or-unsafe (and (procedure? f)
(procedure-arity-includes? f 1)
(list? l)))
(let loop ([l l])
(cond
[(null? l) null]
[else
(let ([r (cdr l)]) ; so `l` is not necessarily retained during `f`
(cons (f (car l)) (loop r)))]))
(gen-map f (list l)))]
[(f l1 l2)
(if (or-unsafe
(and (procedure? f)
(procedure-arity-includes? f 2)
(list? l1)
(list? l2)
(= (length l1) (length l2))))
(let loop ([l1 l1] [l2 l2])
(cond
[(null? l1) null]
[else
(let ([r1 (cdr l1)]
[r2 (cdr l2)])
(cons (f (car l1) (car l2))
(loop r1 r2)))]))
(gen-map f (list l1 l2)))]
[(f l . args) (gen-map f (cons l args))])])
map))

I don't know what this function should do

I have here a function that I need to modify so that I would avoid the double recursive call of (f (car l)) . First of all I can't figure it out what it shows..
If I pass (f '((3 4) 5 6)) it shows me CAR: 3 is not a list
Can anybody help me understand and then modify it?
(DEFUN F (L)
(COND
((NULL L) 0)
((> (f (car l)) 2) (+ (car l) (f (cdr l))))
(T (f (CAR L)))
))
You can figure out what this function should accept as input by looking at what it does with the input, and what it returns by looking at what each case returns. There are three cases:
Case 1
((NULL L) 0)
In this case, L can be nil, and 0, which is a number, is returned.
Case 2
((> (f (car l)) 2) (+ (car l) (f (cdr l))))
In this case, we call both car and cdr on l, so l had better be a cons. We also compare (f (car l)) with 2, so f must return a number, at least for whatever type (car l) is. Since we're calling + with (car l), (car l) must be a number. So f must return a number when given a number. Now, we're also calling + with (f (cdr l)), so whatever type (cdr l) has, f had better return a number for it, too.
Case 3
(T (f (CAR L)))
This doesn't put many constraints on us. This just says that if we didn't have either of the first two cases, then we return (f (car l)). Since checking the second case didn't fail, and because we're calling (car l), l still has to be a cons in this case.
So what is f?
Well, it's still not immediately clear what f is, but we can write it as a piecewise function, and maybe that will help. It take a list, which is either the empty list or a cons that has a first and a rest.
f [] = 0
f x:xs = if (f x) > 2
then x + (f xs)
else (f x)
To modify it so that you only call (f (car l)) is easy enough, although since we know that the input needs to be a list, I'm going to use first and rest to suggest that, rather than car and cdr.
(defun f (list)
(if (endp list)
0
(let ((tmp (f (first list))))
(if (> tmp 2)
(+ (first list)
(f (rest list)))
tmp))))
Let's try to walk through some possible inputs and try to cover the different code branches. What sort of input could we call this with? Well, we can call it with ():
CL-USER> (f '())
0
That takes care of the first then branch. Now what if we want to hit the second? Then we need to pass something that's not the empty list, so it looks like (? . ??). Now the first thing that has to happen is a recursive call to(f (first list)). The only way that this is going to work is if(first list)is also a list that we can pass tofand get a value back. Then(first list)` must have either been the empty list or another suitable list. So we can call:
CL-USER> (f '(() a b c))
0
In general, we can call f with () and with any list such that (first (first (first ... (first list)))) is (). Can we call it with anything else? It doesn't appear so. So now we know what the acceptable inputs to f are:
input ::= ()
| (input . anything)
and the output will always be 0.

Lisp function explanation

I have this example in LISP that removes from every level of a list a given number:
(defun remove_aux (e l)
(cond
((equal e l) nil)
((atom l) (list l))
(t(list(apply 'append (mapcar #'(lambda (l) (remove_aux e l)) l))))))
(defun remove_el (e l)
(car (remove_aux e l)))
So, if it run like this: (remove_el 2 '(1 2 3 ((2 3 2) 4))) => (1 3 ((3) 4))
What I don't exactly understand is how this line works: (t(list(apply 'append (mapcar #'(lambda (l) (sterge_aux e l)) l))))
If I have the line without list and append ((t(mapcar #'(lambda (l) (remove_aux e l)) l))) the result is ((1) NIL (3) ((NIL (3) NIL) (4)))) if it has append but not list ( (t(apply 'append (mapcar #'(lambda (l) (remove_aux e l)) l))) ) then the result is (1 3 3 4) and I don't get why because I did (apply 'append '((1) NIL (3) ((NIL (3) NIL) (4))))) in the Common Lisp console and the result was ((1 3 (NIL (3) NIL) (4))) so I'm really confused. Can somebody explain to me how this all works step by step?
I've annotated the code below to, I hope, explain what's going on. You're probably getting confused because l is getting redefined within a lambda... so the t line (in your example) has 2 "l"s on it but the first one isn't the same as the second one.
(defun remove_aux (e l)
(cond
((equal e l) nil) ;if e equals l return nil
((atom l) (list l)) ;if l is an atom return a list with just l in it
(t ; otherwise...
(list ;create a list
(apply 'append ; whose contents are created by appending
; together the lists that come out of this mapcar
; (apply the append method)
(mapcar #'(lambda (l) ( ; iterate over each of the elements in list l
; the one after the lambda not the one
; being passed to the lambda.
; (this is a horrible name choice
; lambda(l-item) would be much better)
remove_aux e l
; recursively call this method
; with e (which was passed in at the start)
; and l which isn't the l passed in,
; but is an entry of it (see why naming's
; so important?)
; this returns a list
; which will get appended by the append
; with the results of all the other calls
; to remove_aux for each item in the outer l
)
) l)
)))))
(defun remove_el (e l)
(car (remove_aux e l)
)
)
;; append elements of each list in argument together
(append '(a) '(b) '(c d) '(e)) ; ==> (a b c d e)
;; append elements of each sublist in argument
(apply #'append '((a) (b) (c d) (e))) ; ==> (a b c d e)
;; apply function on each element of list into new list
(mapcar #'(lambda (x) (+ x 1)) '(1 3 5 6)) ; ==> (2 4 6 7)
So what does the default case do in your function.. Well it applies itself to each sublist of lst and wrap it in a list so if l is '(a y 2 z) and e is 2, well then the result from mapcar is '((a) (y) () (z)) which is then the argument to apply-append which connects the elements together into one list again. When connecting the lists the element that was to be removed is an empty list and it's effectively ignored in the concatenation process.
Since all the lists appended you create in the helper, you could replace the apply-append with (mapcan #'(lambda (l) (remove_aux e l)) l). A more obvious way to do this would be using reduce while a more efficient way might use loop.
A procedure that achieve what you want to achieve is essentially like below procedure:
(defun remove-all (e l)"Removes all occurrences of e from a list l."
(cond
((null l) '())
((equal e (car l)) (remove-all e (cdr l)))
((not (atom (car l)))
(cons (remove-all e (car l))
(remove-all e (cdr l))))
(t (cons (car l)
(remove-all e (cdr l))))))
;note: the e is not neccessarily an atom, the l is not necessarily a list of atoms.
The procedure in your question has unnecessarily cluttered pieces, like append, maps etc.
if you recomment below i will explain the algorithm.
have a nice hack.

Scheme, N-queens optimization strategies SICP chapter 2

SICP contains an partially complete example of the n-queens solutions, by walking a tree of every possible queen placement in the last row, generating more possible positions in the next row to combine the results so far, filtering the possibilities to keep only ones where the newest queen is safe, and repeating recursively.
This strategy blows up after about n=11 with a maximum recursion error.
I've implemented an alternate strategy that does a smarter tree-walk from the first column, generating possible positions from a list of unused rows, consing each position-list onto an updated list of yet-unused rows. Filtering those pairs considered safe, and recursively mapping over these pairs for the next column. This doesn't blow up (so far) but n=12 takes a minute and n=13 takes about 10 minutes to solve.
(define (queens board-size)
(let loop ((k 1) (pp-pair (cons '() (enumerate-interval 1 board-size))))
(let ((position (car pp-pair))
(potential-rows (cdr pp-pair)))
(if (> k board-size)
(list position)
(flatmap (lambda (pp-pair) (loop (++ k) pp-pair))
(filter (lambda (pp-pair) (safe? k (car pp-pair))) ;keep only safe
(map (lambda (new-row)
(cons (adjoin-position new-row k position)
(remove-row new-row potential-rows))) ;make pp-pair
potential-rows)))))))
;auxiliary functions not listed
Not really looking for code, but a simple explanation of a strategy or two that's less naive and that clicks well with a functional approach.
I can offer you a simplification of your code, so it may run a little bit faster. We start by renaming some variables for improved readability (YMMV),
(define (queens board-size)
(let loop ((k 1)
(pd (cons '() (enumerate-interval 1 board-size))))
(let ((position (car pd))
(domain (cdr pd)))
(if (> k board-size)
(list position)
(flatmap (lambda (pd) (loop (1+ k) pd))
(filter (lambda (pd) (safe? k (car pd))) ;keep only safe NewPositions
(map (lambda (row)
(cons (adjoin-position row k position) ;NewPosition
(remove-row row domain))) ;make new PD for each Row in D
domain))))))) ; D
Now, filter f (map g d) == flatmap (\x->let {y=g x} in [y | f y]) d (using a bit of Haskell syntax there), i.e. we can fuse the map and the filter into one flatmap:
(flatmap (lambda (pd) (loop (1+ k) pd))
(flatmap (lambda (row) ;keep only safe NewPositions
(let ( (p (adjoin-position row k position))
(d (remove-row row domain)))
(if (safe? k p)
(list (cons p d))
'())))
domain))
then, flatmap h (flatmap g d) == flatmap (h <=< g) d (where <=< is right-to-left Kleisli composition operator, but who cares), so we can fuse the two flatmaps into just one, with
(flatmap
(lambda (row) ;keep only safe NewPositions
(let ((p (adjoin-position row k position)))
(if (safe? k p)
(loop (1+ k) (cons p (remove-row row domain)))
'())))
domain)
so the simplified code is
(define (queens board-size)
(let loop ((k 1)
(position '())
(domain (enumerate-interval 1 board-size)))
(if (> k board-size)
(list position)
(flatmap
(lambda (row) ;use only the safe picks
(if (safe_row? row k position) ;better to test before consing
(loop (1+ k) (adjoin-position row k position)
(remove-row row domain))
'()))
domain))))
Here's what I came up with a second time around. Not sure it's terribly much faster though. Quite a bit prettier though.
(define (n-queens n)
(let loop ((k 1) (r 1) (dangers (starting-dangers n)) (res '()) (solutions '()))
(cond ((> k n) (cons res solutions))
((> r n) solutions)
((safe? r k dangers)
(let ((this (loop (+ k 1) 1 (update-dangers r k dangers)
(cons (cons r k) res) solutions)))
(loop k (+ r 1) dangers res this)))
(else (loop k (+ r 1) dangers res solutions)))))
Big thing is using a let statement to serialize recursion, limiting depth to n. Solutions come out backwards (could probably fix by going n->1 instead of 1->n on r and k) but a backwards set is the same set as the frowards set.
(define (starting-dangers n)
(list (list)
(list (- n))
(list (+ (* 2 n) 1))))
;;instead of terminating in null list, terminate in term that cant threaten
small improvement, a danger can come from a row, a down diagonal, or and up diagonal, keep track of each as the board evolves.
(define (safe? r k dangers)
(and (let loop ((rdangers (rdang dangers)))
(cond ((null? rdangers) #t)
((= r (car rdangers))
#f)
(else (loop (cdr rdangers)))))
(let ((ddiag (- k r)))
(let loop ((ddangers (ddang dangers)))
(if (<= (car ddangers) ddiag)
(if (= (car ddangers) ddiag)
#f
#t)
(loop (cdr ddangers)))))
(let ((udiag (+ k r)))
(let loop ((udangers (udang dangers)))
(if (>= (car udangers) udiag)
(if (= (car udangers) udiag)
#f
#t)
(loop (cdr udangers)))))))
medium improvement in the change of format, only needing to do one comparison to check vs prior two. Don't think keeiping diagonals sorted cost me anything, but I don't think it saves time either.
(define (update-dangers r k dangers)
(list
(cons r (rdang dangers))
(insert (- k r) (ddang dangers) >)
(insert (+ k r) (udang dangers) <)))
(define (insert x sL pred)
(let loop ((L sL))
(cond ((null? L) (list x))
((pred x (car L))
(cons x L))
(else (cons (car L)
(loop (cdr L)))))))
(define (rdang dangers)
(car dangers))
(define (ddang dangers)
(cadr dangers))
(define (udang dangers)
(caddr dangers))

How do I find the index of an element in a list in Racket?

This is trivial implement of course, but I feel there is certainly something built in to Racket that does this. Am I correct in that intuition, and if so, what is the function?
Strangely, there isn't a built-in procedure in Racket for finding the 0-based index of an element in a list (the opposite procedure does exist, it's called list-ref). However, it's not hard to implement efficiently:
(define (index-of lst ele)
(let loop ((lst lst)
(idx 0))
(cond ((empty? lst) #f)
((equal? (first lst) ele) idx)
(else (loop (rest lst) (add1 idx))))))
But there is a similar procedure in srfi/1, it's called list-index and you can get the desired effect by passing the right parameters:
(require srfi/1)
(list-index (curry equal? 3) '(1 2 3 4 5))
=> 2
(list-index (curry equal? 6) '(1 2 3 4 5))
=> #f
UPDATE
As of Racket 6.7, index-of is now part of the standard library. Enjoy!
Here's a very simple implementation:
(define (index-of l x)
(for/or ([y l] [i (in-naturals)] #:when (equal? x y)) i))
And yes, something like this should be added to the standard library, but it's just a little tricky to do so nobody got there yet.
Note, however, that it's a feature that is very rarely useful -- since lists are usually taken as a sequence that is deconstructed using only the first/rest idiom rather than directly accessing elements. More than that, if you have a use for it and you're a newbie, then my first guess will be that you're misusing lists. Given that, the addition of such a function is likely to trip such newbies by making it more accessible. (But it will still be added, eventually.)
One can also use a built-in function 'member' which gives a sublist starting with the required item or #f if item does not exist in the list. Following compares the lengths of original list and the sublist returned by member:
(define (indexof n l)
(define sl (member n l))
(if sl
(- (length l)
(length sl))
#f))
For many situations, one may want indexes of all occurrences of item in the list. One can get a list of all indexes as follows:
(define (indexes_of1 x l)
(let loop ((l l)
(ol '())
(idx 0))
(cond
[(empty? l) (reverse ol)]
[(equal? (first l) x)
(loop (rest l)
(cons idx ol)
(add1 idx))]
[else
(loop (rest l)
ol
(add1 idx))])))
For/list can also be used for this:
(define (indexes_of2 x l)
(for/list ((i l)
(n (in-naturals))
#:when (equal? i x))
n))
Testing:
(indexes_of1 'a '(a b c a d e a f g))
(indexes_of2 'a '(a b c a d e a f g))
Output:
'(0 3 6)
'(0 3 6)