From 28fc8a3eefce6a77613a7596b85aa302ee902683 Mon Sep 17 00:00:00 2001 From: Matthias Felleisen Date: Tue, 2 Nov 2010 17:59:25 -0400 Subject: [PATCH] fixed the documentation of contracts-first-extended, added code examples --- .../guide/contracts-examples/ho-version1.rkt | 23 ++++++ .../guide/contracts-examples/ho-version2.rkt | 38 ++++++++++ .../guide/contracts-examples/ho-version2a.rkt | 40 ++++++++++ .../guide/contracts-examples/ho-version3.rkt | 43 +++++++++++ .../guide/contracts-examples/ho-version3a.rkt | 52 +++++++++++++ .../guide/contracts-examples/ho-version3b.rkt | 54 ++++++++++++++ .../guide/contracts-examples/ho-version4.rkt | 57 +++++++++++++++ .../contracts-first-extended-example.scrbl | 73 ++++++++++--------- 8 files changed, 346 insertions(+), 34 deletions(-) create mode 100644 collects/scribblings/guide/contracts-examples/ho-version1.rkt create mode 100644 collects/scribblings/guide/contracts-examples/ho-version2.rkt create mode 100644 collects/scribblings/guide/contracts-examples/ho-version2a.rkt create mode 100644 collects/scribblings/guide/contracts-examples/ho-version3.rkt create mode 100644 collects/scribblings/guide/contracts-examples/ho-version3a.rkt create mode 100644 collects/scribblings/guide/contracts-examples/ho-version3b.rkt create mode 100644 collects/scribblings/guide/contracts-examples/ho-version4.rkt diff --git a/collects/scribblings/guide/contracts-examples/ho-version1.rkt b/collects/scribblings/guide/contracts-examples/ho-version1.rkt new file mode 100644 index 0000000000..814e690a62 --- /dev/null +++ b/collects/scribblings/guide/contracts-examples/ho-version1.rkt @@ -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) diff --git a/collects/scribblings/guide/contracts-examples/ho-version2.rkt b/collects/scribblings/guide/contracts-examples/ho-version2.rkt new file mode 100644 index 0000000000..90ed7c19cb --- /dev/null +++ b/collects/scribblings/guide/contracts-examples/ho-version2.rkt @@ -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) diff --git a/collects/scribblings/guide/contracts-examples/ho-version2a.rkt b/collects/scribblings/guide/contracts-examples/ho-version2a.rkt new file mode 100644 index 0000000000..36f80bedd5 --- /dev/null +++ b/collects/scribblings/guide/contracts-examples/ho-version2a.rkt @@ -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) diff --git a/collects/scribblings/guide/contracts-examples/ho-version3.rkt b/collects/scribblings/guide/contracts-examples/ho-version3.rkt new file mode 100644 index 0000000000..1e2c7f340d --- /dev/null +++ b/collects/scribblings/guide/contracts-examples/ho-version3.rkt @@ -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) diff --git a/collects/scribblings/guide/contracts-examples/ho-version3a.rkt b/collects/scribblings/guide/contracts-examples/ho-version3a.rkt new file mode 100644 index 0000000000..0fb848a899 --- /dev/null +++ b/collects/scribblings/guide/contracts-examples/ho-version3a.rkt @@ -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) diff --git a/collects/scribblings/guide/contracts-examples/ho-version3b.rkt b/collects/scribblings/guide/contracts-examples/ho-version3b.rkt new file mode 100644 index 0000000000..8ab05eb936 --- /dev/null +++ b/collects/scribblings/guide/contracts-examples/ho-version3b.rkt @@ -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) diff --git a/collects/scribblings/guide/contracts-examples/ho-version4.rkt b/collects/scribblings/guide/contracts-examples/ho-version4.rkt new file mode 100644 index 0000000000..f500266f20 --- /dev/null +++ b/collects/scribblings/guide/contracts-examples/ho-version4.rkt @@ -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) \ No newline at end of file diff --git a/collects/scribblings/guide/contracts-first-extended-example.scrbl b/collects/scribblings/guide/contracts-first-extended-example.scrbl index 09aa965fa0..4d88f6867a 100644 --- a/collects/scribblings/guide/contracts-first-extended-example.scrbl +++ b/collects/scribblings/guide/contracts-first-extended-example.scrbl @@ -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}