ACL chapter 6, exercise 4

[WJ]

ANSI Common Lisp by Paul Graham

Chapter 6, exercise 4

The function returns (as values) the two highest-scoring items
in a list, the score being determined by a provided function.

This solution in CL was found on the web:

(defun most (fn lst)
(cond
((null lst) (values nil nil))
((null (cdr lst)) (values (car lst) nil))
(t (let* ((v1 (car lst))
(v2 (cadr lst))
(s1 (funcall fn v1))
(s2 (funcall fn v2))
(wins1 (if (> s1 s2) (cons s1 v1) (cons s2 v2)))
(wins2 (if (> s1 s2) (cons s2 v2) (cons s1 v1))))
(dolist (obj (cddr lst) (values (cdr wins1) (cdr wins2)))
(let ((s (funcall fn obj)))
(cond
((> s (car wins1))
(setf wins2 wins1
wins1 (cons s obj)))
((> s (car wins2))
(setf wins2 (cons s obj))))))))))


Now the Racket solutions.

The easy way:

(define (most2 func xs)
(apply values (map last
(take
(sort (map (lambda(x)(list (func x) x)) xs) > #:key car)
2))))

The hard way:

(define (most2 func xs)
(define-values (a b)
(for/fold ([bigger '(#f . #f)] [smaller '(#f . #f)])
([x xs])
(let* ([tmp (func x)]
[pair (cons tmp x)])
(cond ((not (car bigger)) (values pair smaller))
((or (not (car smaller)) (< (car smaller) tmp))
(if (<= tmp (car bigger))
(values bigger pair)
(values pair bigger)))
(#t (values bigger smaller))))))
(apply values (map cdr (list a b))))

[WJ]

WJ wrote:

> The easy way:
>
> (define (most2 func xs)
> (apply values (map last
> (take
> (sort (map (lambda(x)(list (func x) x)) xs) > #:key car)
> 2))))

That has two defects. It crashes when the list has fewer than
2 items, and it's not simple enough.

(define (most2 func xs)
(apply values

(take
(sort xs > #:key func #:cache-keys? #t)
(min 2 (length xs)))))

If the list has fewer than 2 items, then fewer than 2 values
are returned.

Using cache-keys? ensures that func is called only once for
each item.