fork download
  1. ; top five test scores
  2.  
  3. (import (rnrs hashtables (6)))
  4.  
  5. (define (take n xs)
  6. (let loop ((n n) (xs xs) (ys '()))
  7. (if (or (zero? n) (null? xs))
  8. (reverse ys)
  9. (loop (- n 1) (cdr xs)
  10. (cons (car xs) ys)))))
  11.  
  12. (define (sum xs) (apply + xs))
  13.  
  14. (define scores '((Bob 78) (Sue 75) (Bill 83) (Jill 88) (Joe 58)
  15. (Bob 93) (Sue 84) (Bill 81) (Jill 91) (Joe 75) (Bob 62) (Sue 93)
  16. (Bill 91) (Jill 99) (Joe 62) (Bob 92) (Sue 88) (Bill 88) (Jill 76)
  17. (Joe 61) (Bob 87) (Sue 92) (Bill 87) (Jill 85) (Joe 69) (Bob 85)
  18. (Sue 87) (Bill 93) (Jill 96) (Joe 65) (Bob 72) (Sue 88) (Bill 85)
  19. (Jill 83) (Joe 71)))
  20.  
  21. (define (final-score scores)
  22. (let ((ht (make-eq-hashtable)))
  23. (do ((scores scores (cdr scores)))
  24. ((null? scores)
  25. (call-with-values
  26. (lambda () (hashtable-entries ht))
  27. (lambda (names score-lists)
  28. (map (lambda (name score-list)
  29. (cons name (/ (sum (take 5 (sort score-list >))) 5.0)))
  30. (vector->list names) (vector->list score-lists)))))
  31. (hashtable-update! ht
  32. (caar scores)
  33. (lambda (score) (cons (cadar scores) score))
  34. '()))))
  35.  
  36. (display (final-score scores)) (newline)
Success #stdin #stdout 0.06s 10308KB
stdin
Standard input is empty
stdout
((Joe . 68.4) (Jill . 91.8) (Bill . 88.8) (Sue . 89.6) (Bob . 87.0))