All possible ways of merging two lists while keeping their order

Question

I am writing a function gives all possible ways of merging two ordered lists such that in the merged list, the elements are still ordered according to the elements in their respective starting list.

For example, merging (a b) with (1 2) would result in:

((a b 1 2) (a 1 b 2)(a 1 2 b) (1 a b 2) (1 a 2 b) (1 2 a b))

My initial intuition was to map over an indexing list:

(define (ordered-merge l1 l2)
  (if (null? l2)
      (list l1)
      (let ((num-list (enumerate 0 (length l1) inc identity)))
        (flatten (lambda (pos)
                   (map (lambda (result) (append (take l1 pos)
                                                 (cons (car l2) result)))
                        (ordered-merge (drop l1 pos) (cdr l2))))
                 num-list))))

enumerate is just a list-builder, which here will return a list (0 1 ... (length l1)).

But I'm having feelings this is probably trying to force imperative style into functional style.

Here's my second attempt:

(define (ordered-merge2 l1 l2)
  (cond ((null? l1) (list l2))
        ((null? l2) (list l1))
        (else
         (let ((insert-here (ordered-merge2 l1 (cdr l2)))
               (not-here (ordered-merge2 (cdr l1) l2)))
           (append (map (lambda (result) (cons (car l2) result))
                        insert-here)
                   (map (lambda (result) (cons (car l1) result))
                        not-here))))))

How could this be improved?

Answer 1

Since lists are built last to first and you want output to read first to last, we need to reverse the inputs. We will also need two accumulator (one for the permutation and one for results so far and some sort of recursion. Given that it's just a matter of messaging the logic into place.

(define (ordered-merge3 l1 l2)
  (let loop ((lefts (reverse l1)) (rights (reverse l2)) 
             (permu '()) (acc '()))
     (cond ((or (null? lefts) (null? rights))
            (let ((new-permu (if (null? lefts)
                                 (append (reverse rights) permu)
                                 (append (reverse lefts)  permu))))
               (cons new-permu acc)))
        ;;base case, if either lefts or rights is null there is only one in-order permutation that can be formed.       
          (else (loop lefts 
                      (cdr rights) 
                      (cons (car rights) permu)
                      (loop (cdr lefts)
                            rights
                            (cons (car lefts) permu)
                            acc))))))

The last bit is the hard part to explain. When asked for the in-order permutation of lefts and rights, you can start forming the next permutation with either the car of lefts or the car of rights. In the nested loops here the inner loop is evaluated first because the scheme interpreter does eager evaluation. The value returned by examining the permutations that involve picking the left side is going to be one or more permutations tacked onto the existing known permutation at that point in the calculation. This returned value is used as the accumulator when examining the permutations that involve picking the car of the right side instead.

As far as effeciency, this loop executes once for every element in every permutation. Nothing fancy there, but it will do it in a memory stack no deeper than the sum of the length of the inputs.

(ordered-merge (list 1 2) (list 'a 'b))

;Value 14: ((1 2 a b) (1 a 2 b) (a 1 2 b) (1 a b 2) (a 1 b 2) (a b 1 2))

Overall the shape of how I would approach it is very similar to your second attempt. Just a few critiques. Generally cons is the way to build lists. Secondly by mapping up from prior results you are keeping quite a bit extra of data on the stack.

1 ]=> (ordered-merge2 '(1 2 3 4) '(a b c))
(10 0 0)
1 ]=> (ordered-merge3 '(1 2 3 4) '(a b c))
(0 0 1)
1 ]=> (ordered-merge2 '(1 2 3 4 5 6 7 8 9) '(a b c d e f g h))
(170 0 173)
1 ]=> (ordered-merge3 '(1 2 3 4 5 6 7 8 9) '(a b c d e f g h))
(70 0 72)
1 ]=> (ordered-merge2 '(1 2 3 4 5 6 7 8 9) '(a b c d e f g h j k l m o p))
;Aborting!: out of memory
1 ]=> (ordered-merge2 '(1 2 3 4 5 6 7 8 9) '(a b c d e f g h j k l m ))
(2540 1090 3633)
1 ]=> (ordered-merge3 '(1 2 3 4 5 6 7 8 9) '(a b c d e f g h j k l m ))
(860 50 905)
 ]=> (ordered-merge3 '(1 2 3 4 5 6 7 8 9) '(a b c d e f g h j k l m o p q))
(3820 1080 4902)
1 ]=>(ordered-merge3 '(1 2 3 4 5 6 7 8 9) '(a b c d e f g h j k l m o p q r))
;Aborting!: out of memory

Results are timings (cpu-time garbage-collection-time real-time)

Addendum:

I also figure out that my output list was sharing internal list structure where possible.

(define test2 (ordered-merge2 (list 1 2 3) (list 'a 'b 'c)))
(define test (ordered-merge3 (list 1 2 3) (list 'a 'b 'c))
(for-each (lambda (x) (begin (display x) (newline))) test)
(for-each (lambda (x) (begin (display x) (newline))) test2)

Compare the sublists (1 a 2 3 b c) and (a 1 2 3 b c) which in test are elements 2 and 3, and in test2 are 4 and 6. eq? is only true for lists if they are the same object in memory

1 ]=>(eq? (cddr (list-ref test 2)) (cddr (list-ref test 3)))
;Value: #t

1 ]=> (eq? (cddr (list-ref test2 4)) (cddr (list-ref test2 10)))
;Value: #f

1 ]=> (equal? (cddr (list-ref test2 4)) (cddr (list-ref test2 10)))    
;Value: #t