fork download
copy 
  1. ; jane's homework
  2.  
  3. (define range (case-lambda ; start, start+step, ..., start+step<stop
  4.   ((stop) (range 0 stop (if (negative? stop) -1 1)))
  5.   ((start stop) (range start stop (if (< start stop) 1 -1)))
  6.   ((start stop step) (let ((le? (if (negative? step) >= <=)))
  7.     (let loop ((x start) (xs (list)))
  8.       (if (le? stop x) (reverse xs) (loop (+ x step) (cons x xs))))))
  9.   (else (error 'range "unrecognized arguments"))))
  10.  
  11. (define (sum xs) (apply + xs)) ; sum of elements of xs
  12.  
  13. (define digits (case-lambda ; list of base-b digits of n
  14.   ((n) (digits n 10))
  15.   ((n b) (do ((n n (quotient n b))
  16.               (ds (list) (cons (modulo n b) ds)))
  17.              ((zero? n) ds)))))
  18.  
  19. (define (part k xs) ; k'th lexicographical left-partition of xs
  20.   (let loop ((ds (reverse (digits k 2))) (xs xs) (ys (list)))
  21.     (if (null? ds) (reverse ys)
  22.       (if (zero? (car ds))
  23.           (loop (cdr ds) (cdr xs) ys)
  24.           (loop (cdr ds) (cdr xs) (cons (car xs) ys))))))
  25.  
  26. (define (max-lcm xs) ; max lcm of part-sums of 2-partitions of xs
  27.   (let ((len (length xs)) (tot (sum xs)))
  28.     (apply max (map (lambda (s) (lcm s (- tot s)))
  29.                     (map sum (map (lambda (k) (part k xs))
  30.                                   (range (expt 2 (- len 1)))))))))
  31.  
  32. (display (max-lcm '(2 3 4))) (newline) ; 20
  33. (display (max-lcm '(2 3 4 6))) (newline) ; 56
Success #stdin #stdout 0.04s 8188KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
20
56
https://ideone.com/c4yYG6
language:
Scheme (guile 2.2.4)
created:
6 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!