fork(1) download
  1. ; 2max
  2.  
  3. (define (take n xs)
  4. (let loop ((n n) (xs xs) (ys '()))
  5. (if (or (zero? n) (null? xs))
  6. (reverse ys)
  7. (loop (- n 1) (cdr xs)
  8. (cons (car xs) ys)))))
  9.  
  10. (define (sum xs) (apply + xs))
  11.  
  12. (define (digits n . args)
  13. (let ((b (if (null? args) 10 (car args))))
  14. (let loop ((n n) (d '()))
  15. (if (zero? n) d
  16. (loop (quotient n b)
  17. (cons (modulo n b) d))))))
  18.  
  19. (define (2max xs) (if (< (length xs) 2) (list -1) (take 2 (sort xs >))))
  20.  
  21. (define (sum-digits n) (sum (digits n)))
  22.  
  23. (define (cluster proc lt? lst)
  24. (define (insert key value tree)
  25. (cond ((null? tree)
  26. (list key (list value) '() '()))
  27. ((lt? key (car tree))
  28. (let ((left (insert key value (caddr tree))))
  29. (list (car tree) (cadr tree) left (cadddr tree))))
  30. ((lt? (car tree) key)
  31. (let ((right (insert key value (cadddr tree))))
  32. (list (car tree) (cadr tree) (caddr tree) right)))
  33. (else
  34. (let ((new (cons value (cadr tree))))
  35. (list key new (caddr tree) (cadddr tree))))))
  36. (define (in-order tree)
  37. (if (null? tree) '()
  38. (append (in-order (caddr tree))
  39. (list (cadr tree))
  40. (in-order (cadddr tree)))))
  41. (let loop ((lst lst) (tree '()))
  42. (if (null? lst) (in-order tree)
  43. (loop (cdr lst) (insert (proc (car lst)) (car lst) tree)))))
  44.  
  45. (define (f xs)
  46. (apply max (map sum (map 2max (cluster sum-digits < xs)))))
  47.  
  48. (display (f '(51 17 71 42))) (newline)
  49. (display (f '(1 2 3 4 5 6))) (newline)
Success #stdin #stdout 0s 8004KB
stdin
Standard input is empty
stdout
93
-1