A different list merging into a new list in Lisp -

i ask how can merge 2 different lists of numbers new list keeping "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 image below can give exact description of problem. lists numbers because must compare different units of 2 series , further combine points of start of each number of both series new serie.

image_1. think image best way describe problem.

based on description, wrote 2 mutually-recursive functions mrg , split:

• mrg iterates on first list, calls split each element
• split tries collect second list enough elements sum equal current element in first list. if element in second list large, split , remaining reinjected second list. split calls mrg when has finished processing current element in first list.

here trace of execution showing how result 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 optimize code, tried works correctly in way can produce useful trace. looks loop might work too.

iterative version (edit)

here version without recursion along debugging statements:

(defun mrg% (lx ly)   (with-list-collector (collect)     (flet ((collect (v)              "add print statements 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 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 macro using:

(defmacro with-list-collector    ((collector-name &optional name copy-p) &body body)   "bind collector-name local function collect items in list.  call (collector-name value) accumulates value list, in same order calls being made. resulting list can accessed through symbol name, if given, or return value of with-list-collector.   return value of (collector-name value) value.  if copy-p t, each access name performs copy of list under construction. otherwise, name refers list last cons-cell modified after each call collector-name (except if nil).  return value of whole form list being built, when name nil. otherwise, return value given last form of body: assumed list accessed name if necessary, , interesting value given body."   (assert (or (not copy-p) name) ()           "a copy argument valid when name 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 result               `(progn ,flet-expr                       (cdr ,head)))))))