partition lcm

Write a function that accepts a list of numbers and returns the maximum least common multiple among the sums of all possible partitions of the list.

 $ cat mlp.rkt 
 #lang racket 
  
 (define (max-lcm-partition l) 
  
   ; Return the list (p1 p2 lcm) where p1 and p2 partition l and lcm is 
   ; the lcm of the sums of p1 and p2 such that lcm is among the 
   ; largest of all possible partitionings of l. 
  
   (let* 
  
     ((max-p1 '()) 
      (max-p2 l) 
      (max-lcm 0) 
      (f (lambda (p1 p2) 
          (let 
            ((lcm (lcm (apply + p1) (apply + p2)))) 
  
            (when (> lcm max-lcm) 
              (set! max-lcm lcm) 
              (set! max-p1 p1) 
              (set! max-p2 p2)))))) 
  
     (let loop ((l l) (p1 '()) (p2 '())) 
       (if (null? l) 
         (f p1 p2) 
         (let ((e (car l)) 
              (l (cdr l))) 
           (loop l (cons e p1) p2) 
           (loop l p1 (cons e p2))))) 
  
     (list max-p1 max-p2 max-lcm))) 
  
  
 (define (max-lcm-partition-2 l) 
  
   ; Return the list (p1 p2 lcm) where p1 and p2 partition l and lcm is 
   ; the lcm of the sums of p1 and p2 such that lcm is among the 
   ; largest of all possible partitionings of l. 
  
   (define N (length l)) 
  
   ; The exploded N-bit number that generates list partitions.  The extra  
   ; bit is the overflow bit signaling the end of partition generation. 
    
   (define partition (make-vector (+ N 1) 0)) 
  
   (define max-lcm 0) 
   (define max-p1 '()) 
   (define max-p2 l) 
  
   (define (add-1) 
  
     ; Add one to the partition number. 
      
     (let loop ((i N)) 
       (unless (< i 0) 
         (cond 
           ((= (vector-ref partition i) 0) 
              (vector-set! partition i 1)) 
           (#t 
              (vector-set! partition i 0) 
              (loop (- i 1))))))) 
  
   (define (sum-partition-lcm) 
  
     ; Determine if the current partition has a new maximum lcm. 
      
     (let loop ((i N) (l l) (p1 '()) (p2 '())) 
       (if (< i 1) 
  
         (let ((lcm (lcm (apply + p1) (apply + p2)))) 
           (when (< max-lcm lcm) 
             (set! max-lcm lcm) 
             (set! max-p1 p1) 
             (set! max-p2 p2))) 
  
         (let ((e (car l)) 
               (l (cdr l))) 
           (if (= (vector-ref partition i) 0) 
             (loop (- i 1) l (cons e p1) p2) 
             (loop (- i 1) l p1 (cons e p2))))))) 
  
   (do () ((= (vector-ref partition 0) 1)) 
     (sum-partition-lcm) 
     (add-1)) 
  
   (list max-p1 max-p2 max-lcm)) 
  
  
 (require rackunit) 
  
 (check-eq? (caddr (max-lcm-partition '(2 3 4 6))) 56) 
 (check-eq? (caddr (max-lcm-partition-2 '(2 3 4 6))) 56) 
  
 (define (chk l) 
   (let ((a1 (max-lcm-partition l)) 
         (a2 (max-lcm-partition-2 l))) 
     (check-eq? (caddr a1) (caddr a2)))) 
      
 (chk '(2 3 4 6)) 
 (chk '(2 4 5)) 
 (chk '(2 4 6 7)) 
  
  
 (define (make-random-list n) 
   (let loop ((i 0) (l '())) 
     (if (>= i n) 
       l 
       (loop (+ i 1) (cons (random 1000) l))))) 
  
 (define (check-random-list i n) 
   (do ((j i (- j 1))) ((< j 1)) 
     (chk (make-random-list n)))) 
    
 (check-random-list 10 15) 
  
  
 (define (time-it f N) 
   (let loop ((t 0) (n N)) 
     (if (= n 0) 
       (exact->inexact (/ t N)) 
       (let-values 
         (((a b c d) (time-apply f '()))) 
         (loop (+ t b) (- n 1)))))) 
  
 (define (time len n) 
   (let* ((l (make-random-list len)) 
          (p (lambda (t f) 
               (printf "~a, ~a elements ~a msec\n" 
                 t len (time-it (lambda () (f l)) n))))) 
     (p "recursive" max-lcm-partition) 
     (p "iterative" max-lcm-partition-2))) 
  
 (define N 10) 
  
 (for-each (lambda (l) (time l N)) '(10 15 20)) 
  
 $ mzscheme mlp.rkt 
 recursive, 10 elements 0.8 msec 
 iterative, 10 elements 0.8 msec 
 recursive, 15 elements 26.0 msec 
 iterative, 15 elements 36.4 msec 
 recursive, 20 elements 966.4 msec 
 iterative, 20 elements 1406.8 msec 
  
 $