Creating a custom reverse of list - lisp

I'm trying to create a custom reverse of list in Lisp. I'm pretty new to Lisp programming, and still struggling with syntax. This is my code so far
(defun new-union(l1 l2)
(setq l (union l1 l2))
(let (res)
(loop for x in l
do(setq res (cons (car l) res))
do(setq l (cdr l)))))
Here I'm taking two lists, and forming union list l. Then for reversing the list l I'm accessing element wise to append it to a new list res. Then consequently using the cons, car and cdr to update the list.
However, I'm getting a weird output. Can someone please suggest where I'm going wrong?
I'm aware of an inbuilt function for the same called nreverse , but I wanted to experiment to see how the Lisp interprets the data in list.
On printing res at the end, for example
(new-union '(a b c) '(d e f))
the output for above call gives me
(L A A A A A A A X X)
I think I'm doing the looping wrong.

Problems
(summary of previous comments)
Bad indentation, spaces, and names; prefer this:
(defun new-union (l1 l2)
(setq list (union l1 l2))
(let (reversed)
(loop for x in list
do (setq res (cons (car list) reversed))
do (setq list (cdr list)))))
Usage of SETQ on undeclared, global variables, instead of a LET
Mutation of the structure being iterated (LIST)
Not using X inside the LOOP (why define it?)
The return value is always NIL
Refactoring
(defun new-union (l1 l2)
(let ((reverse))
(dolist (elt (union l1 l2) reverse)
(push elt reverse))))
Define a local reverse variable, bound to NIL by default (you could set it to '(), this is sometimes preferred).
Use DOLIST to iterate over a list and perform side-effects; the third argument is the return value; here you can put the reverse variable where we accumulate the reversed list.
For each element elt, push it in front of reverse; if you want to avoid push for learning purposes, use (setf reverse (cons elt reverse)).
Common Lisp is multi-paradigm and favors pragmatic solutions: sometimes a loop is more natural or more efficient, and there is no reason to force yourself to adopt a functional style.
Functional implementation
However, lists provide a natural inductive structure: recursive approaches may be more appropriate in some cases.
If you wanted to use a functional style to compute reverse, be aware that tail-call optimization, though commonly available, is not required by the language specification (it depends on your implementation capabilities and compiler options).
With default settings, SBCL eliminates calls in tail positions and would eliminate the risk of stack overflows with large inputs. But there are other possible ways to obtain bad algorithmic complexities (and wasteful code) if you are not careful.
The following is what I'd use to define the combination of union and reverse; in particular, I prefer to define a local function with labels to avoid calling new-union with a dummy nil parameter. Also, I iterate the list resulting from the union only once.
(defun new-union (l1 l2)
(labels ((rev (list acc)
(etypecase list
(null acc)
(cons (rev (rest list)
(cons (first list) acc))))))
(rev (union l1 l2) nil)))
Trace
0: (NEW-UNION (A B C) (D E F))
1: (UNION (A B C) (D E F))
1: UNION returned (C B A D E F)
1: (REV (C B A D E F) NIL)
2: (REV (B A D E F) (C))
3: (REV (A D E F) (B C))
4: (REV (D E F) (A B C))
5: (REV (E F) (D A B C))
6: (REV (F) (E D A B C))
7: (REV NIL (F E D A B C))
7: REV returned (F E D A B C)
6: REV returned (F E D A B C)
5: REV returned (F E D A B C)
4: REV returned (F E D A B C)
3: REV returned (F E D A B C)
2: REV returned (F E D A B C)
1: REV returned (F E D A B C)
0: NEW-UNION returned (F E D A B C)
Remark
It is quite surprising to reverse the result of union, when the union is supposed to operate on unordered sets: the order of elements in the result do not have to reflect the ordering of list-1 or list-2 in any way. Sets are unordered collections having no duplicates; if your input lists already represent sets, as hinted by the name of the function (new-union), then it makes no sense to remove duplicates or expect the order to be meaningful.
If, instead, the input lists represents sequences of values, then the order matters; feel free to use append or concatenate in combination with remove-duplicates, but note that the latter will remove elements in front of the list by default:
(remove-duplicates (concatenate 'list '(4 5 6) '(2 3 4)))
=> (5 6 2 3 4)
You may want to use :from-end t instead.

Ok...I think you want to take two lists, combine them together, remove duplicates, and then reverse them.
Your biggest problem is that you're using loops instead of recursion. LISP was born to do list processing using recursion. It's far more natural.
Below is a very simple example of how to do that:
(defvar l1 '(a b c)) ;first list
(defvar l2 '(d e f)) ;second list
(defun my-reverse (a b) ;a and b are lists
"combines a and b into lst, removes duplicates, and reverses using recursion"
(let ((lst (remove-duplicates (append a b))))
(if (> (length lst) 0)
(append (last lst) (my-reverse nil (butlast lst)))
nil)))
Sample Run compiled in SLIME using SBCL
; compilation finished in 0:00:00.010
CL-USER> l1 ;; verify l1 variable
(A B C)
CL-USER> l2 ;; verify l2 variable
(D E F)
CL-USER> (append l1 l2) ;; append l1 and l2
(A B C D E F)
CL-USER> (my-reverse l1 l2) ;; reverse l1 and l2
(F E D C B A)

Related

Extending a reduction relation

While taking a look at PLT redex, I wanted to play with simplification rules; so I defined this minimal language for booleans:
(define-language B0
(b T F (not b)))
I wanted to simplify a chain of (not (not ...)) so I extended the language to deal with contexts and defined a reduction relation to simplify the not:
(define-extended-language B1 B0
(C (not C) hole)
(BV T F))
(define red0
(reduction-relation
B1
(--> (in-hole C (not T)) (in-hole C F))
(--> (in-hole C (not F)) (in-hole C T))))
Now I wanted to extend my language to boolean equations and to allow not-simplification at each side of the equation, so I defined:
(define-extended-language B2 B1
(E (= C b) (= b C)))
hoping that:
(define red1
(extend-reduction-relation red0 B2))
will do the thing.
But no: red1 can reduce (not (not (not F))))) but not (= (not T) F)))
Am I doing something really silly here?
The problem with red1 is that it only contains the rules of red0 which use the limited context C. To make it work as expected you could either add the old rules modified to use E or make somehow the final extended context have the name C. One not very tedious approach could be:
(define-language L)
(define R
(reduction-relation L
(--> (not T) F)
(--> (not F) T)))
(define-language LB
(b T F (not b))
(C (compatible-closure-context b)))
(define RB (context-closure R LB C))
(define-extended-language LBE LB
(e (= b b))
(C .... (compatible-closure-context e #:wrt b)))
(define RBE (extend-reduction-relation RB LBE))
Note that this doesn't work in some older versions.
Two sources of useful information are this tutorial and of course the redex reference.

For loop which prints out every 3rd number

I'm trying to make a for loop that iterates over a list of numbers and prints out every 3rd number.
Edit: I've only figured out how to use the for loop but I'm not entirely sure if there's a specific function I can use to only show every 3rd number. I feel like I might be on the right path when using car/cdr function except I'm getting an error
rest: contract violation
expected: (and/c list? (not/c empty?))
given: 0
My code:
(for/list ([x (in-range 20)] #:when (car(cdr(cdr x)))) (displayln x))
I'm trying to make a for loop that iterates over a list of numbers and prints out every 3rd number.
Typically it is more useful to create a new list with the desired values, and then print those values, or pass them to a function, or do whatever else may be needed. for/list does indeed return a list, and this is one reason for problems encountered by OP example code. (Other problems in OP code include that x is a number with [x (in-range 20)], so (cdr x) is not defined).
A possible solution would be to recurse over the input list, using take to grab the next three values, keeping the third, and using drop to reduce the input list:
;; Recurse using `take` and `drop`:
(define (every-3rd-1 lst)
(if (< (length lst) 3)
'()
(cons (third (take lst 3))
(every-3rd-1 (drop lst 3)))))
Another option would be to recurse on the input list using an auxiliary counter; starting from 1, only keep the values from the input list when the counter is a multiple of 3:
;; Recurse using an auxilliary counter:
(define (every-3rd-2 lst)
(define (every-3rd-helper lst counter)
(cond [(null? lst)
'()]
[(zero? (remainder counter 3))
(cons (first lst) (every-3rd-helper (rest lst) (add1 counter)))]
[else (every-3rd-helper (rest lst) (add1 counter))]))
(every-3rd-helper lst 1))
Yet another possibility would be to use for/list to build a list; here i is bound to values from the input list, and counter is bound to values from a list of counting numbers:
;; Use `for/list` to build a list:
(define (every-3rd-3 lst)
(for/list ([i lst]
[counter (range 1 (add1 (length lst)))]
#:when (zero? (remainder counter 3)))
i))
This function (or any of them, for that matter) could be usefully generalized to keep every nth element:
;; Generalize to `every-nth`:
(define (every-nth n lst)
(for/list ([i lst]
[counter (range 1 (add1 (length lst)))]
#:when (zero? (remainder counter n)))
i))
Finally, map could be used to create a list containing every nth element by mapping over a range of every nth index into the list:
;; Use `map` and `range`:
(define (every-nth-map n lst)
(map (lambda (x) (list-ref lst x)) (range (sub1 n) (length lst) n)))
If what OP really requires is simply to print every third value, rather than to create a list of every third value, perhaps the code above can provide useful materials allowing OP to come to a satisfactory conclusion. But, each of these functions can be used to print results as OP desires, as well:
scratch.rkt> (for ([x (every-3rd-1 '(a b c d e f g h i j k l m n o p))])
(displayln x))
c
f
i
l
o
scratch.rkt> (for ([x (every-3rd-2 '(a b c d e f g h i j k l m n o p))])
(displayln x))
c
f
i
l
o
scratch.rkt> (for ([x (every-3rd-3 '(a b c d e f g h i j k l m n o p))])
(displayln x))
c
f
i
l
o
scratch.rkt> (for ([x (every-nth 3 '(a b c d e f g h i j k l m n o p))])
(displayln x))
c
f
i
l
o
scratch.rkt> (for ([x (every-nth-map 3 '(a b c d e f g h i j k l m n o p))])
(displayln x))
c
f
i
l
o
Here is a template:
(for ([x (in-list xs)]
[i (in-naturals]
#:when some-condition-involving-i)
(displayln x))

Count elements and return them

I want to count the elements in a list and return a list containing the elements paired with them respective quantity
Something like that:
Input:
(count-elements '(a b d d a b c c b d d))
Output:
((a 2) (b 3) (d 4) (c 2))
How can I do it? I'm not having any success trying to pair the element and its accounting
Your problem can be divided into three broad parts:
Duplicate recognition/ deletion : This can be done by either removing all the duplicates of every element, or by knowing that the current element is a duplicate(and thus not counting it as a new element.). This(the former strategy) can be done by using the function remove-duplicates
Counting: A way to actually count the elements. This can be done by the function count
Combination: A way to combine the results into a list. This can be done by the macro push.
The Code:
(defun count-elements (lst)
(loop for i in (remove-duplicates lst)
with ans = nil
do (push (list i (count i lst)) ans)
finally (return ans)))
CL-USER> (count-elements '(a a b c))
((C 1) (B 1) (A 2))
CL-USER> (count-elements '(a b c d d a b s a c d))
((D 3) (C 2) (A 3) (S 1) (B 2))
CL-USER>
NOTE: The result might not be arranged as you would expect, because of the value returned by remove-duplicates
EDIT: As pointed out by coredump, a better version of count-elements would be:
(defun count-elements (lst)
(map 'list
(lambda (e)
(list e (count e lst)))
(remove-duplicates lst)))
which, instead of using loop, uses map.

How can i subtract arbitrary 2 lists in racket?

I want to define a function that consumes 2 lists and do subtraction resulting another list.
For example, when list1 is '(a a b b c) and list2 is '(a b), the subtraction result should be '(a b c).
I tried to implement it by lambda and remove, ended up making sevral lists.
I really have no idea how to do this.
Here is one way:
#lang racket
(define (subtract xs ys)
(if (empty? ys)
xs
(subtract (remove (first ys) xs) (rest ys))))
(subtract '(a a b b c) '(a b))

LISP Displaying binary tree level by level

I have a list that looks like (A (B (C D)) (E (F))) which represents this tree:
A
/ \
B E
/ \ /
C D F
How do I print it as (A B E C D F) ?
This is as far as I managed:
((lambda(tree) (loop for ele in tree do (print ele))) my-list)
But it prints:
A
(B (C D))
(E (F))
NIL
I'm pretty new to Common LISP so there may be functions that I should've used. If that's the case then enlight me.
Thanks.
Taking your question at face value, you want to print out the nodes in 'breadth-first' order, rather than using one of the standard, depth-first orderings: 'in-order' or 'pre-order' or 'post-order'.
in-order: C B D A E F
pre-order: A B C D E F
post-order: C D B F E A
requested order: A B E C D F
In your tree structure, each element can be either an atom, or a list with one element, or a list with two elements. The first element of a list is always an atom.
What I think the pseudo-code needs to look like is approximately:
Given a list 'remains-of-tree':
Create empty 'next-level' list
Foreach item in `remains-of-tree`
Print the CAR of `remains-of-tree`
If the CDR of `remains-of-tree` is not empty
CONS the first item onto 'next-level'
If there is a second item, CONS that onto `next-level`
Recurse, passing `next-level` as argument.
I'm 100% sure that can be cleaned up (that looks like trivial tail recursion, all else apart). However, I think it works.
Start: (A (B (C D)) (E (F)))
Level 1:
Print CAR: A
Add (B (C D)) to next-level: ((B (C D)))
Add (E (F)) to next-level: ((B (C D)) (E (F)))
Pass ((B (C D) (E (F))) to level 2:
Level 2:
Item 1 is (B (C D))
Print CAR: B
Push C to next-level: (C)
Push D to next-level: (C D)
Item 2 is (E (F))
Print CAR: E
Push F to next-level: (C D F)
Pass (C D F) to level 3:
Level 3:
Item 1 is C
Print CAR: C
Item 2 is D
Print CAR: D
Item 3 is F
Print CAR: F
It seems that the way you represent your list is inconsistent. For your example, I imagine it should be: (A ((B (C D)) (E (F)))). This way, a node is consistently either a leaf or a list where the car is the leaf and the cadr is the children nodes.
Because of this mistake, I am assuming this is not a homework. Here is a recursive solution.
(defun by-levels (ts)
(if (null ts)
'()
(append
(mapcar #'(lambda (x) (if (listp x) (car x) x)) ts)
(by-levels (mapcan #'(lambda (x) (if (listp x) (cadr x) '())) ts)))))
by-levels takes a list of nodes and collects values of the top-level nodes, and recursively find the next children to use as the next nodes.
Now,
(defun leafs-of-tree-by-levels (tree)
(by-levels (list tree)))
(leafs-of-tree-by-levels '(a ((b (c d)) (e (f)))))
; (A B E C D F)
I hope that makes sense.
My Lisp is a little rusty, but as Jonathan suggested, a breadth-first tree walk should do it - something along these lines
Edit: I guess I read the problem a little too quickly before. What You have is basically a syntax tree of function applications, so here is the revised code. I assume from your description of the problem that if C and D are children of B then you meant to write (B (C)(D))
; q is a queue of function calls to print
(setq q (list the-original-expression))
; for each function call
(while q
; dequeue the first one
(setq a (car q) q (cdr q))
; print the name of the function
(print (car a))
; append its arguments to the queue to be printed
(setq q (append q)(cdr a))
)
This is the history:
q: ( (A (B (C)(D))(E (F))) )
print: A
q: ( (B (C)(D))(E (F)) )
print: B
q: ( (E (F))(C)(D) )
print: E
q: ( (C)(D)(F) )
print: C
q: ( (D)(F) )
print: D
q: ( (F) )
print: F
q: nil