I would like to ask how can I merge 2 different lists of numbers to a new list keeping the "common points" between them in Common Lisp.
Example
list1: (1 2 3 2 2 )
List2: (1/2 1/2 1 2 2 1 2 1)
Result:(1/2 1/2 1 1 1 2 1 1 1 1)
I hope the image below can give an exact description of the problem.
The lists are numbers because it must compare the different units of the two series and further combine the points of start of each number of both series into a new serie.
Image_1. I think this image is the best way to describe the problem.
Based on your description, I wrote two mutually-recursive functions MRG and SPLIT:
MRG iterates over the first list, all calls SPLIT for each element
SPLIT tries to collect from the second list enough elements for which the sum is equal to the current element in the first list. If the element in the second list is too large, it is split and the remaining is reinjected into the second list. SPLIT also calls MRG when it has finished processing the current element in the first list.
Here is a trace of execution showing how the result is computed.
0: (MRG (1 2 3 2 2) (1/2 1/2 1 2 2 1 2 1))
1: (SPLIT 1 (1/2 1/2 1 2 2 1 2 1) (2 3 2 2))
2: (SPLIT 1/2 (1/2 1 2 2 1 2 1) (2 3 2 2))
3: (SPLIT 0 (1 2 2 1 2 1) (2 3 2 2))
4: (MRG (2 3 2 2) (1 2 2 1 2 1))
5: (SPLIT 2 (1 2 2 1 2 1) (3 2 2))
6: (SPLIT 1 (2 2 1 2 1) (3 2 2))
7: (SPLIT 0 (1 2 1 2 1) (3 2 2))
8: (MRG (3 2 2) (1 2 1 2 1))
9: (SPLIT 3 (1 2 1 2 1) (2 2))
10: (SPLIT 2 (2 1 2 1) (2 2))
11: (SPLIT 0 (1 2 1) (2 2))
12: (MRG (2 2) (1 2 1))
13: (SPLIT 2 (1 2 1) (2))
14: (SPLIT 1 (2 1) (2))
15: (SPLIT 0 (1 1) (2))
16: (MRG (2) (1 1))
17: (SPLIT 2 (1 1) NIL)
18: (SPLIT 1 (1) NIL)
19: (SPLIT 0 NIL NIL)
20: (MRG NIL NIL)
20: MRG returned NIL
19: SPLIT returned NIL
18: SPLIT returned (1)
17: SPLIT returned (1 1)
16: MRG returned (1 1)
15: SPLIT returned (1 1)
14: SPLIT returned (1 1 1)
13: SPLIT returned (1 1 1 1)
12: MRG returned (1 1 1 1)
11: SPLIT returned (1 1 1 1)
10: SPLIT returned (2 1 1 1 1)
9: SPLIT returned (1 2 1 1 1 1)
8: MRG returned (1 2 1 1 1 1)
7: SPLIT returned (1 2 1 1 1 1)
6: SPLIT returned (1 1 2 1 1 1 1)
5: SPLIT returned (1 1 1 2 1 1 1 1)
4: MRG returned (1 1 1 2 1 1 1 1)
3: SPLIT returned (1 1 1 2 1 1 1 1)
2: SPLIT returned (1/2 1 1 1 2 1 1 1 1)
1: SPLIT returned (1/2 1/2 1 1 1 2 1 1 1 1)
0: MRG returned (1/2 1/2 1 1 1 2 1 1 1 1)
I made no attempt to optimize the code, I just tried to do something that works correctly in a way that can produce a useful trace. But this looks like something for which a loop might work too.
Iterative version (edit)
Here is a version without recursion along with debugging statements:
(defun mrg% (lx ly)
(with-list-collector (collect)
(flet ((collect (v)
"Add print statements to COLLECT"
(print (list :collect v))
(collect v)))
(dolist (x lx)
(loop
(print (list :split x ly))
(unless (plusp x)
(return))
(assert ly)
(let ((y (pop ly)))
(if (<= y x)
(decf x (collect y))
(return (push (- y (collect x)) ly)))))))))
With your example:
(mrg% '(1 2 3 2 2 )
'(1/2 1/2 1 2 2 1 2 1))
... prints:
(:SPLIT 1 (1/2 1/2 1 2 2 1 2 1))
(:COLLECT 1/2)
(:SPLIT 1/2 (1/2 1 2 2 1 2 1))
(:COLLECT 1/2)
(:SPLIT 0 (1 2 2 1 2 1))
(:SPLIT 2 (1 2 2 1 2 1))
(:COLLECT 1)
(:SPLIT 1 (2 2 1 2 1))
(:COLLECT 1)
(:SPLIT 3 (1 2 1 2 1))
(:COLLECT 1)
(:SPLIT 2 (2 1 2 1))
(:COLLECT 2)
(:SPLIT 0 (1 2 1))
(:SPLIT 2 (1 2 1))
(:COLLECT 1)
(:SPLIT 1 (2 1))
(:COLLECT 1)
(:SPLIT 2 (1 1))
(:COLLECT 1)
(:SPLIT 1 (1))
(:COLLECT 1)
(:SPLIT 0 NIL)
For completeness, here is the macro I am using:
(defmacro with-list-collector
((collector-name &optional name copy-p) &body body)
"Bind COLLECTOR-NAME as a local function to collect items in a list.
A call to (COLLECTOR-NAME VALUE) accumulates VALUE into a list, in the
same order as the calls are being made. The resulting list can be
accessed through the symbol NAME, if given, or as the return value of
WITH-LIST-COLLECTOR.
The return value of (COLLECTOR-NAME VALUE) is VALUE.
If COPY-P is T, each access to NAME performs a copy of the list under
construction. Otherwise, NAME refers to a list which last cons-cell is
modified after each call to COLLECTOR-NAME (except if it is NIL).
The return value of the whole form is the list being built, ONLY when
NAME is NIL. Otherwise, the return value is given by the last form of
BODY: it is assumed that the list will be accessed by NAME if
necessary, and that the interesting value is given by BODY."
(assert (or (not copy-p) name) ()
"A COPY argument is only valid when a NAME is given.")
(alexandria:with-gensyms (queue head value)
(let ((flet-expr `(flet ((,collector-name (,value)
(prog1 ,value
(setf ,queue
(setf (cdr ,queue)
(cons ,value nil))))))
(declare (inline ,collector-name))
,#body)))
`(let* ((,queue (cons nil nil))
(,head ,queue))
,(if name
`(symbol-macrolet
((,name ,(if copy-p
`(copy-seq (cdr ,head))
`(cdr ,head))))
,flet-expr)
;; anonymous list : return as result
`(progn ,flet-expr
(cdr ,head)))))))
It seems to me that the list elements are like pauses between beats. My algorithm would at each step look for the minimum pause, then reduce the remaining current pauses by that and advance the lists when their current pause is zero.
To illustrate, I put a print instruction into the loop:
(defun merge-beats (&rest lists)
(do* ((minpause nil (reduce #'min (mapcar #'first pauses)))
(result () (cons minpause result))
(pauses lists
(remove nil
(mapcar (lambda (pause-list)
(let ((current-pause (- (first pause-list)
minpause)))
(if (zerop current-pause)
(rest pause-list)
(cons current-pause
(rest pause-list)))))
pauses)))
(- #1=(print (list :minpause minpause :result result :pauses pauses))
#1#))
((endp pauses) (nreverse result))))
CL-USER> (merge-beats '(1 2 3 2 2)
'(1/2 1/2 1 2 2 1 2 1))
(:MINPAUSE NIL :RESULT NIL :PAUSES ((1 2 3 2 2) (1/2 1/2 1 2 2 1 2 1)))
(:MINPAUSE 1/2 :RESULT (1/2) :PAUSES ((1/2 2 3 2 2) (1/2 1 2 2 1 2 1)))
(:MINPAUSE 1/2 :RESULT (1/2 1/2) :PAUSES ((2 3 2 2) (1 2 2 1 2 1)))
(:MINPAUSE 1 :RESULT (1 1/2 1/2) :PAUSES ((1 3 2 2) (2 2 1 2 1)))
(:MINPAUSE 1 :RESULT (1 1 1/2 1/2) :PAUSES ((3 2 2) (1 2 1 2 1)))
(:MINPAUSE 1 :RESULT (1 1 1 1/2 1/2) :PAUSES ((2 2 2) (2 1 2 1)))
(:MINPAUSE 2 :RESULT (2 1 1 1 1/2 1/2) :PAUSES ((2 2) (1 2 1)))
(:MINPAUSE 1 :RESULT (1 2 1 1 1 1/2 1/2) :PAUSES ((1 2) (2 1)))
(:MINPAUSE 1 :RESULT (1 1 2 1 1 1 1/2 1/2) :PAUSES ((2) (1 1)))
(:MINPAUSE 1 :RESULT (1 1 1 2 1 1 1 1/2 1/2) :PAUSES ((1) (1)))
(:MINPAUSE 1 :RESULT (1 1 1 1 2 1 1 1 1/2 1/2) :PAUSES NIL)
(1/2 1/2 1 1 1 2 1 1 1 1)
CL-USER>
Related
I'm doing an algorithm that randomizes a TSP (array of citys) based on 1 TSP.
(do ((i 0 (+ i 1)))
((= i n-population))
(setf (aref population i) (shuffle TSP 100))
)
And as far as I know im filling up i positions of the array population with (shuffle TSP 100) that is beeing called each iteration, but the algorithm is setting all array positions and not just i position.
[Note. An earlier version of this answer contained a mistake which would badly alter the statistics of the shuffling: please check below for the corrected version and a note as to what the problem was.]
Given your code, slightly elaborated to turn it into a function:
(defun fill-array-with-something (population n-population TSP)
(do ((i 0 (+ i 1)))
((= i n-population))
(setf (aref population i) (shuffle TSP 100))))
Then each element of population from 0 to (1- n-population) will be set to the result of (shuffle TSP 100). There are then two possibilities:
(shuffle TSP 100) returns a fresh object from each call;
(shuffle TSP 100) returns the same object – probably TSP – from each call.
In the first case, each element of the array will have a distinct value. In the second case, all elements below n-population will have the same value.
Without knowing what your shuffle function does, here is an example of one which will give the latter behaviour:
(defun shuffle (vec n)
;; shuffle pairs of elts of VEC, N times.
(loop with max = (length vec)
repeat n
do (rotatef (aref vec (random max))
(aref vec (random max)))
finally (return vec)))
And we can test this:
> (let ((pop (make-array 10))
(tsp (vector 0 1 2 3 4 5 6 7 8 9 )))
(fill-array-with-something pop (length pop) tsp)
pop)
#(#(2 8 7 1 3 9 5 4 0 6) #(2 8 7 1 3 9 5 4 0 6) #(2 8 7 1 3 9 5 4 0 6)
#(2 8 7 1 3 9 5 4 0 6) #(2 8 7 1 3 9 5 4 0 6) #(2 8 7 1 3 9 5 4 0 6)
#(2 8 7 1 3 9 5 4 0 6) #(2 8 7 1 3 9 5 4 0 6) #(2 8 7 1 3 9 5 4 0 6)
#(2 8 7 1 3 9 5 4 0 6))
As you can see all the elements are mysteriously the same thing, which is because my shuffle simply returned its first argument, having modified it in place.
You can check this by either explicitly checking the result of shuffle, or by, for instance, using *print-circle* to see the sharing. The latter approach is pretty neat:
> (let ((*print-circle* t)
(pop (make-array 10))
(tsp (vector 0 1 2 3 4 5 6 7 8 9 )))
(fill-array-with-something pop (length pop) tsp)
(print pop)
(values))
#(#1=#(4 6 7 0 1 2 5 9 3 8) #1# #1# #1# #1# #1# #1# #1# #1# #1#)
And now it's immediately apparent what the problem is.
The solution is to make sure either that shuffle returns a fresh object, or to copy its result. With my shuffle this can be done like this:
(defun fill-array-with-something (population n-population tsp)
(do ((i 0 (+ i 1)))
((= i n-population))
(setf (aref population i) (shuffle (copy-seq TSP) 100))))
Note that a previous version of this answer had (copy-seq (shuffle TSP 100)): with my version of shuffle this is a serious mistake, as it means that the elements in population are related to each other but get increasingly shuffled as you go along. With (shuffle (copy-seq TSP) 100) each element gets the same amount of shuffling, independently.
And now
> (let ((*print-circle* t)
(pop (make-array 10))
(tsp (vector 0 1 2 3 4 5 6 7 8 9 )))
(fill-array-with-something pop (length pop) tsp)
(print pop)
(values))
#(#(8 3 4 1 6 9 2 5 0 7) #(8 6 5 1 3 0 4 2 9 7) #(5 0 4 7 1 6 9 3 2 8)
#(3 0 7 6 2 9 4 5 1 8) #(8 2 5 1 7 3 9 0 4 6) #(0 5 6 3 8 7 2 1 4 9)
#(4 1 3 7 8 0 5 2 9 6) #(6 9 1 5 0 7 4 2 3 8) #(2 7 5 8 0 9 6 3 4 1)
#(5 4 8 9 6 7 2 0 1 3))
I suspect that the problem is in OP function SHUFFLE which has not yet been shared; my suspicion is that SHUFFLE is shuffling the *TSP* array itself in place instead of creating a shuffled copy of that array. The POPULATION values are then all referencing the same shuffled *TSP* array.
To solve this problem, SHUFFLE should return a shuffled array instead of shuffling the array in place. Here is a function that performs a Fisher-Yates shuffle on a vector:
(defun shuffle-vector (vect)
"Takes a vector argument VECT and returns a shuffled vector."
(let ((result (make-array (length vect) :fill-pointer 0)))
(labels ((shuffle (v)
(if (zerop (length v))
result
(let* ((i (random (length v)))
(x (elt v i)))
(vector-push x result)
(shuffle (concatenate 'vector
(subseq v 0 i)
(subseq v (1+ i))))))))
(shuffle vect))))
Testing in the REPL:
CL-USER> (defvar *TSP* #("Village" "Town" "City" "Metropolis" "Megalopolis"))
*TSP*
CL-USER> (defvar *n-population* 5)
*N-POPULATION*
CL-USER> (defvar *population* (make-array *n-population*))
*POPULATION*
CL-USER> (dotimes (i *n-population*)
(setf (aref *population* i) (shuffle-vector *TSP*)))
NIL
CL-USER> *population*
#(#("Megalopolis" "City" "Metropolis" "Town" "Village")
#("Megalopolis" "Metropolis" "Town" "City" "Village")
#("City" "Megalopolis" "Town" "Village" "Metropolis")
#("City" "Megalopolis" "Village" "Metropolis" "Town")
#("Megalopolis" "Town" "Metropolis" "City" "Village"))
I'd like to insert the result of an evaluated Clojure expression directly in my Emacs buffer, in pretty-printed form.
For example, with something like:
;; [emacs lisp]
(insert (nrepl-dict-get (nrepl-sync-request:eval "(range 30)") "value"))
I get, in the buffer of interest,
;;=>
(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29)
In the past, I've let Clojure pretty-print things for me, as so:
(nrepl-dict-get
(nrepl-sync-request:eval
(format "(clojure.core/let [x %s] (with-out-str (clojure.pprint/pprint x)))"
"(range 30)"))
"value")
;;=>
"(0\n 1\n 2\n 3\n 4\n 5\n 6\n 7\n 8\n 9\n 10\n 11\n 12\n 13\n 14\n 15\n 16\n 17\n 18\n 19\n 20\n 21\n 22\n 23\n 24\n 25\n 26\n 27\n 28\n 29)\n"
However, the " and \n are being inserted escaped; I want them to be inserted unescaped. In other words, I want the pretty-printed result to be inserted directly without escaping quotes or newlines. This used to work in earlier versions of Cider and cider-nrepl.
Wrapping:
(nrepl-dict-get
(nrepl-sync-request:eval
(format "(clojure.core/let [x %s] (with-out-str (clojure.pprint/pprint x)))"
"(range 30)"))
"value")
in read should solve this.
I've just added this feature to lispy (it's a Paredit-style
package that uses Cider for Clojure eval):
2E will to a pretty-printed eval-and-insert, while
E will keep doing a plain one.
Here's an example (| represents point):
|(for [x (range 8)] (range x))
After E:
|(for [x (range 8)] (range x))
(() (0) (0 1) (0 1 2) (0 1 2 3) (0 1 2 3 4) (0 1 2 3 4 5) (0 1 2 3 4 5 6))
After 2E:
|(for [x (range 8)] (range x))
(()
(0)
(0 1)
(0 1 2)
(0 1 2 3)
(0 1 2 3 4)
(0 1 2 3 4 5)
(0 1 2 3 4 5 6))
Of course you can still do EjM to accomplish the same thing:
(for [x (range 8)] (range x))
|(()
(0)
(0 1)
(0 1 2)
(0 1 2 3)
(0 1 2 3 4)
(0 1 2 3 4 5)
(0 1 2 3 4 5 6))
I could figure out some way to do this myself but I have a feeling there's a simpler, perhaps built-in way to do this. I want to see if any two lists share an element. These are the two lists I'm dealing with at the moment:
((0 1 2) (3 4 5) (6 7 8) (0 3 6) (1 3 7) (2 4 8) (0 4 8) (2 4 6))
((0 1 7) (0 1 6) (0 1 3) (0 3 7) (0 3 6) (0 6 7) (1 3 7) (1 3 6) (1 6 7) (3 6 7))
Since both lists contain (1 3 7), I'd like a comparison of the lists to return T.
Is there a better way to do this than just setting up a couple DOLISTs?
How about INTERSECTION?
(defvar a '((0 1 2) (3 4 5) (6 7 8) (0 3 6) (1 3 7) (2 4 8) (0 4 8) (2 4 6)))
=> A
(defvar b '((0 1 7) (0 1 6) (0 1 3) (0 3 7) (0 3 6) (0 6 7) (1 3 7) (1 3 6) (1 6 7) (3 6 7)))
=> B
(intersection a b :test 'equal)
=> ((1 3 7) (0 3 6))
If I have a list like this
((0 1 2) (3 4 5) (6 7 8) (0 3 6) (1 3 7) (2 4 8) (0 4 8) (2 4 6))
And I want to find the index of (0 3 6), is there a built-in function to do this? POSITION doesn't seem to work when the search item is itself a list.
See hyperspec. POSITION can take a :test argument:
(position '(0 3 6)
'((0 1 2) (3 4 5) (6 7 8) (0 3 6) (1 3 7) (2 4 8) (0 4 8) (2 4 6))
:test #'equal))
3
The default test for POSITION (and other sequence operations) is EQL, by the way.
If I had a N lists each of length M, how could I write a nice clean function to return a single list of length M, where each element is the sum of the corresponding elements in the N lists?
(starting to learn lisp - go easy!)
This is a job for the map and apply functions. Here is a way to do it, with an EDIT suggested by Nathan Sanders:
(define (add-lists . more)
(apply map + more))
For a more matlab like syntax:
(define (piecewise func)
(lambda more
(apply map func more)))
(define pw piecewise)
((pw +) '(1 2 3 4 5) '(6 7 8 9 0))
((pw -) '(1 2 3 4 5) '(6 7 8 9 0))
((pw *) '(1 2 3 4 5) '(6 7 8 9 0))
((pw /) '(1 2 3 4 5) '(6 7 8 9 0.1))
outputs:
(7 9 11 13 5)
(-5 -5 -5 -5 5)
(6 14 24 36 0)
(1/6 2/7 3/8 4/9 50.0)
Just this works in MIT scheme.
(map + '(1 2 3) '(4 5 6) '(7 8 9))
;Value 28: (12 15 18)