I stayed up all night writing this function that takes a list of strings and turns it into a recursively nested set of alists. I tried using pushnew so that existing strings would not be duplicated but had to create my own test for repetition because I could not get pushnew to do it.
Obviously there is a way to use recursion but I couldn't get that to work because I could not get the destination part of pushnew to call right.
I finally did it a stupid way, but what is the smart way?
(defvar vocab '())
(defun place-down ( a b &optional c d e f g)
(unless (assoc a vocab :test #'equal)
(pushnew (cons a '()) vocab :test #'equal))
(unless (assoc b (cdr(assoc a vocab :test #'equal)):test #'equal)
(pushnew (cons b '()) (cdr(assoc a vocab :test #'equal :test #'equal))))
(when c
(unless (assoc c (cdr(assoc b (cdr(assoc a vocab :test #'equal :test #'equal
)):test #'equal)):test #'equal)
(pushnew (cons c '()) (cdr(assoc b (cdr(assoc a vocab :test #'equal
:test #'equal)):test #'equal)))))
(when d
(unless (assoc d (cdr(assoc c (cdr(assoc b (cdr(assoc a vocab :test #'equal
:test #'equal)):test #'equal)):test #'equal)):test #'equal)
(pushnew (cons d '()) (cdr(assoc c (cdr(assoc b (cdr(assoc a vocab :test
#'equal :test #'equal)):test #'equal)):test #'equal)))))
(when e
(unless (assoc e (cdr(assoc d (cdr(assoc c (cdr(assoc b (cdr(assoc a vocab
:test #'equal :test #'equal)) :test #'equal)):test #'equal)):test #'equal)):test #'equal)
(pushnew (cons e '()) (cdr(assoc d (cdr(assoc c(cdr(assoc b (cdr(assoc a vocab
:test #'equal :test #'equal)) :test #'equal)):test #'equal)):test #'equal)))))
(when f
(unless (assoc f (cdr(assoc e (cdr(assoc d(cdr(assoc c(cdr(assoc b (cdr(assoc a vocab
:test #'equal :test #'equal)) :test #'equal)):test #'equal)):test #'equal)):test #'equal))
:test #'equal)
(pushnew (cons f '()) (cdr(assoc e (cdr(assoc d(cdr(assoc c(cdr(assoc b (cdr(assoc a vocab
:test #'equal :test #'equal)) :test #'equal)):test #'equal)):test #'equal)):test #'equal)))))
(when g
(unless (assoc g (cdr(assoc f (cdr(assoc e(cdr(assoc d(cdr(assoc c(cdr(assoc b (cdr(assoc a vocab
:test #'equal :test #'equal)) :test #'equal)):test #'equal)):test #'equal)):test #'equal))
:test #'equal)):test #'equal)
(pushnew (cons g '()) (cdr(assoc f (cdr(assoc e(cdr(assoc d(cdr(assoc c(cdr(assoc b (cdr(assoc a vocab
:test #'equal :test #'equal)) :test #'equal)):test #'equal)):test #'equal)):test #'equal)):test #'equal))))))
In the reple I put:
*(place-down "this" "is" "it" "the" "life" "we" "live")
* vocab
=> (("this" ("is" ("it" ("the" ("life" ("we" ("live"))))))))
The example looks like something REDUCE can solve.
(defun place-down (&rest strings)
(reduce (lambda (string accumulator)
(if accumulator
(list string accumulator)
(list string)))
strings
:initial-value nil
:from-end t))
REDUCE with an explicit :initial-value argument is the case where the given reducing function is called in the most uniform way; otherwise, that function can be called with zero or two arguments, and can even not be called at all if the list has a single element (thank you #jkiiski). If the accumulator is NIL, we discard it. Tests:
(place-down "this" "is" "it" "the" "life" "we" "live")
=> ("this" ("is" ("it" ("the" ("life" ("we" ("live")))))))
(place-down "this" "is" "it")
=> ("this" ("is" ("it")))
(place-down "this")
=> ("this")
(place-down)
=> NIL
The :from-end t arguments makes the operation right-associative.
CL-USER 8 > (loop with result = nil
for l in (reverse '("this" "is" "it" "the" "life" "we" "live"))
do (setf result (list (cons l result)))
finally (return result))
(("this" ("is" ("it" ("the" ("life" ("we" ("live"))))))))
or
CL-USER 9 > (let ((result nil)
(list '("this" "is" "it" "the" "life" "we" "live")))
(dolist (l (reverse list) result)
(setf result (list (cons l result)))))
(("this" ("is" ("it" ("the" ("life" ("we" ("live"))))))))
Related
I am attempting to write a DrRacket function that that can sort a list in ascending or descending order (by making the comparison operator a parameter). The sorting algorithm should be insertion sort. I called this second parameter cmp.
There are no warnings when I compile, but when I attempt to test the function; for example, (sort-list '(1 0 2 4) >), I receive this error:
sort-list: arity mismatch;
the expected number of arguments does not match the given number
expected: 2
given: 1
arguments...:
Here is my function as of now:
(define (sort-list l cmp)
(define first-element (if (not (null? l)) (car l) 0))
(cond ((null? l) (quote ()))
(else (cons (find-shortest l first-element cmp) (sort-list (remove-member l (find-shortest l first-element cmp)))))))
(define find-shortest
(lambda (tl b cmp)
(cond ((null? tl) b)
((cmp (car tl) b) (set! b (car tl)) (find-shortest (cdr tl) b cmp))
(else (find-shortest (cdr tl) b cmp)))))
(define remove-member
(lambda (tl2 a)
(cond ((null? tl2) (quote ()))
((= a (car tl2)) (cdr tl2))
(else (cons (car tl2) (remove-member (cdr tl2) a))))))
Trying to define resursive macro in elisp
(defmacro remacro (keys)
(if keys
`(func1 ,(car keys)
,(remacro (cdr keys)))
))
(macroexpand '(remacro '(a b c)))
But it is ended up in
Lisp nesting exceeds `max-lisp-eval-depth'
error.
Wanted to get result like
(func1 a (func1 b (func1 c nil nil) '(c)) '(b c))
from
(remacro '(a b c))
Please let me know how I can correct this definition.
One more thing could I defined `keys' as rest parameter like
(defmacro remacro (&rest keys)
(if keys
`(abc ,(car keys)
,(remacro `,#(cdr keys)))
))
tried this one but it is not working.
USE CASE:
Basically I wanted to define a function
to set a tree node that is arranged in alist way
(it is still not working, have to work on it)
(defmacro set-tree-node (tree e &rest keys)
`(setcdr
,(if keys
`(assoc (car keys)
(pushnew
(list ,(car keys))
(cdr
,(set-tree-node `(cdr ,xtree) e `,#(cdr keys)))
:key 'car))
tree)
e))
(setq egtree nil)
After running
(set-tree-node egtree new-node n b c)
should get
egtree eq
((n (b (c . new-node))))
or
(n (b (c . new-node)))
I had defined it as function
(defun set-tree-node (tree e &rest keys)
(setcdr
(reduce (lambda (xtree k)
(message "tree %s k %s" xtree k)
(assoc k (pushnew (list k) (cdr xtree) :key 'car)))
keys :initial-value (cons nil tree))
e))
But it could work only for existing list
It can successfully change (tree if full path exists)
egtree from
(setq egtree '((n (b (c . d)))))
to
egtree eq
'((n (b (c . replaced-d))))
after called like this
(set-tree-node jt 'replaced-d 'n 'b 'c)
But this function do not work with if list if complete path do not
exits
Write the macro as:
(defmacro remacro (keys)
(if keys
`(abc ,(car keys)
(remacro ,(cdr keys)))))
and call it:
(remacro (a b c))
You don't need to quote the argument because macro parameters are not evaluated.
To see the expansion, use:
(macroexpand-all '(remacro (a b c)))
(abc a (abc b (abc c nil)))
I don't see where add is supposed to come from in your example, I assume that was a typo for abc.
(defmacro tree-node (tree &rest keys)
(if keys
`(cdr
(assoc ',(car (last keys))
(pushnew
',(last keys)
(tree-node ,tree ,#(butlast keys))
:key 'car)))
tree))
(setq egtree nil)
(setf (tree-node egtree l1 l2 lx) 'value)
(push (tree-node egtree l1 l2 ly) 'element1)
(push (tree-node egtree l1 l2 ly) 'element2)
(defmacro set-tree-node (tree value &rest keys)
`(setf (tree-node ,tree ,#keys) ,value))
(set-tree-node egtree 'value l1 l2 lz)
wanted to make macro like this.
I would like to write a function that reverses the elements of a list, but it should happen in place (that is, don't create a new reversed list).
Something like:
>> (setq l ' (a b c d))
((a b c d)
>> (rev l)
(d c b a)
>> l
(d c b a)
What flags should I follow to achieve this?
Have a look at nreverse which will modify the list in place (see HyperSpec).
As per the comments, do note the comments that #Barmar made and this bit from the spec:
For nreverse, sequence might be destroyed and re-used to produce the result. The result might or might not be identical to sequence. Specifically, when sequence is a list, nreverse is permitted to setf any part, car or cdr, of any cons that is part of the list structure of sequence.
It's not difficult to implement this (ignoring fault cases). The keys are to use (setf cdr) to reuse a given cons cell and not to lose the reference to the prior cdr.
(defun nreverse2 (list)
(recurse reving ((list list) (rslt '()))
(if (not (consp list))
rslt
(let ((rest (cdr list)))
(setf (cdr list) rslt)
(reving rest list)))))
(defmacro recurse (name args &rest body)
`(labels ((,name ,(mapcar #'car args) ,#body))
(,name ,#(mapcar #'cadr args))))
[edit] As mentioned in a comment, to do this truly in-place (and w/o regard to consing):
(defun reverse-in-place (l)
(let ((result l))
(recurse reving ((l l) (r (reverse l))
(cond ((not (consp l)) result)
(else (setf (car l) (car r))
(reving (cdr l) (cdr r)))))))
> (defvar l '(1 2 3))
> (reverse-in-place l))
(3 2 1)
> l
(3 2 1)
since yesterday I've been trying to program a special case statement for scheme that would do the following:
(define (sort x)
(cond ((and (list? x) x) => (lambda (l)
(sort-list l)))
((and (pair? x) x) => (lambda (p)
(if (> (car p) (cdr p))
(cons (cdr p) (car p))
p)))
(else "here")))
instead of using all the and's and cond's statement, I would have:
(define (sort x)
(scase ((list? x) => (lambda (l)
(sort-list l)))
((pair? x) => (lambda (p)
(if (> (car p) (cdr p))
(cons (cdr p) (car p))
p)))
(else "here")))
What I could do so far, was this:
(define (sort x)
(scase (list? x) (lambda (l)
(sort-list l)))
(scase (pair? x) (lambda (p)
(if (> (car p) (cdr p))
(cons (cdr p) (car p))
p))))
with this code:
(define-syntax scase
(syntax-rules ()
((if condition body ...)
(if condition
(begin
body ...)))))
What I wanted to do now, is just allow the scase statement to have multiple arguments like this:
(scase ((list? (cons 2 1)) 'here)
((list? '(2 1)) 'working))
but I can't seem to figure out how I can do that. Maybe you guys could give me a little help?
Thanks in advance ;)
If this is an exercise in learning how to use syntax-rules, then disregard this answer.
I see a way to simplify your code that you are starting with.
(define (sort x)
(cond ((list? x)
(sort-list x))
((pair? x)
(if (> (car x) (cdr x))
(cons (cdr x) (car x))
x)))
(else "here")))
Since all the (and (list? x) x) => (lambda l ... does is see if x is a list, and then bind l to x, (since #f is not a list, and '() is not false, at least in Racket), you can just skip all that and just use x. You do not need to use => in case, and in this case it doesn't help. => is useful if you want to do an test that returns something useful if successful, or #f otherwise.
Now, if you want to use a macro, then you're going to need to clarify what you want it to do a bit better. I think that case already does what you want. Your existing macro is just if, so I'm not sure how to extend it.
I found the solution for my question, here it goes:
(define-syntax cases
(syntax-rules ()
((_ (e0 e1 e2 ...)) (if e0 (begin e1 e2 ...)))
((_ (e0 e1 e2 ...) c1 c2 ...)
(if e0 (begin e1 e2 ...) (cases c1 c2 ...)))))
Thank you all anyway :)
Here's a solution :
#lang racket
(require mzlib/defmacro)
(define-syntax scase
(syntax-rules (else)
((_ (else body1)) body1)
((_ (condition1 body1) (condition2 body2) ...)
(if condition1
body1
(scase (condition2 body2) ...)))))
(define (sort1 x)
((scase ((list? x) (lambda (l)
(sort l <)))
((pair? x) (lambda (p)
(if (> (car p) (cdr p))
(cons (cdr p) (car p))
p)))
(else (lambda (e) "here")))
x))
It works in DrRacket. I made three changes to your solution. First, i renamed your sort procedure to sort1 since sort is inbuilt in scheme ( I have used it inside sort1). Second, I have changed the sort1 itself so that the input given will be passed to the procedure returned by scase and you will directly get the sorted result. Third, I have modified the scase syntax extension, so that it will accept the else condition.
>(sort1 (list 3 1 2))
'(1 2 3)
> (sort1 (cons 2 1))
'(1 . 2)
> (sort1 'here)
"here"
I suggest you read "The Scheme Programming Language" by Kent Dybvig. There is an entire chapter on syntactic extensions.
I need to remove an element from a list which contain inner lists inside. The predefined element should be removed from every inner list too.
I have started working with the following code:
(SETQ L2 '(a b ( a 2 b) c 1 2 (D b (a s 4 2) c 1 2 a) a )) ; defined my list
; Created a function for element removing
(defun elimina (x l &optional l0)
(cond (( null l)(reverse l0))
((eq x (car l))(elimina x (cdr l) l0))
(T (elimina x (cdr l) (cons (car l) l0))))
)
(ELIMINA 'a L2)
But unfortunately it removes only elements outside the nested lists.
I have tried to create an additional function which will remove the element from the inner lists.
(defun elimina-all (x l)
(cond ((LISTP (CAR L))(reverse l)(elimina x (car l)))
(T (elimina-all x (CDR L)))
)
)
but still unsuccessfully.
Can you please help me to work it out?
Thank you in advance.
First of all, I'd suggest you read this book, at least, this page, it explains (and also gives very good examples!) of how to traverse a tree, but most importantly, of how to combine functions to leverage more complex tasks from more simple tasks.
;; Note that this function is very similar to the built-in
;; `remove-if' function. Normally, you won't write this yourself
(defun remove-if-tree (tree predicate)
(cond
((null tree) nil)
((funcall predicate (car tree))
(remove-if-tree (cdr tree) predicate))
((listp (car tree))
(cons (remove-if-tree (car tree) predicate)
(remove-if-tree (cdr tree) predicate)))
(t (cons (car tree)
(remove-if-tree (cdr tree) predicate)))))
;; Note that the case of the symbol names doesn't matter
;; with the default settings of the reader table. I.e. `D' and `d'
;; are the same symbol, both uppercase.
;; Either use \ (backslash) or || (pipes
;; around the symbol name to preserve the case. Eg. \d is the
;; lowercase `d'. Similarly, |d| is a lowercase `d'.
(format t "result: ~s~&"
(remove-if-tree
'(a b (a 2 b) c 1 2 (D b (a s 4 2) c 1 2 a) a)
#'(lambda (x) (or (equal 1 x) (equal x 'a)))))
Here's a short example of one way to approaching the problem. Read the comments.
Maybe like this:
(defun elimina (x l &optional l0)
(cond ((null l) (reverse l0))
((eq x (car l)) (elimina x (cdr l) l0))
(T (elimina x (cdr l) (cons (if (not (atom (car l)))
(elimina x (car l))
(car l))
l0)))))
I was looking for the same answer as you and, unfortunately, I couldn't completely understand the answers above so I just worked on it and finally I got a really simple function in Lisp that does exactly what you want.
(defun remove (a l)
(cond
((null l) ())
((listp (car l))(cons (remove a (car l))(remove a (cdr l))))
((eq (car l) a) (remove a (cdr l)))
(t (cons (car l) (remove a (cdr l))))
)
)
The function begins with two simple cases, which are: 'list is null' and 'first element is a list'. Following this you will "magically" get the car of the list and the cdr of the list without the given element. To fixed that up to be the answer for the whole list you just have to put them together using cons.