56 lines
1.8 KiB
Racket
56 lines
1.8 KiB
Racket
#lang racket/load
|
|
|
|
(module a racket/base
|
|
(require racket/contract (only-in racket/list first second rest empty?) (prefix-in old: (only-in racket/list argmax)))
|
|
|
|
(define (argmax f lov)
|
|
(cond
|
|
[(empty? (rest lov)) (first lov)]
|
|
[else (define r (old:argmax f lov))
|
|
(if (and (pair? r) (eq? (cadr r) 'bananas))
|
|
'(3 oranges) ;; a bug
|
|
r)]))
|
|
|
|
|
|
(provide
|
|
(contract-out
|
|
[argmax
|
|
(->i ([f (-> any/c real?)] [lov (and/c pair? list?)]) ()
|
|
(r (f lov)
|
|
(lambda (r)
|
|
(define f@r (f r))
|
|
(define flov (map f lov))
|
|
(and (is-first-max? r f@r (map list lov flov))
|
|
(dominates-all f@r flov)))))]))
|
|
|
|
; f@r is greater or equal to all f@v in flov
|
|
(define (dominates-all f@r flov)
|
|
(for/and ((f@v flov)) (>= f@r f@v)))
|
|
|
|
; r is (second x) for the first x in flov+lov s.t. (= (first x) f@r)
|
|
(define (is-first-max? r f@r lov+flov)
|
|
(define fst (first lov+flov))
|
|
(if (= (second fst) f@r)
|
|
(eq? (first fst) r)
|
|
(is-first-max? f@r r (rest lov+flov)))))
|
|
|
|
(module b racket/base
|
|
(require 'a)
|
|
(require racket/contract/private/blame)
|
|
;; --- copied from version 1 ---
|
|
(with-handlers ([exn:fail:contract:blame? void])
|
|
(printf "*** 0: ~s\n" (argmax car '())))
|
|
(with-handlers ([exn:fail:contract:blame? void])
|
|
(printf "*** 1: ~s\n" (argmax car '())))
|
|
(with-handlers ([exn:fail:contract:blame? void])
|
|
(printf "2***: ~s\n" (argmax car '((apples 3)))))
|
|
(printf "3: ~s\n" (argmax car '((3 apples) (3 oranges))))
|
|
;; --- copies from version 2 ---
|
|
(printf "4: ~s\n" (argmax sqrt '(1)))
|
|
(printf "5: ~s\n" (argmax car '((3 apples) (3 oranges))))
|
|
;; --- new tests ---
|
|
(with-handlers ([exn:fail:contract:blame? void])
|
|
(printf "***6: ~s\n" (argmax car '((3 bananas) (3 oranges))))))
|
|
|
|
(require 'b)
|