I'm trying to implement my own deep-copy routine in elisp (since something like (setq newlist oldlist) seems to give just a shallow copy, and (copy-sequence newlist oldlist) still leaves newlist exposed to any changes of the elements of oldlist)
Moreover, if there is a function that does what I want I am having no luck finding it.
The definition of my function is:
(defun deep-copy (iList oList)
(setq oList (car iList))
(setq counter (- (length iList) 1))
(setq iList (cdr iList))
(while (> counter 0)
(setq oList (cons oList (car iList)))
(setq iList (cdr iList))
(setq counter (- counter 1) )))
and afterwards, with an iList of (1 2 3 4 5 6) what oList happens to have is: (((((1 . 2) . 3) . 4) . 5) . 6)
i.e. nested lists.
I have tried quoting, back quoting, using append, switching the order of oList and (car iList) in (cons # #), googling for a solution, but I am having no luck (either errors or garbage).
In addition to any welcome comments on what functions already exist that will do what I want, where there are weaknesses in the code (I am an elisp newbie), could someone tell me how to cons elements to an existing list properly?
the examples tend be variants of the form: (cons 'pine '(fir oak maple)), where '(fir oak maple) is some hard coded list
edit: For the last two hours I have been battling against myself (since I commented out oList in the calling function, and I kept referring to an old version of it). At any rate, swapping oList and (car iList) and then reversing at the end seems to do the trick (but surely there is a better way!?) i.e.
(defun deep-copy (iList)
(setq oList nil )
(setq counter (- (length iList) 1))
(while (>= counter 0)
(setq oList (cons (car iList) oList) )
(setq iList (cdr iList) )
(setq counter (- counter 1) ))
(reverse oList)
)
Use copy-tree (example assumes you required cl, for my convenience, but copy-tree itself doesn't require it):
elisp> (setq list1 '(((1 2) (3 4)) 5 (6)))
(((1 2)
(3 4))
5
(6))
elisp> (setq list2 (copy-sequence list1))
(((1 2)
(3 4))
5
(6))
elisp> (setf (caar list2) 1)
1
elisp> list2
((1
(3 4))
5
(6))
elisp> list1
((1
(3 4))
5
(6))
elisp> (setq list1 '(((1 2) (3 4)) 5 (6)))
(((1 2)
(3 4))
5
(6))
elisp> (setq list2 (copy-tree list1))
(((1 2)
(3 4))
5
(6))
elisp> (setf (caar list2) 1)
1
elisp> list1
(((1 2)
(3 4))
5
(6))
elisp> list2
((1
(3 4))
5
(6))
Instead of giving tips about your code, I suggest that you read through the Elisp introduction that comes with Emacs: C-h i g (eintr) RET or other introductory Lisp books, for example Touretzky (the latter is for Common Lisp, but a great introduction). It will teach you the basics – for example, to not just setq in function definitions and so on.
But to give you an example, here's the definition of copy-tree (alternatively, just view it in your Emacs: M-x find-function RET copy-tree RET):
(defun copy-tree (tree &optional vecp)
"Make a copy of TREE.
If TREE is a cons cell, this recursively copies both its car and its cdr.
Contrast to `copy-sequence', which copies only along the cdrs. With second
argument VECP, this copies vectors as well as conses."
(if (consp tree)
(let (result)
(while (consp tree)
(let ((newcar (car tree)))
(if (or (consp (car tree)) (and vecp (vectorp (car tree))))
(setq newcar (copy-tree (car tree) vecp)))
(push newcar result))
(setq tree (cdr tree)))
(nconc (nreverse result) tree))
(if (and vecp (vectorp tree))
(let ((i (length (setq tree (copy-sequence tree)))))
(while (>= (setq i (1- i)) 0)
(aset tree i (copy-tree (aref tree i) vecp)))
tree)
tree)))
Elisp has the function copy-tree. It's the recursive version of copy-sequence:
Example
(let* ((orig '((1 2) (3 4)))
(copy (copy-tree orig)))
(setcdr (cadr copy) '(0))
(list orig copy))
==> (((1 2) (3 4)) ((1 2) (3 0)))
in your case you could write:
(setq oList (copy-tree iList))
Related
This question already has answers here:
How to do a powerset in DrRacket?
(5 answers)
Closed 7 years ago.
I'm new to functional programming and I have no idea how to code this in Lisp. For example, for a given power set such as (1 2 3), how do I code it in a way to make it: (WITHOUT using Lambda functions)
( () (1) (2) (3) (1 2 3) )
So far, I have:
(define (powerSet lis)
(if (null? lis) '(()))
)
(define (APPENDS lis1 lis2)
(cond
((null? lis1) lis2)
(else (cons (car lis1)
(APPENDS (cdr lis1) lis2)))
)
)
Which just returns the empty set, or nothing.
EDIT:
Thank you so much Chris! That made so much sense. The second variation (without the append-map function) works well. However, if you input (powerset'(1 2 3 4)), it gives you:
(()
(1)
(2)
(1 2)
(3)
(1 3)
(2 3)
(1 2 3)
(4)
(1 4)
(2 4)
(1 2 4)
(3 4)
(1 3 4)
(2 3 4)
(1 2 3 4))
Is there anyway for me to make it look like:
(()
(1)
(2)
(3)
(4)
(1 2)
(1 3)
(1 4)
(2 3)
(2 4)
(3 4)
(1 2 3)
(1 2 4)
(1 3 4)
(2 3 4)
(1 2 3 4))
Thanks so much!
All user-defined functions are lambda (or case-lambda) expressions, including the powerset function you're defining. There is no way to avoid it. However, you can hide the lambda identifier by using internal definitions (it's still a lambda behind the scenes!†).
With this in mind, here's an implementation (requires Racket or SRFI 1):
(define (powerset lst)
(define (make-pair x)
(list x (cons (car lst) x)))
(if (null? lst)
'(())
(append-map make-pair (powerset (cdr lst)))))
If you're trying to avoid append-map or higher-order functions in general, you could jump through a few hoops to do the same thing:
(define (powerset lst)
(define (inner next)
(if (null? next)
'()
(cons (car next)
(cons (cons (car lst) (car next))
(inner (cdr next))))))
(if (null? lst)
'(())
(inner (powerset (cdr lst)))))
† An expression like
(define (foo bar)
baz)
is actually expanded into the following equivalent expression:
(define foo
(lambda (bar)
baz))
I've created a function that should return the elements that the two lists do not have in common. Currently, they are outputting exactly what is passed into it. Any suggestions on how to fix this?
(define (findDifference lst1 lst2)
(if (null? lst1) lst2
(cons (car lst1) (findDifference (cdr lst1) lst2))))
(findDifference '(2 3 4 (2 3) 2 (4 5)) '(2 4 (4 5))
Current Output: (2 3 4 (2 3) 2 (4 5) 2 4 (4 5))
Desired Output: (3 (2 3))
You're asking for the symmetric difference of two lists. Try this:
(define (diff list1 list2)
(union (complement list1 list2)
(complement list2 list1)))
Using the following helper procedures:
(define (union list1 list2)
(cond ((null? list1) list2)
((member (car list1) list2) (union (cdr list1) list2))
(else (cons (car list1) (union (cdr list1) list2)))))
(define (complement list1 list2)
(cond ((null? list1) '())
((member (car list1) list2) (complement (cdr list1) list2))
(else (cons (car list1) (complement (cdr list1) list2)))))
Also notice that if you're using Racket you can simply use the built-in set-symmetric-difference procedure for the same effect. For example:
(diff '(2 3 4 (2 3) 2 (4 5)) '(2 4 (4 5)))
=> '(3 (2 3))
Since it seems like homework and I do not want to spoil the fun, here is the brute force algorithm, with some bits left out. If you are really stuck I will give you the full source.
(define (sym-diff xs ys)
;; Since we have the helper function we can determine all the elements that are in the first list,
;; but not in the second list.
;; Then we can pass this intermediate result to the second call to sym-diff-helper.
;;This will return us all the elements that are in the second list but not the first.
(let ((in-first-not-second ...))
(sym-diff-helper ys xs in-first-not-second)))
;; This function will return all the elements from the first list that are not in the second list!
(define (sym-diff-helper xs ys acc)
(cond
;; If the first list is empty we have checked it.
(...
acc)
;; If the first list is not empty yet, check if the first element
;; is in the second list.
;; If so, discard it and continue with the rest of the list.
((member ... ...)
(sym-diff-helper ... ... ...)
;; If the first element of the first list is not in the second list,
;; add it to the accumulator and continue with the rest of the list.
(else
(sym-diff-helper ... ... ...)))
(sym-diff-helper '(1 2 3) '(2 3 4) '())
;; == (1)
(sym-diff-helper '(1 2 (3 4) 5) '(2 3 4) '())
;; == (5 (3 4) 1)
(sym-diff '(2 3 4 (2 3) 2 (4 5)) '(2 4 (4 5)))
;; == ((2 3) 3)
Note that I have chosen to use member. There are a few other search functions but they were not well suited in this case. Hence, I left it there. More info on the search functions can be found here: http://docs.racket-lang.org/reference/pairs.html#%28part..List.Searching%29
So I am familiar with the algorithm for creating a power set using Scheme that looks something like this:
(define (power-set set)
(if (null? set) '(())
(let ((power-set-of-rest (power-set (cdr set))))
(append power-set-of-rest
(map (lambda (subset) (cons (car set) subset))
power-set-of-rest)))))
So this, for (1, 2, 3, 4), would output:
(() (4) (3) (3 4) (2) (2 4) (2 3) (2 3 4) (1) (1 4) (1 3) (1 3 4) (1 2) (1 2 4)
(1 2 3) (1 2 3 4))
I need to figure out how to output the power set "in order", for example:
(() (1) (2) (3) (4) (1 2) (1 3) (1 4) (2 3) (2 4) (3 4) (1 2 3) (1 2 4) (1 3 4)
(2 3 4) (1 2 3 4))
Doing a little research, it seems as if the best option would be for me to run a sort before outputting. I am NOT allowed to use built in sorts, so I have found some example sorts for sorting a list:
(define (qsort e)
(if (or (null? e) (<= (length e) 1))
e
(let loop ((left null) (right null)
(pivot (car e)) (rest (cdr e)))
(if (null? rest)
(append (append (qsort left) (list pivot)) (qsort right))
(if (<= (car rest) pivot)
(loop (append left (list (car rest))) right pivot (cdr rest))
(loop left (append right (list (car rest))) pivot (cdr rest)))))))
I cannot figure out how I would go about sorting it based off of the second, or third element in one of the power sets though. Can anyone provide an example?
Here's a powerset function that returns the items in the correct order, without sorting. It requires Racket and uses its queues to implement breadth-first processing:
(require srfi/1 data/queue)
(define (powerset items)
(define fifo (make-queue))
(enqueue! fifo (cons '() items))
(let loop ((result '()))
(if (queue-empty? fifo)
(reverse result)
(let* ((head-entry (dequeue! fifo))
(subset (car head-entry))
(rest-items (cdr head-entry)))
(pair-for-each (lambda (next-items)
(enqueue! fifo (cons (cons (car next-items) subset)
(cdr next-items))))
rest-items)
(loop (cons (reverse subset) result))))))
We maintain a FIFO queue of pairs, each consisting of a subset (in reversed order) and a list of items not included in it, starting with an empty subset so all the original items are still not included in it.
For each such pair, we collect the subset into the result list, and also extend the queue by extending this subset by each item from the not-included items. Processing stops when the queue is empty.
Because we extend subsets each time by one element only, and in order, the result is ordered too.
Here's a compare function that should work for your needs. It assumes that the numbers in the two input arguments are sorted already.
(define (list-less? lst1 lst2)
;; Compare the contents of the lists.
(define (helper l1 l2)
;; If two lists are identical, the answer is false.
;; This scenario won't be exercised in the problem.
;; It's here only for the sake of completeness.
(if (null? l1)
#f
;; If the first item of the second list is greater than
;; the first item, return true.
(if (> (car l2) (car l1))
#t
(or (< (car l1) (car l2)) (helper (cdr l1) (cdr l2))))))
;; First compare the lengths of the input arguments.
;; A list of smaller length are assumed to be "less"
;; than list of greater length.
;; Only when the lists are of equal length, do we
;; compare the contents of the lists.
(let ((len1 (length lst1)) (len2 (length lst2)))
(if (> len1 len2)
#f
(or (< len1 len2) (helper lst1 lst2)))))
Absract: The abstract problem is:
a list of values
a list of modifiers, things that act on the values to return new values
(for the example code I'm just multiplying the value by the modifier value)
the list of modifiers is not constrained to be the same size as the list of values.
apply the modifiers to the values, and get back any unused modifiers
Here's a version that that uses two separate functions: one to actually apply the modifiers, one to get the remaining modifiers
;; Return the modified list
(define (apply-mods vals mods)
(if (or (null? vals) (null? mods)) vals
(cons (* (car vals) (car mods)) (apply-mod (cdr vals) (cdr mods)))
)
)
;; trim the modifiers
(define (trim-mods vals mods)
(if (or (null? vals) (null? mods)) mods
(trim-mods (cdr vals) (cdr mods))
)
The idea is that after I apply the list of modifiers, (apply-mods vals mods) I may want to use the remaining
modifiers (trim-mods vals mods) in subsequent operations.
Currently, the best approach I've come up with is the two function approach, but it seems wasteful to iterate though the list twice.
Is there a clean way to return both the modified values, and the unused modifiers?
Concrete The concrete problem is:
my values are musical notes; each has a volume and a duration. Something like:
(vol: 1, dur: 1 beat)(vol: 1 dur: 2 beats)(vol: 1 dur: 1 beat)...
my modifiers are "changes to the volume", each has a volume change and a duration
(dvol: +1 dur: 4 beats)(dvol: -2 dur: 4 beats)...
as I recurse through the lists, I keep track of the net accumulated time to determine which modifier is in effect for a given note.
So in the real problem there is not the easy 1-1 mapping of modifiers to values, and thus I expect to run into situations where I'll apply a list of modifiers to a list of note that is shorter (in terms of duration) than the note list; I'll then want to apply the
remaining modifiers to the next note list (I plan on breaking the overall music into chunks).
Assuming these are the expected results:
> (apply-mods '((1 . 10)) '((1 . 4) (2 . 4) (3 . 4)))
'((2 . 4) (3 . 4) (4 . 2))
'((3 . 2))
> (apply-mods '((1 . 1) (1 . 2) (1 . 1)) '((+1 . 4) (-2 . 4)))
'((2 . 1) (2 . 2) (2 . 1))
'((-2 . 4))
this is a simple loop processing 2 lists in parallel:
(define (apply-mods vals mods)
(let loop ((vals vals) (mods mods) (res null))
(cond
((null? vals) (values (reverse res) mods))
((null? mods) (error "not enough mods"))
(else
(let ((val (car vals)) (mod (car mods)))
(let ((vol (car val)) (dur (cdr val)) (dvol (car mod)) (ddur (cdr mod)))
(cond
; case 1. duration of note = duration of mod => consume note and mod
((= dur ddur)
(loop (cdr vals)
(cdr mods)
(cons (cons (+ vol dvol) dur) res)))
; case 2. duration of note < duration of mod => consume note, push back shorter mod
((< dur ddur)
(loop (cdr vals)
(cons (cons dvol (- ddur dur)) (cdr mods))
(cons (cons (+ vol dvol) dur) res)))
; case 3. duration of note > duration of mod => push back part of note, consume mod
(else
(loop (cons (cons vol (- dur ddur)) (cdr vals))
(cdr mods)
(cons (cons (+ vol dvol) ddur) res))))))))))
It seems that your requirement is even simpler, and you probably only need to cover case 1, but I can only speculate while waiting for an example. In any case, you will be able to adapt this code to your specific need quite easily.
It sounds like you may want a mutable data structure such as a queue.
(make-mod-queue '(dvol: +1 dur: 4 beats)(dvol: -2 dur: 4 beats)...))
#queue((4 (dvol: +1)) (4 (dvol: -2)) ...)
(make-note-queue '(vol: 1, dur: 1 beat)(vol: 1 dur: 2 beats)(vol: 1 dur: 1 beat))
#queue((1 (vol" 1)) (1 (vol: 1)) (2 (vol: 1))
Then a function to combine them
(define (apply-mods note-queue mod-queue)
(let ((new-queue make-empty-queue))
(get-note-dur (lambda ()
(if (emtpy-queue? note-queue)
#f
(car (front-queue note-queue)))))
(get-mod-dur (lambda ()
(if (empty-queue? mod-queue)
#f
(car (front-queue mod-queue)))))
(get-vol
(lambda ()
(if (or (empty-queue? mod-queue) (empty-queue? mod-queue))
#f
(+ (note-vol (front-queue note-queue))
(mod-vol (front-queue mod-queue)))))))
(let loop ((d1 (get-note-dur)) ;;should return #f is note-queue is empty
(d2 (get-mod-dur)) ;;ditto for mod-queue
(vol (get-volume)))
(cond ((not vol)
(cond ((and d2 (not (= d2 (get-mod-dur))))
(set-car! (front-queue mod-queue) d2) new-queue)
new-queue)
((and d1 (not (= d1 (get-note-dur))))
(set-car! (front-queue note-queue) d1) new-queue)
new-queue)
(else new-queue)))
((= d1 d2)
(insert-queue! new-queue (cons d1 (list 'vol: vol)))
(delete-queue! note-queue)
(delete-queue! mod-queue)
(loop (get-note-dur) (get-mod-dur) (get-volume)
((< d1 d2)
(insert-queue! new-queue (cons d1 (list 'vol: vol)))
(delete-queue! note-queue)
(loop (get-note-dur) (- d2 d1) (get-volume)))
((> d1 d2)
(insert-queue! new-queue (cons d2 (list 'vol: vol)))
(delete-queue! mod-queue)
(loop (- d1 d2) (get-mod-dur) (get-volume)))))))
Would return
#queue (1 (vol" 2)) (1 (vol: 2)) (2 (vol: 2)
and your mod-queue (whatever you passed it in as would now be mutated to
#queue (4 (dvol: -2)) ...),
and the original note-queue is now an empty-queue
queues as described in SICP
http://mitpress.mit.edu/sicp/full-text/sicp/book/node62.html
How to delete only first appearance of element into list (elisp) ?
The Common Lisp sequence-editing functions (remove and friends) take a :count keyword argument:
Count, if supplied, limits the number of elements removed or deleted; if more than count elements satisfy the test, then of these elements only the leftmost or rightmost, depending on from-end, are deleted or removed, as many as specified by count. If count is supplied and negative, the behavior is as if zero had been supplied instead. If count is nil, all matching items are affected.
For example:
ELISP> (require 'cl)
cl
ELISP> (remove* 1 '(1 2 1 3 1 4) :count 1)
(2 1 3 1 4)
ELISP> (remove* 1 '(1 2 1 3 1 4) :count 2)
(2 3 1 4)
ELISP> (remove* 1 '(1 2 1 3 1 4) :count 2 :from-end t)
(1 2 3 4)
(Note that Emacs already had its own function called remove, so the cl package has to use the name remove*.)
The noob's code for elisp. position can be found into cl-seq.el.
(defun remove-first (elem lst)
(interactive)
(if (equal (position elem lst) nil ) (progn (setq lst lst) )
(progn
(setq out1 (nthcdr (+ 1 (position elem lst)) lst))
(setq out2 (nbutlast lst (- (length lst) (position elem lst) ) ) )
(delq nil (append out2 out1))
))
)
To remove 3 from mylist, will be called as
>(setq mylist '(1 2 3 4 3 3))
>(setq mylist (remove-first 3 mylist))
(1 2 4 3 3)
You can use this elisp (which requires cl):
(defun remove-first (elt seq)
(let ((remove-first t))
(remove-if (lambda (e) (when (and remove-first (equal elt e))
(setq remove-first nil)
t))
seq)))
Note: this makes a copy of the original list. For one using side-effects, try this:
(defun remove-first* (elt seq)
(if (equal elt (car seq))
(cdr seq)
(while (cdr seq)
(if (equal elt (cadr seq))
(progn (setcdr seq (cddr seq))
(setq seq nil))
(setq seq (cdr seq))))
seq))
Note: when the first element is the one removed, just the cdr is returned, so as always with this type of operation, invoke it like so:
(setq mylist (remove-first* 3 mylist))