Scheme Merge with Assimilation

; Merge with assimilation
; Input: two sorted lists, A and B, with elements of the same unspecified format:
; An implied total ordering of such elements embodied by:
; A list element comparator yielding three states for less, equal and greater,
; coded as a negative numeric, 0, or a positive numeric.
; A list element assimilation operator for equal cases.

(define (merge-assim A B comp assim) (let mg ((A A)(B B)) 
(if (null? A) B (if (null? B) A (let ((t (comp (car A) (car B))))
    (cond ((positive? t) (cons (car A) (mg (cdr A) B)))
      ((negative? t) (cons (car B) (mg A (cdr B))))
      (else (cons (assim (car A)(car B)) (mg (cdr A) (cdr B))))))))))

; This was abstracted from the problem of representing a sparse vector where
; list elements are a pair (n . s), n being a component identifier, and s being a scalar.
; The code above is tested for this application thus:

(define (pair-cmp x y) (- (car y) (car x)))
(define (pair-mrg x y) (cons (car x) (+ (cdr x) (cdr y))))

(merge-assim '((0 . 4.5) (3 . 2) (4 . -3.7) (118 . 5)) '((4 . 6) (3000 . 1))
        pair-cmp pair-mrg)
=> ((0 . 4.5) (3 . 2) (4 . 2.3) (118 . 5) (3000 . 1))

And now a sort using the above. I think that this is the McCarthy sort where at each stage we have a list of sorted lists. We progress from one stage to the next by merging adjacent lists until there is only one.

(define (ms comp assim) (lambda (A) (let nm ((ll (map list A)))
  (if (pair? ll) (if (pair? (cdr ll))
  (nm (let srt ((a ll)) (if (null? a) '() (if (null? (cdr a)) a
     (cons (merge-assim (car a) (cadr a) comp assim) (srt (cddr a)))))))
  (car ll)) '()))))

(define ss (ms pair-cmp pair-mrg))
(ss '((2 . 6) (1 . 3) (6 . 4) (5 . 2) ( 1 . 6) (2 . 5)))

Here is the above sort without merge logic; it takes a boolean ‘less’ comparator.

(define (sort ls less) (let nm ((ll (map list ls)))
  (if (pair? ll) (if (pair? (cdr ll))
    (nm (let srt ((a ll)) (if (null? a) '() (if (null? (cdr a)) a (cons
     (let mg ((a (car a))(b (cadr a)))
      (cond ((null? a) b) ((null? b) a)
        ((less (car a) (car b)) (cons (car a) (mg (cdr a) b)))
        (#t (cons (car b) (mg a (cdr b)))))) (srt (cddr a)))))))
    (car ll)) '())))

(sort '(3 4 6 5 3 7 6 4 2 3 6 5 3 4) <)
; => (2 3 3 3 3 4 4 4 5 5 6 6 6 7)