; partitioning the telephone book
(define (split n xs)
(let loop ((n n) (xs xs) (zs '()))
(if (or (zero? n) (null? xs))
(values (reverse zs) xs)
(loop (- n 1) (cdr xs) (cons (car xs) zs)))))
(define (sum xs) (apply + xs))
(define phone (list 16 4 17 10 15 4 4 6 7 14 9 17 27 6 1 9 0 12 20 8 0 3 4 0 3 4))
(define (parts stars bars)
(if (= bars 1) (list (list stars))
(let loop ((i 0) (ps (parts stars (- bars 1))) (zs (list)))
(if (< stars i) zs
(if (null? ps)
(loop (+ i 1) (parts (- stars i 1) (- bars 1)) zs)
(loop i (cdr ps) (cons (cons i (car ps)) zs)))))))
(define (score xs part ideal)
(let loop ((xs xs) (part part) (zs (list)))
(if (pair? part)
(call-with-values
(lambda () (split (car part) xs))
(lambda (first rest)
(loop rest (cdr part) (cons first zs))))
(let loop ((zs (map sum (reverse zs))) (tot 0))
(if (null? zs) tot
(loop (cdr zs) (+ tot (abs (- (car zs) ideal)))))))))
(define (phone-book xs k)
(let ((min-part '()) (min-diff 10000000))
(do ((ps (parts (length xs) k) (cdr ps)))
((null? ps) (values min-part min-diff))
(let ((s (score xs (car ps) (quotient (sum xs) k))))
(when (< s min-diff)
(set! min-part (car ps))
(set! min-diff s))))))
(call-with-values
(lambda () (phone-book phone 4))
(lambda (part score)
(display part) (newline)
(display score) (newline)))