suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fixed the documentation of contracts-first-extended, added code examples

Browse Source
This commit is contained in:
Matthias Felleisen 2010-11-02 17:59:25 -04:00
parent c83cf15695
commit 28fc8a3eef
8 changed files with 346 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/scribblings/guide/contracts-examples/ho-version1.rkt Normal file
View File

@ -0,0 +1,23 @@
#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)
(old:argmax f lov))
(provide/contract
[argmax (-> (-> any/c real?) (and/c pair? list?) any/c)]))
(module b racket/base
(require 'a)
(require racket/contract/private/blame)
(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)))))
(require 'b)

38
collects/scribblings/guide/contracts-examples/ho-version2.rkt Normal file
View File

@ -0,0 +1,38 @@
#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)
(define r (old:argmax f lov))
(if (and (number? r) (= r 1/4)) 1/5 r)) ;; a bug
(provide/contract
[argmax
(->i ([f (-> any/c real?)] [lov (and/c pair? list?)]) ()
(r (f lov)
(lambda (r)
(define f@r (f r))
(for/and ((v lov)) (>= f@r (f v))))))]))
(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))))
;; --- new tests ---
(printf "4: ~s\n" (argmax sqrt '(1)))
(with-handlers ([exn:fail:contract:blame? void])
(printf "*** 4: ~s\n" (argmax sqrt '(1/4))))
(printf "5: ~s\n" (argmax car '((3 apples) (3 oranges)))))
(require 'b)

40
collects/scribblings/guide/contracts-examples/ho-version2a.rkt Normal file
View File

@ -0,0 +1,40 @@
#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)
(define r (old:argmax f lov))
(if (and (number? r) (= r 1/4)) 1 r)) ;; yet another bug
(provide/contract
[argmax
(->i ([f (-> any/c real?)] [lov (and/c pair? list?)]) ()
(r (f lov)
(lambda (r)
(define f@r (f r))
(and
(memq r lov)
(for/and ((v lov)) (>= f@r (f v)))))))]))
(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)))
(with-handlers ([exn:fail:contract:blame? void])
(printf "*** 4: ~s\n" (argmax sqrt '(1/4))))
(printf "5: ~s\n" (argmax car '((3 apples) (3 oranges)))))
(require 'b)

43
collects/scribblings/guide/contracts-examples/ho-version3.rkt Normal file
View File

@ -0,0 +1,43 @@
#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)
(define r (old:argmax f lov))
(if (and (pair? r) (eq? (cadr r) 'bananas))
'(3 oranges)
r)) ;; yet another bug
(provide/contract
[argmax
(->i ([f (-> any/c real?)] [lov (and/c pair? list?)]) ()
(r (f lov)
(lambda (r)
(define f@r (f r))
(and (for/and ((v lov)) (>= f@r (f v)))
(eq? (first (memf (lambda (v) (= (f v) f@r)) lov))
r)))))]))
(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)

52
collects/scribblings/guide/contracts-examples/ho-version3a.rkt Normal file
View File

@ -0,0 +1,52 @@
#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)
(define r (old:argmax f lov))
(if (and (pair? r) (eq? (cadr r) 'bananas))
'(3 oranges)
r)) ;; yet another bug
(provide/contract
[argmax
(->i ([f (-> any/c real?)] [lov (and/c pair? list?)]) ()
(r (f lov)
(lambda (r)
(define f@r (f r))
(and (is-first-max? r f@r f lov)
(dominates-all f@r f lov)))))])
;; @code:comment{where}
;; @code:comment{@#,dominates1}
(define (dominates-all f@r f lov)
(for/and ((v lov)) (>= (f v) f@r)))
;; @code:comment{@#,first?1}
(define (is-first-max? r f@r f lov)
(eq? (first (memf (lambda (v) (= (f v) f@r)) lov)) r)))
(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)

54
collects/scribblings/guide/contracts-examples/ho-version3b.rkt Normal file
View File

@ -0,0 +1,54 @@
#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
[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)

57
collects/scribblings/guide/contracts-examples/ho-version4.rkt Normal file
View File

@ -0,0 +1,57 @@
#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
[argmax
(->i ([f (-> any/c real?)] [lov (and/c pair? list?)]) ()
(r (f lov)
(lambda (r)
(cond
[(empty? (rest lov)) (eq? (first lov) r)]
[else
(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 '())))
;; changed:
;; the functin violates -> real but the single element isn't checked
(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)

73
collects/scribblings/guide/contracts-first-extended-example.scrbl
View File

@ -35,7 +35,7 @@ racket
(define (argmax f lov) ...)
(provide/contract
[argmax (-> (-> any/c real?) (and/c pair? list?) anyc/)])
[argmax (-> (-> any/c real?) (and/c pair? list?) any/c)])
]
This contract captures two essential conditions of the informal
description of @scheme[argmax]:
@ -62,7 +62,8 @@ racket
(provide/contract
[argmax
(->i ([f (-> any/c real?)] [lov (and/c pair? list?)]) ()
(_ (lambda (r)
(r (f lov)
(lambda (r)
(define f@r (f r))
(for/and ((v lov)) (>= f@r (f v))))))])
]
@ -83,8 +84,9 @@ racket
(provide/contract
[argmax
(->i ([f (-> any/c real?)] [lov (and/c pair? list?)]) ()
(_ (lambda (r)
(define f@r (f r))
(r (f lov)
(lambda (r)
(define f@r (f r))
(and
(memq r lov)
(for/and ((v lov)) (>= f@r (f v)))))))])
@ -110,12 +112,13 @@ racket
(provide/contract
[argmax
(->i ([f (-> any/c real?)] [a (and/c cons? list?)]) ()
(_ (lambda (r)
(define f@r (f r))
(and (for/and ((v lov)) (>= f@r (f v)))
(eq? (first (memf (lambda (v) (= (f v) f@r)) lov))
r)))))])
(->i ([f (-> any/c real?)] [lov (and/c pair? list?)]) ()
(r (f lov)
(lambda (r)
(define f@r (f r))
(and (for/and ((v lov)) (>= f@r (f v)))
(eq? (first (memf (lambda (v) (= (f v) f@r)) lov))
r)))))])
]
That is, the @scheme[memf] function determines the first element of
@racket[lov] whose value under @racket[f] is equal to @racket[r]'s value
@ -146,11 +149,12 @@ racket
(provide/contract
[argmax
(->i ([f (-> any/c real?)] [a (and/c cons? list?)]) ()
(_ (lambda (r)
(define f@r (f r))
(and (is-first-max? r f@r f lov)
(dominates-all f@r f lov)))))])
(->i ([f (-> any/c real?)] [lov (and/c pair? list?)]) ()
(r (f lov)
(lambda (r)
(define f@r (f r))
(and (is-first-max? r f@r f lov)
(dominates-all f@r f lov)))))])
@code:comment{where}
@ -170,7 +174,6 @@ This step leaves us with the problem of the newly introduced inefficiency.
@racket[lov], we change the contract so that it computes these values and
reuses them as needed:
@(define dominates2
@multiarg-element['tt]{@list{
@racket[f@r] is greater or equal to all @racket[f@v] in @racket[flov]}})
@ -187,24 +190,25 @@ racket
(provide/contract
[argmax
(->i ([f (-> any/c real?)] [a (and/c cons? list?)]) ()
(_ (lambda (r)
(define f@r (f r))
(define flov (map f lov))
(and (is-first-max? r f@r lov flov)
(dominates-all f@r flov)))))])
(->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)))))])
@code:comment{where}
@code:comment{@#,dominates2}
(define (dominates-all f@r lov)
(define (dominates-all f@r flov)
(for/and ((f@v flov)) (>= f@r f@v)))
@code:comment{@#,first?2}
(define (is-first-max? r f@r lov+flov)
(define fst (first flov))
(if (= (first fst) f@r)
(eq? (second fst) r)
(define fst (first lov+flov))
(if (= (second fst) f@r)
(eq? (first fst) r)
(is-first-max? f@r r (rest lov+flov))))
]
Now the predicate on the result once again computes all values of @racket[f]
@ -240,14 +244,15 @@ racket
(provide/contract
[argmax
(->i ([f (-> any/c real?)] [lov (and/c pair? list?)]) ()
(_ (lambda (r)
(cond
[(empty? (rest a)) (eq? (first a) r)]
[else
(define f@r (f r))
(define flov (map f lov))
(and (is-first-max? r f@r lov flov)
(dominates-all f@r flov))]))))])
(r (f lov)
(lambda (r)
(cond
[(empty? (rest lov)) (eq? (first lov) r)]
[else
(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))]))))])
@code:comment{where}