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.
Related
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)
Suppose I want to convert the following untyped code into typed racket. These functions are inspired by SICP where they show how a data structure can be constructed purely from functions.
(define (make-pair x y)
(lambda (c)
(cond
((= c 1) x)
((= c 2) y)
(error "error in input, should be 1 or 2"))))
(define (first p) (p 1))
(define (second p) (p 2))
To convert it straight to typed racket, the return value of the make-pair function seems to be (: make-pair (All (A B) (-> A B (-> Number (U A B))))). And following this, the type of first should be (: first (All (A B) (-> (-> Number (U A B)) A))). However, while implementing the function we can't call (p 1) directly now because we need some sort of occurrence typing to make sure first returns only of type A. Changing the return type of first to (U A B) works but then the burden of occurrence typing goes on the user and not in the API. So in this scenario how can we use occurrence typing inside first (that is, how to use a predicate for type variable A) so that we can safely return only the first component of the pair?
UPDATE
I tried an approach which differs a bit from above and requires the predicates for A and B to be supplied as arguments to make-pair function. Below is the code:
#lang typed/racket
(define-type FuncPair (All (A B) (List (-> Number (U A B)) (-> A Boolean) (-> B Boolean))))
(: make-pair (All (A B) (-> A B (-> A Boolean) (-> B Boolean) (FuncPair A B))))
(define (make-pair x y x-pred y-pred)
(list
(lambda ([c : Number])
(cond
((= c 1) x)
((= c 2) y)
(else (error "Wrong input!"))))
x-pred
y-pred))
(: first (All (A B) (-> (FuncPair A B) Any)))
(define (first p)
(let ([pair-fn (car p)]
[fn-pred (cadr p)])
(let ([f-value (pair-fn 1)])
(if (fn-pred f-value)
f-value
(error "Cannot get first value in pair")))))
However, this fails in the check (fn-pred f-value) condition with error expected: A
given: (U A B) in: f-value
From the untyped code at the start of your question, it seems like a pair of A and B is a function that given 1, gives back A, and given 2, gives back B. The way to express this type of function is with a case-> type:
#lang typed/racket
(define-type (Pairof A B)
(case-> [1 -> A] [2 -> B]))
The accessors can be defined the same way as your original untyped code, just by adding type annotations:
(: first : (All (A B) [(Pairof A B) -> A]))
(define (first p) (p 1))
(: second : (All (A B) [(Pairof A B) -> B]))
(define (second p) (p (ann 2 : 2)))
The type of the constructor should be:
(: make-pair : (All (A B) [A B -> (Pairof A B)]))
But the constructor doesn't quite work as-is. One thing wrong with it is that your else clause is missing the else part of it. Fixing that gives you:
(: make-pair : (All (A B) [A B -> (Pairof A B)]))
(define (make-pair x y)
(lambda (c)
(cond
[(= c 1) x]
[(= c 2) y]
[else (error "error in input, should be 1 or 2")])))
This is almost right, and if typed racket were awesome enough, it would be. Typed racket treats equal? specially for occurrence typing, but it doesn't do the same thing for =. Changing = to equal? fixes it.
(: make-pair : (All (A B) [A B -> (Pairof A B)]))
(define (make-pair x y)
(lambda (c)
(cond
[(equal? c 1) x]
[(equal? c 2) y]
[else (error "error in input, should be 1 or 2")])))
Ideally occurrence typing should work with =, but perhaps the fact that things like (= 2 2.0) return true makes that both harder to implement and less useful.
A common way of defining semantics is (for example):
return v if [some other condition]
otherwise, return error
For example, consider
(define-language simple-dispatch
(e ::= v (+ e e))
(v ::= number string)
(res ::= e err)
(E ::= hole (+ E e) (+ v E)))
We could then define the reduction relation
(define s-> (reduction-relation simple-dispatch
#:domain res
(--> (in-hole E (+ number_1 number_2))
(in-hole E ,(+ number_1 number_2)))
(--> (in-hole E (+ any any))
err)))
This is the natural way to do this, because it avoids having to write individual matchers for each of the 3 failure cases (number string, string number, string string). However, it then creates the problem that running it like this:
(apply-reduction-relation s-> (term (+ 2 2)))
Shows (correctly) that it lets you reduce both to an error or to the number 4. Is there a way to make an "except" pattern that avoids having to check all of the constituent cases?
What you want to use here is a combination of side-condition and redex-match?. Extending your reduction-relation gives:
(define s-> (reduction-relation simple-dispatch
#:domain res
(--> (in-hole E (+ number_1 number_2))
(in-hole E ,(+ (term number_1) (term number_2))))
(--> (in-hole E (+ any_1 any_2))
err
(side-condition
(not (redex-match? simple-dispatch
(+ number number)
(term (+ any_1 any_2))))))))
This just says you can take the second rule so long as the first one is not true, which is what the papers are saying implicitly, and just didn't draw out explicitly in the figure. (Note that you can use side-condition/hidden to get it to not draw the side condition when rendering the figure).
You can use this method to scale up to any number of patterns you want to disallow.
I have list of lists in my program
for example
(( a b) (c d) (x y) (d u) ........)
Actually I want to add 1 new element in the list but new element would be a parent of all existing sublists.
for example if a new element is z, so my list should become like this
( (z( a b) (c d) (x y) (d u) ........))
I have tried with push new element but it list comes like this
( z( a b) (c d) (x y) (d u) ........)
that I dont want as I have lot of new elements coming in and each element represents some block of sublists in the list
Your help would highly be appreciated.
It sounds like you just need to wrap the result of push, cons, or list* in another list:
(defun add-parent (children parent)
(list (list* parent children)))
(add-parent '((a b) (c d) (x y) (d u)) 'z)
;;=> ((Z (A B) (C D) (X Y) (D U)))
This is the approach that I'd probably take with this. It's just important that you save the return value. In this regard, it's sort of like the sort function.
However, if you want to make a destructive macro out of that, you can do that too using define-modify-macro. In the following, we use define-modify-macro to define a macro add-parentf that updates its first argument to be the result of calling add-parent (defined above) with the first argument and the parent.
(define-modify-macro add-parentf (parent) add-parent)
(let ((kids (copy-tree '((a b) (c d) (x y) (d u)))))
(add-parentf kids 'z)
kids)
;;=> ((Z (A B) (C D) (X Y) (D U)))
For such a simple case you can also use a shorter backquote approach, for example:
(let ((parent 'z) (children '((a b) (c d) (e f))))
`((,parent ,#children)))
If you aren't familiar with backquote, I'd recommend reading the nice and concise description in Appendix D: Read Macros of Paul Graham's ANSI Common Lisp.
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