6
\$\begingroup\$

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?

\$\endgroup\$
0

1 Answer 1

2
\$\begingroup\$

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
\$\endgroup\$
4
  • \$\begingroup\$ Good point. I have been diving through SICP lately and got used to the idea that making code human readable by using "conventional interfaces" (map, filter, fold) should be preferred over performance gains. If performance is such an issue, perhaps using append! instead of append in ordered-merge2 would make things faster? \$\endgroup\$
    – samlaf
    Feb 19, 2016 at 13:55
  • \$\begingroup\$ Also, are you timing the procedures using 'with-timing? Is there a way to stop it from printing the value of the call? \$\endgroup\$
    – samlaf
    Feb 19, 2016 at 14:00
  • \$\begingroup\$ I actually tried append! in your version, and it didn't make much difference. I did you with-timing in fact. If you wrap the body of the thunk with a begin you can put in a second value like "done" to force it through the calculation but disregard the results. \$\endgroup\$
    – WorBlux
    Feb 19, 2016 at 22:37
  • \$\begingroup\$ Map, fold... and other higher-order function are good to use when they fit, the shape of the recursion and the data structures make it hard to do. And in scheme at least it's not built-in to map to data structures that aren't lists. \$\endgroup\$
    – WorBlux
    Feb 19, 2016 at 22:47

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.