0000: 23 21 72 36 72 73 0a 3b 3b 20 4e 4f 54 45 3a 20 #!r6rs.;; NOTE:
0010: 41 6c 6c 20 74 65 73 74 73 20 6f 66 20 63 6f 6d All tests of com
0020: 70 6c 65 78 20 6e 75 6d 62 65 72 73 20 68 61 76 plex numbers hav
0030: 65 20 62 65 65 6e 20 63 6f 6d 6d 65 6e 74 65 64 e been commented
0040: 20 6f 75 74 2c 0a 3b 3b 20 20 20 20 20 20 20 73 out,.;; s
0050: 69 6e 63 65 20 6d 61 6e 79 20 63 6f 6d 70 6c 65 ince many comple
0060: 78 20 70 72 69 6d 69 74 69 76 65 73 20 61 72 65 x primitives are
0070: 28 77 65 72 65 3f 29 20 6d 69 73 73 69 6e 67 20 (were?) missing
0080: 66 72 6f 6d 20 49 6b 61 72 75 73 2e 0a 0a 28 69 from Ikarus...(i
0090: 6d 70 6f 72 74 20 28 72 6e 72 73 29 20 0a 20 20 mport (rnrs) .
00a0: 20 20 20 20 20 20 28 72 6e 72 73 20 72 35 72 73 (rnrs r5rs
00b0: 29 0a 20 20 20 20 20 20 20 20 28 72 65 6e 61 6d ). (renam
00c0: 65 20 28 6f 6e 6c 79 20 28 72 6e 72 73 29 20 77 e (only (rnrs) w
00d0: 72 69 74 65 29 20 28 77 72 69 74 65 20 70 72 65 rite) (write pre
00e0: 74 74 79 2d 70 72 69 6e 74 29 29 0a 20 20 20 20 tty-print)).
00f0: 20 20 20 20 28 73 75 72 66 61 67 65 20 73 32 37 (surfage s27
0100: 20 72 61 6e 64 6f 6d 2d 62 69 74 73 29 0a 20 20 random-bits).
0110: 20 20 20 20 20 20 28 73 75 72 66 61 67 65 20 73 (surfage s
0120: 34 32 20 65 61 67 65 72 2d 63 6f 6d 70 72 65 68 42 eager-compreh
0130: 65 6e 73 69 6f 6e 73 29 0a 20 20 20 20 20 20 20 ensions).
0140: 20 28 73 75 72 66 61 67 65 20 73 36 37 20 63 6f (surfage s67 co
0150: 6d 70 61 72 65 2d 70 72 6f 63 65 64 75 72 65 73 mpare-procedures
0160: 29 29 0a 0a 3b 20 43 6f 70 79 72 69 67 68 74 20 ))..; Copyright
0170: 28 63 29 20 32 30 30 35 20 53 65 62 61 73 74 69 (c) 2005 Sebasti
0180: 61 6e 20 45 67 6e 65 72 20 61 6e 64 20 4a 65 6e an Egner and Jen
0190: 73 20 41 78 65 6c 20 53 7b 5c 6f 7d 67 61 61 72 s Axel S{\o}gaar
01a0: 64 2e 0a 3b 20 0a 3b 20 50 65 72 6d 69 73 73 69 d..; .; Permissi
01b0: 6f 6e 20 69 73 20 68 65 72 65 62 79 20 67 72 61 on is hereby gra
01c0: 6e 74 65 64 2c 20 66 72 65 65 20 6f 66 20 63 68 nted, free of ch
01d0: 61 72 67 65 2c 20 74 6f 20 61 6e 79 20 70 65 72 arge, to any per
01e0: 73 6f 6e 20 6f 62 74 61 69 6e 69 6e 67 0a 3b 20 son obtaining.;
01f0: 61 20 63 6f 70 79 20 6f 66 20 74 68 69 73 20 73 a copy of this s
0200: 6f 66 74 77 61 72 65 20 61 6e 64 20 61 73 73 6f oftware and asso
0210: 63 69 61 74 65 64 20 64 6f 63 75 6d 65 6e 74 61 ciated documenta
0220: 74 69 6f 6e 20 66 69 6c 65 73 20 28 74 68 65 0a tion files (the.
0230: 3b 20 60 60 53 6f 66 74 77 61 72 65 27 27 29 2c ; ``Software''),
0240: 20 74 6f 20 64 65 61 6c 20 69 6e 20 74 68 65 20 to deal in the
0250: 53 6f 66 74 77 61 72 65 20 77 69 74 68 6f 75 74 Software without
0260: 20 72 65 73 74 72 69 63 74 69 6f 6e 2c 20 69 6e restriction, in
0270: 63 6c 75 64 69 6e 67 0a 3b 20 77 69 74 68 6f 75 cluding.; withou
0280: 74 20 6c 69 6d 69 74 61 74 69 6f 6e 20 74 68 65 t limitation the
0290: 20 72 69 67 68 74 73 20 74 6f 20 75 73 65 2c 20 rights to use,
02a0: 63 6f 70 79 2c 20 6d 6f 64 69 66 79 2c 20 6d 65 copy, modify, me
02b0: 72 67 65 2c 20 70 75 62 6c 69 73 68 2c 0a 3b 20 rge, publish,.;
02c0: 64 69 73 74 72 69 62 75 74 65 2c 20 73 75 62 6c distribute, subl
02d0: 69 63 65 6e 73 65 2c 20 61 6e 64 2f 6f 72 20 73 icense, and/or s
02e0: 65 6c 6c 20 63 6f 70 69 65 73 20 6f 66 20 74 68 ell copies of th
02f0: 65 20 53 6f 66 74 77 61 72 65 2c 20 61 6e 64 20 e Software, and
0300: 74 6f 0a 3b 20 70 65 72 6d 69 74 20 70 65 72 73 to.; permit pers
0310: 6f 6e 73 20 74 6f 20 77 68 6f 6d 20 74 68 65 20 ons to whom the
0320: 53 6f 66 74 77 61 72 65 20 69 73 20 66 75 72 6e Software is furn
0330: 69 73 68 65 64 20 74 6f 20 64 6f 20 73 6f 2c 20 ished to do so,
0340: 73 75 62 6a 65 63 74 20 74 6f 0a 3b 20 74 68 65 subject to.; the
0350: 20 66 6f 6c 6c 6f 77 69 6e 67 20 63 6f 6e 64 69 following condi
0360: 74 69 6f 6e 73 3a 0a 3b 20 0a 3b 20 54 68 65 20 tions:.; .; The
0370: 61 62 6f 76 65 20 63 6f 70 79 72 69 67 68 74 20 above copyright
0380: 6e 6f 74 69 63 65 20 61 6e 64 20 74 68 69 73 20 notice and this
0390: 70 65 72 6d 69 73 73 69 6f 6e 20 6e 6f 74 69 63 permission notic
03a0: 65 20 73 68 61 6c 6c 20 62 65 0a 3b 20 69 6e 63 e shall be.; inc
03b0: 6c 75 64 65 64 20 69 6e 20 61 6c 6c 20 63 6f 70 luded in all cop
03c0: 69 65 73 20 6f 72 20 73 75 62 73 74 61 6e 74 69 ies or substanti
03d0: 61 6c 20 70 6f 72 74 69 6f 6e 73 20 6f 66 20 74 al portions of t
03e0: 68 65 20 53 6f 66 74 77 61 72 65 2e 0a 3b 20 0a he Software..; .
03f0: 3b 20 54 48 45 20 53 4f 46 54 57 41 52 45 20 49 ; THE SOFTWARE I
0400: 53 20 50 52 4f 56 49 44 45 44 20 60 60 41 53 20 S PROVIDED ``AS
0410: 49 53 27 27 2c 20 57 49 54 48 4f 55 54 20 57 41 IS'', WITHOUT WA
0420: 52 52 41 4e 54 59 20 4f 46 20 41 4e 59 20 4b 49 RRANTY OF ANY KI
0430: 4e 44 2c 0a 3b 20 45 58 50 52 45 53 53 20 4f 52 ND,.; EXPRESS OR
0440: 20 49 4d 50 4c 49 45 44 2c 20 49 4e 43 4c 55 44 IMPLIED, INCLUD
0450: 49 4e 47 20 42 55 54 20 4e 4f 54 20 4c 49 4d 49 ING BUT NOT LIMI
0460: 54 45 44 20 54 4f 20 54 48 45 20 57 41 52 52 41 TED TO THE WARRA
0470: 4e 54 49 45 53 20 4f 46 0a 3b 20 4d 45 52 43 48 NTIES OF.; MERCH
0480: 41 4e 54 41 42 49 4c 49 54 59 2c 20 46 49 54 4e ANTABILITY, FITN
0490: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC
04a0: 55 4c 41 52 20 50 55 52 50 4f 53 45 20 41 4e 44 ULAR PURPOSE AND
04b0: 0a 3b 20 4e 4f 4e 49 4e 46 52 49 4e 47 45 4d 45 .; NONINFRINGEME
04c0: 4e 54 2e 20 49 4e 20 4e 4f 20 45 56 45 4e 54 20 NT. IN NO EVENT
04d0: 53 48 41 4c 4c 20 54 48 45 20 41 55 54 48 4f 52 SHALL THE AUTHOR
04e0: 53 20 4f 52 20 43 4f 50 59 52 49 47 48 54 20 48 S OR COPYRIGHT H
04f0: 4f 4c 44 45 52 53 20 42 45 0a 3b 20 4c 49 41 42 OLDERS BE.; LIAB
0500: 4c 45 20 46 4f 52 20 41 4e 59 20 43 4c 41 49 4d LE FOR ANY CLAIM
0510: 2c 20 44 41 4d 41 47 45 53 20 4f 52 20 4f 54 48 , DAMAGES OR OTH
0520: 45 52 20 4c 49 41 42 49 4c 49 54 59 2c 20 57 48 ER LIABILITY, WH
0530: 45 54 48 45 52 20 49 4e 20 41 4e 20 41 43 54 49 ETHER IN AN ACTI
0540: 4f 4e 0a 3b 20 4f 46 20 43 4f 4e 54 52 41 43 54 ON.; OF CONTRACT
0550: 2c 20 54 4f 52 54 20 4f 52 20 4f 54 48 45 52 57 , TORT OR OTHERW
0560: 49 53 45 2c 20 41 52 49 53 49 4e 47 20 46 52 4f ISE, ARISING FRO
0570: 4d 2c 20 4f 55 54 20 4f 46 20 4f 52 20 49 4e 20 M, OUT OF OR IN
0580: 43 4f 4e 4e 45 43 54 49 4f 4e 0a 3b 20 57 49 54 CONNECTION.; WIT
0590: 48 20 54 48 45 20 53 4f 46 54 57 41 52 45 20 4f H THE SOFTWARE O
05a0: 52 20 54 48 45 20 55 53 45 20 4f 52 20 4f 54 48 R THE USE OR OTH
05b0: 45 52 20 44 45 41 4c 49 4e 47 53 20 49 4e 20 54 ER DEALINGS IN T
05c0: 48 45 20 53 4f 46 54 57 41 52 45 2e 0a 3b 20 0a HE SOFTWARE..; .
05d0: 3b 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ; --------------
05e0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
05f0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
0600: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
0610: 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 3b 0a 3b 20 43 6f ---------.;.; Co
0620: 6d 70 61 72 65 20 70 72 6f 63 65 64 75 72 65 73 mpare procedures
0630: 20 53 52 46 49 20 28 63 6f 6e 66 69 64 65 6e 63 SRFI (confidenc
0640: 65 20 74 65 73 74 73 29 0a 3b 20 53 65 62 61 73 e tests).; Sebas
0650: 74 69 61 6e 2e 45 67 6e 65 72 40 70 68 69 6c 69 tian.Egner@phili
0660: 70 73 2e 63 6f 6d 2c 20 4a 65 6e 73 61 78 65 6c ps.com, Jensaxel
0670: 40 73 6f 65 67 61 61 72 64 2e 6e 65 74 2c 20 32 @soegaard.net, 2
0680: 30 30 35 0a 3b 0a 3b 20 68 69 73 74 6f 72 79 20 005.;.; history
0690: 6f 66 20 74 68 69 73 20 66 69 6c 65 3a 0a 3b 20 of this file:.;
06a0: 20 20 53 45 2c 20 31 34 2d 4f 63 74 2d 32 30 30 SE, 14-Oct-200
06b0: 34 3a 20 66 69 72 73 74 20 76 65 72 73 69 6f 6e 4: first version
06c0: 0a 3b 20 20 20 2e 2e 0a 3b 20 20 20 53 45 2c 20 .; ...; SE,
06d0: 32 38 2d 46 65 62 2d 32 30 30 35 3a 20 61 64 61 28-Feb-2005: ada
06e0: 70 74 65 64 20 74 6f 20 6d 61 6b 65 20 69 74 20 pted to make it
06f0: 6f 6e 65 2d 73 6f 75 72 63 65 20 50 4c 54 2c 53 one-source PLT,S
0700: 34 38 2c 43 68 69 63 6b 65 6e 0a 3b 20 20 20 4a 48,Chicken.; J
0710: 53 2c 20 30 31 2d 4d 61 72 2d 32 30 30 35 3a 20 S, 01-Mar-2005:
0720: 66 69 72 73 74 20 76 65 72 73 69 6f 6e 0a 3b 20 first version.;
0730: 20 20 53 45 2c 20 31 38 2d 41 70 72 2d 32 30 30 SE, 18-Apr-200
0740: 35 3a 20 61 64 64 65 64 20 28 3c 3f 20 5b 63 5d 5: added (<? [c]
0750: 20 5b 78 20 79 5d 29 20 61 6e 64 20 28 3c 2f 3c [x y]) and (</<
0760: 3f 20 5b 63 5d 20 5b 78 20 79 20 7a 5d 29 0a 3b ? [c] [x y z]).;
0770: 20 20 20 53 45 2c 20 31 33 2d 4d 61 79 2d 32 30 SE, 13-May-20
0780: 30 35 3a 20 69 6e 63 6c 75 64 65 64 20 65 78 61 05: included exa
0790: 6d 70 6c 65 73 20 66 6f 72 20 3c 3f 20 65 74 63 mples for <? etc
07a0: 2e 0a 3b 20 20 20 53 45 2c 20 31 36 2d 4d 61 79 ..; SE, 16-May
07b0: 2d 32 30 30 35 3a 20 6e 61 6d 69 6e 67 20 63 6f -2005: naming co
07c0: 6e 76 65 6e 74 69 6f 6e 20 63 68 61 6e 67 65 64 nvention changed
07d0: 3b 20 63 6f 6d 70 61 72 65 2d 62 79 3c 20 6f 70 ; compare-by< op
07e0: 74 69 6f 6e 61 6c 20 78 20 79 0a 3b 0a 3b 20 54 tional x y.;.; T
07f0: 68 69 73 20 70 72 6f 67 72 61 6d 20 72 75 6e 73 his program runs
0800: 20 73 6f 6d 65 20 65 78 61 6d 70 6c 65 73 20 6f some examples o
0810: 6e 20 27 63 6f 6d 70 61 72 65 2e 73 63 6d 27 2e n 'compare.scm'.
0820: 0a 3b 20 49 74 20 68 61 73 20 62 65 65 6e 20 74 .; It has been t
0830: 65 73 74 65 64 20 75 6e 64 65 72 20 0a 3b 20 20 ested under .;
0840: 20 2a 20 50 4c 54 20 32 30 38 70 31 0a 3b 20 20 * PLT 208p1.;
0850: 20 2a 20 53 63 68 65 6d 65 20 34 38 20 31 2e 31 * Scheme 48 1.1
0860: 0a 3b 20 20 20 2a 20 43 68 69 63 6b 65 6e 20 31 .; * Chicken 1
0870: 2e 37 30 2e 0a 0a 3b 20 50 6f 72 74 61 62 69 6c .70...; Portabil
0880: 69 74 79 20 77 6f 72 6b 61 72 6f 75 6e 64 73 0a ity workarounds.
0890: 3b 20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ; ==============
08a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 0a 3b 20 54 68 =========.;.; Th
08b0: 65 20 70 75 72 70 6f 73 65 20 6f 66 20 74 68 65 e purpose of the
08c0: 73 65 20 70 72 6f 63 65 64 75 72 65 73 20 69 73 se procedures is
08d0: 20 74 6f 20 70 75 73 68 20 74 68 65 20 65 78 61 to push the exa
08e0: 6d 70 6c 65 73 0a 3b 20 74 68 72 6f 75 67 68 20 mples.; through
08f0: 61 20 53 63 68 65 6d 65 20 73 79 73 74 65 6d 20 a Scheme system
0900: 77 69 74 68 20 73 65 76 65 72 65 20 6c 69 6d 69 with severe limi
0910: 74 61 74 69 6f 6e 73 2e 20 49 74 20 69 73 0a 3b tations. It is.;
0920: 20 6e 6f 74 20 74 68 65 20 69 6e 74 65 6e 74 69 not the intenti
0930: 6f 6e 20 74 6f 20 73 75 70 70 6c 79 20 74 68 65 on to supply the
0940: 20 66 75 6e 63 74 69 6f 6e 61 6c 69 74 79 2e 0a functionality..
0950: 0a 3b 20 70 6f 6f 72 20 6d 61 6e 27 73 20 63 6f .; poor man's co
0960: 6d 70 6c 65 78 0a 28 64 65 66 69 6e 65 20 28 70 mplex.(define (p
0970: 6d 2d 63 6f 6d 70 6c 65 78 3f 20 7a 29 20 20 20 m-complex? z)
0980: 20 20 20 20 20 20 20 20 20 20 28 6f 72 20 28 72 (or (r
0990: 65 61 6c 3f 20 7a 29 20 28 61 6e 64 20 28 70 61 eal? z) (and (pa
09a0: 69 72 3f 20 7a 29 20 28 65 71 3f 20 28 63 61 72 ir? z) (eq? (car
09b0: 20 7a 29 20 27 63 6f 6d 70 6c 65 78 29 29 29 29 z) 'complex))))
09c0: 0a 28 64 65 66 69 6e 65 20 28 70 6d 2d 6e 75 6d .(define (pm-num
09d0: 62 65 72 3f 20 7a 29 20 20 20 20 20 20 20 20 20 ber? z)
09e0: 20 20 20 20 20 28 6f 72 20 28 72 65 61 6c 3f 20 (or (real?
09f0: 7a 29 20 28 70 6d 2d 63 6f 6d 70 6c 65 78 3f 20 z) (pm-complex?
0a00: 7a 29 29 29 0a 28 64 65 66 69 6e 65 20 28 70 6d z))).(define (pm
0a10: 2d 6d 61 6b 65 2d 72 65 63 74 61 6e 67 75 6c 61 -make-rectangula
0a20: 72 20 72 65 20 69 6d 29 20 28 6c 69 73 74 20 27 r re im) (list '
0a30: 63 6f 6d 70 6c 65 78 20 72 65 20 69 6d 29 29 0a complex re im)).
0a40: 28 64 65 66 69 6e 65 20 28 70 6d 2d 72 65 61 6c (define (pm-real
0a50: 2d 70 61 72 74 20 7a 29 20 20 20 20 20 20 20 20 -part z)
0a60: 20 20 20 20 28 69 66 20 28 70 6d 2d 63 6f 6d 70 (if (pm-comp
0a70: 6c 65 78 3f 20 7a 29 20 28 63 61 64 72 20 7a 29 lex? z) (cadr z)
0a80: 20 7a 29 29 0a 28 64 65 66 69 6e 65 20 28 70 6d z)).(define (pm
0a90: 2d 69 6d 61 67 2d 70 61 72 74 20 7a 29 20 20 20 -imag-part z)
0aa0: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 70 6d (if (pm
0ab0: 2d 63 6f 6d 70 6c 65 78 3f 20 7a 29 20 28 63 61 -complex? z) (ca
0ac0: 64 64 72 20 7a 29 20 7a 29 29 0a 0a 3b 20 61 70 ddr z) z))..; ap
0ad0: 70 6c 79 20 6f 6e 20 74 72 75 6e 63 61 74 65 64 ply on truncated
0ae0: 20 61 72 67 75 6d 65 6e 74 20 6c 69 73 74 0a 28 argument list.(
0af0: 64 65 66 69 6e 65 20 28 6d 61 6b 65 2d 61 70 70 define (make-app
0b00: 6c 79 20 6c 69 6d 69 74 29 0a 20 20 28 6c 65 74 ly limit). (let
0b10: 20 28 28 6f 72 69 67 69 6e 61 6c 2d 61 70 70 6c ((original-appl
0b20: 79 20 61 70 70 6c 79 29 29 0a 20 20 20 20 28 6c y apply)). (l
0b30: 61 6d 62 64 61 20 28 66 20 2e 20 78 73 29 0a 20 ambda (f . xs).
0b40: 20 20 20 20 20 28 6c 65 74 20 28 28 61 72 67 73 (let ((args
0b50: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 78 73 20 (let loop ((xs
0b60: 78 73 29 20 28 72 65 76 2d 61 72 67 73 20 27 28 xs) (rev-args '(
0b70: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
0b80: 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 (cond.
0b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ba0: 20 20 20 20 28 28 6e 75 6c 6c 3f 20 78 73 29 0a ((null? xs).
0bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0bc0: 20 20 20 20 20 20 20 28 72 65 76 65 72 73 65 20 (reverse
0bd0: 72 65 76 2d 61 72 67 73 29 29 0a 20 20 20 20 20 rev-args)).
0be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0bf0: 20 28 28 6e 75 6c 6c 3f 20 28 63 64 72 20 78 73 ((null? (cdr xs
0c00: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
0c10: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 65 6e (appen
0c20: 64 20 28 72 65 76 65 72 73 65 20 72 65 76 2d 61 d (reverse rev-a
0c30: 72 67 73 29 20 28 63 61 72 20 78 73 29 29 29 0a rgs) (car xs))).
0c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c50: 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 (else.
0c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c70: 20 20 20 28 6c 6f 6f 70 20 28 63 64 72 20 78 73 (loop (cdr xs
0c80: 29 20 28 63 6f 6e 73 20 28 63 61 72 20 78 73 29 ) (cons (car xs)
0c90: 20 72 65 76 2d 61 72 67 73 29 29 29 29 29 29 29 rev-args)))))))
0ca0: 0a 20 20 20 20 20 20 20 20 28 69 66 20 28 3c 3d . (if (<=
0cb0: 20 28 6c 65 6e 67 74 68 20 61 72 67 73 29 20 6c (length args) l
0cc0: 69 6d 69 74 29 0a 20 20 20 20 20 20 20 20 20 20 imit).
0cd0: 20 20 28 6f 72 69 67 69 6e 61 6c 2d 61 70 70 6c (original-appl
0ce0: 79 20 66 20 61 72 67 73 29 0a 20 20 20 20 20 20 y f args).
0cf0: 20 20 20 20 20 20 28 6f 72 69 67 69 6e 61 6c 2d (original-
0d00: 61 70 70 6c 79 0a 20 20 20 20 20 20 20 20 20 20 apply.
0d10: 20 20 20 66 0a 20 20 20 20 20 20 20 20 20 20 20 f.
0d20: 20 20 28 62 65 67 69 6e 20 28 64 69 73 70 6c 61 (begin (displa
0d30: 79 20 22 2a 2a 2a 20 77 61 72 6e 69 6e 67 3a 20 y "*** warning:
0d40: 74 72 75 6e 63 61 74 65 64 20 61 70 70 6c 79 22 truncated apply"
0d50: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
0d60: 20 20 20 20 20 20 28 6e 65 77 6c 69 6e 65 29 0a (newline).
0d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d80: 20 20 20 20 28 6c 65 74 20 74 72 75 6e 63 61 74 (let truncat
0d90: 65 20 28 28 6e 20 30 29 20 28 72 65 76 2d 61 72 e ((n 0) (rev-ar
0da0: 67 73 20 27 28 29 29 20 28 78 73 20 61 72 67 73 gs '()) (xs args
0db0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
0dc0: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 3d 20 (if (=
0dd0: 6e 20 6c 69 6d 69 74 29 0a 20 20 20 20 20 20 20 n limit).
0de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0df0: 20 20 20 28 72 65 76 65 72 73 65 20 72 65 76 2d (reverse rev-
0e00: 61 72 67 73 29 0a 20 20 20 20 20 20 20 20 20 20 args).
0e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e20: 28 74 72 75 6e 63 61 74 65 20 28 2b 20 6e 20 31 (truncate (+ n 1
0e30: 29 20 28 63 6f 6e 73 20 28 63 61 72 20 78 73 29 ) (cons (car xs)
0e40: 20 72 65 76 2d 61 72 67 73 29 20 28 63 64 72 20 rev-args) (cdr
0e50: 78 73 29 29 29 29 29 29 29 29 29 29 29 0a 0a 3b xs)))))))))))..;
0e60: 20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ===============
0e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
0eb0: 3b 20 52 75 6e 6e 69 6e 67 20 74 68 65 20 65 78 ; Running the ex
0ec0: 61 6d 70 6c 65 73 20 69 6e 20 49 6b 61 72 75 73 amples in Ikarus
0ed0: 20 0a 3b 20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .; ============
0ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 0a 3b 20 31 ==========.;.; 1
0f00: 2e 20 55 6e 63 6f 6d 6d 65 6e 74 20 74 68 65 20 . Uncomment the
0f10: 66 6f 6c 6c 6f 77 69 6e 67 20 6c 69 6e 65 73 3a following lines:
0f20: 0a 3b 0a 0a 28 64 65 66 69 6e 65 20 70 72 65 74 .;..(define pret
0f30: 74 79 2d 77 72 69 74 65 20 70 72 65 74 74 79 2d ty-write pretty-
0f40: 70 72 69 6e 74 29 0a 0a 3b 20 32 2e 20 52 75 6e print)..; 2. Run
0f50: 20 74 68 69 73 20 66 69 6c 65 2e 0a 0a 0a 0a 3b this file.....;
0f60: 20 52 75 6e 6e 69 6e 67 20 74 68 65 20 65 78 61 Running the exa
0f70: 6d 70 6c 65 73 20 69 6e 20 50 4c 54 20 28 44 72 mples in PLT (Dr
0f80: 53 63 68 65 6d 65 29 0a 3b 20 3d 3d 3d 3d 3d 3d Scheme).; ======
0f90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0fa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0fb0: 0a 3b 0a 3b 20 31 2e 20 55 6e 63 6f 6d 6d 65 6e .;.; 1. Uncommen
0fc0: 74 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 t the following
0fd0: 6c 69 6e 65 73 3a 0a 3b 0a 3b 70 6c 74 20 28 72 lines:.;.;plt (r
0fe0: 65 71 75 69 72 65 20 0a 3b 70 6c 74 20 20 20 20 equire .;plt
0ff0: 28 6c 69 62 20 22 31 36 2e 73 73 22 20 22 73 72 (lib "16.ss" "sr
1000: 66 69 22 29 20 3b 20 63 61 73 65 2d 6c 61 6d 62 fi") ; case-lamb
1010: 64 61 0a 3b 70 6c 74 20 20 20 20 28 6c 69 62 20 da.;plt (lib
1020: 22 32 33 2e 73 73 22 20 22 73 72 66 69 22 29 20 "23.ss" "srfi")
1030: 3b 20 65 72 72 6f 72 0a 3b 70 6c 74 20 20 20 20 ; error.;plt
1040: 28 6c 69 62 20 22 32 37 2e 73 73 22 20 22 73 72 (lib "27.ss" "sr
1050: 66 69 22 29 20 3b 20 72 61 6e 64 6f 6d 2d 69 6e fi") ; random-in
1060: 74 65 67 65 72 0a 3b 70 6c 74 20 20 20 20 28 6c teger.;plt (l
1070: 69 62 20 22 34 32 2e 73 73 22 20 22 73 72 66 69 ib "42.ss" "srfi
1080: 22 29 20 3b 20 65 61 67 65 72 20 63 6f 6d 70 72 ") ; eager compr
1090: 65 68 65 6e 73 69 6f 6e 73 20 6c 69 73 74 2d 65 ehensions list-e
10a0: 63 20 65 74 63 2e 0a 3b 70 6c 74 20 20 20 20 28 c etc..;plt (
10b0: 6c 69 62 20 22 70 72 65 74 74 79 2e 73 73 22 29 lib "pretty.ss")
10c0: 29 20 20 20 3b 20 70 72 65 74 74 79 2d 70 72 69 ) ; pretty-pri
10d0: 6e 74 0a 3b 70 6c 74 20 28 64 65 66 69 6e 65 20 nt.;plt (define
10e0: 70 72 65 74 74 79 2d 77 72 69 74 65 20 70 72 65 pretty-write pre
10f0: 74 74 79 2d 70 72 69 6e 74 29 0a 3b 70 6c 74 20 tty-print).;plt
1100: 28 6c 6f 61 64 20 22 63 6f 6d 70 61 72 65 2e 73 (load "compare.s
1110: 63 6d 22 29 0a 3b 0a 3b 20 32 2e 20 52 75 6e 20 cm").;.; 2. Run
1120: 74 68 69 73 20 66 69 6c 65 2e 0a 0a 3b 20 52 75 this file...; Ru
1130: 6e 6e 69 6e 67 20 74 68 65 20 65 78 61 6d 70 6c nning the exampl
1140: 65 73 20 69 6e 20 53 63 68 65 6d 65 2d 34 38 0a es in Scheme-48.
1150: 3b 20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ; ==============
1160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1170: 3d 3d 3d 0a 3b 0a 3b 20 31 2e 20 49 6e 76 6f 6b ===.;.; 1. Invok
1180: 65 20 73 63 68 65 6d 65 34 38 20 77 69 74 68 20 e scheme48 with
1190: 73 75 66 66 69 63 69 65 6e 74 20 68 65 61 70 20 sufficient heap
11a0: 73 69 7a 65 20 28 2d 68 20 3c 77 6f 72 64 73 3e size (-h <words>
11b0: 29 2e 0a 3b 20 32 2e 20 50 61 73 74 65 20 74 68 )..; 2. Paste th
11c0: 69 73 20 69 6e 74 6f 20 74 68 65 20 52 45 50 4c is into the REPL
11d0: 3a 0a 3b 20 20 20 20 20 20 2c 6f 70 65 6e 20 73 :.; ,open s
11e0: 72 66 69 2d 31 36 20 73 72 66 69 2d 32 33 20 73 rfi-16 srfi-23 s
11f0: 72 66 69 2d 32 37 20 73 72 66 69 2d 34 32 20 70 rfi-27 srfi-42 p
1200: 70 0a 3b 20 20 20 20 20 20 28 64 65 66 69 6e 65 p.; (define
1210: 20 70 72 65 74 74 79 2d 77 72 69 74 65 20 70 29 pretty-write p)
1220: 0a 3b 20 20 20 20 20 20 2c 6c 6f 61 64 20 63 6f .; ,load co
1230: 6d 70 61 72 65 2e 73 63 6d 20 65 78 61 6d 70 6c mpare.scm exampl
1240: 65 73 2e 73 63 6d 0a 0a 3b 20 52 75 6e 6e 69 6e es.scm..; Runnin
1250: 67 20 74 68 65 20 65 78 61 6d 70 6c 65 73 20 69 g the examples i
1260: 6e 20 74 68 65 20 43 68 69 63 6b 65 6e 20 53 63 n the Chicken Sc
1270: 68 65 6d 65 20 49 6e 74 65 72 70 72 65 74 65 72 heme Interpreter
1280: 0a 3b 20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .; =============
1290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 0a 3b 20 31 2e =========.;.; 1.
12c0: 20 46 65 74 63 68 20 61 6e 64 20 69 6e 73 74 61 Fetch and insta
12d0: 6c 6c 20 74 68 65 20 73 72 66 69 2d 34 32 20 65 ll the srfi-42 e
12e0: 67 67 20 66 72 6f 6d 20 74 68 65 20 43 68 69 63 gg from the Chic
12f0: 6b 65 6e 20 68 6f 6d 65 70 61 67 65 0a 3b 20 32 ken homepage.; 2
1300: 2e 20 55 6e 63 6f 6d 6d 65 6e 74 20 74 68 65 20 . Uncomment the
1310: 66 6f 6c 6c 6f 77 69 6e 67 20 6c 69 6e 65 73 3a following lines:
1320: 0a 3b 20 20 20 20 20 20 28 72 65 71 75 69 72 65 .; (require
1330: 2d 65 78 74 65 6e 73 69 6f 6e 20 73 72 66 69 2d -extension srfi-
1340: 32 33 29 0a 3b 20 20 20 20 20 20 28 64 65 66 69 23).; (defi
1350: 6e 65 20 72 61 6e 64 6f 6d 2d 69 6e 74 65 67 65 ne random-intege
1360: 72 20 72 61 6e 64 6f 6d 29 0a 3b 20 20 20 20 20 r random).;
1370: 20 28 72 65 71 75 69 72 65 2d 65 78 74 65 6e 73 (require-extens
1380: 69 6f 6e 20 73 72 66 69 2d 34 32 29 0a 3b 20 20 ion srfi-42).;
1390: 20 20 20 20 28 64 65 66 69 6e 65 20 70 72 65 74 (define pret
13a0: 74 79 2d 77 72 69 74 65 20 64 69 73 70 6c 61 79 ty-write display
13b0: 29 0a 3b 20 20 20 20 20 20 28 64 65 66 69 6e 65 ).; (define
13c0: 20 63 6f 6d 70 6c 65 78 3f 20 70 6d 2d 63 6f 6d complex? pm-com
13d0: 70 6c 65 78 3f 29 0a 3b 20 20 20 20 20 20 28 64 plex?).; (d
13e0: 65 66 69 6e 65 20 6e 75 6d 62 65 72 3f 20 70 6d efine number? pm
13f0: 2d 6e 75 6d 62 65 72 3f 29 0a 3b 20 20 20 20 20 -number?).;
1400: 20 28 64 65 66 69 6e 65 20 6d 61 6b 65 2d 72 65 (define make-re
1410: 63 74 61 6e 67 75 6c 61 72 20 70 6d 2d 6d 61 6b ctangular pm-mak
1420: 65 2d 72 65 63 74 61 6e 67 75 6c 61 72 29 0a 3b e-rectangular).;
1430: 20 20 20 20 20 20 28 64 65 66 69 6e 65 20 72 65 (define re
1440: 61 6c 2d 70 61 72 74 20 70 6d 2d 72 65 61 6c 2d al-part pm-real-
1450: 70 61 72 74 29 0a 3b 20 20 20 20 20 20 28 64 65 part).; (de
1460: 66 69 6e 65 20 69 6d 61 67 2d 70 61 72 74 20 70 fine imag-part p
1470: 6d 2d 69 6d 61 67 2d 70 61 72 74 29 0a 3b 20 20 m-imag-part).;
1480: 20 20 20 20 28 64 65 66 69 6e 65 20 61 70 70 6c (define appl
1490: 79 20 28 6d 61 6b 65 2d 61 70 70 6c 79 20 31 32 y (make-apply 12
14a0: 36 29 29 20 3b 20 47 72 72 72 2e 2e 2e 0a 3b 20 6)) ; Grrr....;
14b0: 20 20 20 20 20 28 6c 6f 61 64 20 22 63 6f 6d 70 (load "comp
14c0: 61 72 65 2e 73 63 6d 22 29 0a 3b 20 33 2e 20 49 are.scm").; 3. I
14d0: 6e 76 6f 6b 65 20 63 73 69 20 77 69 74 68 3a 0a nvoke csi with:.
14e0: 3b 20 20 20 20 20 20 63 73 69 20 2d 73 79 6e 74 ; csi -synt
14f0: 61 78 20 65 78 61 6d 70 6c 65 73 2e 73 63 6d 0a ax examples.scm.
1500: 3b 20 20 20 20 20 20 20 20 0a 3b 20 4e 6f 74 65 ; .; Note
1510: 3a 20 43 68 69 63 6b 65 6e 20 64 6f 65 73 6e 27 : Chicken doesn'
1520: 74 20 68 61 76 65 20 63 6f 6d 70 6c 65 78 20 6e t have complex n
1530: 75 6d 62 65 72 73 20 61 6e 64 20 68 61 73 20 61 umbers and has a
1540: 0a 3b 20 20 20 20 20 20 20 73 65 76 65 72 65 20 .; severe
1550: 6c 69 6d 69 74 20 6f 6e 20 74 68 65 20 6e 75 6d limit on the num
1560: 62 65 72 20 6f 66 20 61 72 67 75 6d 65 6e 74 73 ber of arguments
1570: 20 66 6f 72 20 61 70 70 6c 79 2e 0a 0a 3b 20 3d for apply...; =
1580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 20 ============..;
15d0: 54 65 73 74 20 65 6e 67 69 6e 65 0a 3b 20 3d 3d Test engine.; ==
15e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 0a 3b 20 57 65 =========.;.; We
15f0: 20 75 73 65 20 61 6e 20 65 78 74 65 6e 64 65 64 use an extended
1600: 20 76 65 72 73 69 6f 6e 20 6f 66 20 74 68 65 20 version of the
1610: 74 68 65 20 63 68 65 63 6b 65 72 20 6f 66 20 53 the checker of S
1620: 52 46 49 2d 34 32 20 28 77 69 74 68 0a 3b 20 46 RFI-42 (with.; F
1630: 65 6c 69 78 27 20 72 65 64 75 63 74 69 6f 6e 20 elix' reduction
1640: 6f 6e 20 63 6f 64 65 73 69 7a 65 29 20 66 6f 72 on codesize) for
1650: 20 72 75 6e 6e 69 6e 67 20 61 20 62 61 74 63 68 running a batch
1660: 20 6f 66 20 74 65 73 74 73 20 66 6f 72 0a 3b 20 of tests for.;
1670: 74 68 65 20 76 61 72 69 6f 75 73 20 70 72 6f 63 the various proc
1680: 65 64 75 72 65 73 20 6f 66 20 27 63 6f 6d 70 61 edures of 'compa
1690: 72 65 2e 73 63 6d 27 2e 20 4d 6f 72 65 6f 76 65 re.scm'. Moreove
16a0: 72 2c 20 77 65 20 75 73 65 20 74 68 65 0a 3b 20 r, we use the.;
16b0: 63 6f 6d 70 72 65 68 65 6e 73 69 6f 6e 73 20 6f comprehensions o
16c0: 66 20 53 52 46 49 2d 34 32 20 74 6f 20 67 65 6e f SRFI-42 to gen
16d0: 65 72 61 74 65 20 65 78 61 6d 70 6c 65 73 20 73 erate examples s
16e0: 79 73 74 65 6d 61 74 69 63 61 6c 6c 79 2e 0a 0a ystematically...
16f0: 28 64 65 66 69 6e 65 20 6d 79 2d 65 71 75 61 6c (define my-equal
1700: 3f 20 20 20 20 20 20 20 65 71 75 61 6c 3f 29 0a ? equal?).
1710: 28 64 65 66 69 6e 65 20 6d 79 2d 70 72 65 74 74 (define my-prett
1720: 79 2d 77 72 69 74 65 20 70 72 65 74 74 79 2d 77 y-write pretty-w
1730: 72 69 74 65 29 0a 0a 28 64 65 66 69 6e 65 20 6d rite)..(define m
1740: 79 2d 63 68 65 63 6b 2d 63 6f 72 72 65 63 74 20 y-check-correct
1750: 30 29 0a 28 64 65 66 69 6e 65 20 6d 79 2d 63 68 0).(define my-ch
1760: 65 63 6b 2d 77 72 6f 6e 67 20 20 20 30 29 0a 0a eck-wrong 0)..
1770: 28 64 65 66 69 6e 65 20 28 6d 79 2d 63 68 65 63 (define (my-chec
1780: 6b 2d 72 65 73 65 74 29 0a 20 20 28 73 65 74 21 k-reset). (set!
1790: 20 6d 79 2d 63 68 65 63 6b 2d 63 6f 72 72 65 63 my-check-correc
17a0: 74 20 30 29 0a 20 20 28 73 65 74 21 20 6d 79 2d t 0). (set! my-
17b0: 63 68 65 63 6b 2d 77 72 6f 6e 67 20 20 20 30 29 check-wrong 0)
17c0: 29 0a 0a 3b 20 28 6d 79 2d 63 68 65 63 6b 20 65 )..; (my-check e
17d0: 78 70 72 20 3d 3e 20 64 65 73 69 72 65 64 2d 72 xpr => desired-r
17e0: 65 73 75 6c 74 29 0a 3b 20 20 20 65 76 61 6c 75 esult).; evalu
17f0: 61 74 65 73 20 65 78 70 72 20 61 6e 64 20 63 6f ates expr and co
1800: 6d 70 61 72 65 73 20 74 68 65 20 76 61 6c 75 65 mpares the value
1810: 20 77 69 74 68 20 64 65 73 69 72 65 64 2d 72 65 with desired-re
1820: 73 75 6c 74 2e 0a 0a 28 64 65 66 69 6e 65 2d 73 sult...(define-s
1830: 79 6e 74 61 78 20 6d 79 2d 63 68 65 63 6b 0a 20 yntax my-check.
1840: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 (syntax-rules (
1850: 3d 3e 29 0a 20 20 20 20 28 28 6d 79 2d 63 68 65 =>). ((my-che
1860: 63 6b 20 65 78 70 72 20 3d 3e 20 64 65 73 69 72 ck expr => desir
1870: 65 64 2d 72 65 73 75 6c 74 29 0a 20 20 20 20 20 ed-result).
1880: 28 6d 79 2d 63 68 65 63 6b 2d 70 72 6f 63 20 27 (my-check-proc '
1890: 65 78 70 72 20 28 6c 61 6d 62 64 61 20 28 29 20 expr (lambda ()
18a0: 65 78 70 72 29 20 64 65 73 69 72 65 64 2d 72 65 expr) desired-re
18b0: 73 75 6c 74 29 29 29 29 0a 0a 28 64 65 66 69 6e sult))))..(defin
18c0: 65 20 28 6d 79 2d 63 68 65 63 6b 2d 70 72 6f 63 e (my-check-proc
18d0: 20 65 78 70 72 20 74 68 75 6e 6b 20 64 65 73 69 expr thunk desi
18e0: 72 65 64 2d 72 65 73 75 6c 74 29 0a 20 20 28 6e red-result). (n
18f0: 65 77 6c 69 6e 65 29 0a 20 20 28 6d 79 2d 70 72 ewline). (my-pr
1900: 65 74 74 79 2d 77 72 69 74 65 20 65 78 70 72 29 etty-write expr)
1910: 0a 20 20 28 64 69 73 70 6c 61 79 20 22 20 20 3d . (display " =
1920: 3e 20 22 29 0a 20 20 28 6c 65 74 20 28 28 61 63 > "). (let ((ac
1930: 74 75 61 6c 2d 72 65 73 75 6c 74 20 28 74 68 75 tual-result (thu
1940: 6e 6b 29 29 29 0a 20 20 20 20 28 77 72 69 74 65 nk))). (write
1950: 20 61 63 74 75 61 6c 2d 72 65 73 75 6c 74 29 0a actual-result).
1960: 20 20 20 20 28 69 66 20 28 6d 79 2d 65 71 75 61 (if (my-equa
1970: 6c 3f 20 61 63 74 75 61 6c 2d 72 65 73 75 6c 74 l? actual-result
1980: 20 64 65 73 69 72 65 64 2d 72 65 73 75 6c 74 29 desired-result)
1990: 0a 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a . (begin.
19a0: 20 20 20 20 20 20 20 20 20 20 28 64 69 73 70 6c (displ
19b0: 61 79 20 22 20 3b 20 63 6f 72 72 65 63 74 22 29 ay " ; correct")
19c0: 0a 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 . (set!
19d0: 20 6d 79 2d 63 68 65 63 6b 2d 63 6f 72 72 65 63 my-check-correc
19e0: 74 20 28 2b 20 6d 79 2d 63 68 65 63 6b 2d 63 6f t (+ my-check-co
19f0: 72 72 65 63 74 20 31 29 29 20 29 0a 20 20 20 20 rrect 1)) ).
1a00: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
1a10: 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 22 20 (display "
1a20: 3b 20 2a 2a 2a 20 77 72 6f 6e 67 20 2a 2a 2a 2c ; *** wrong ***,
1a30: 20 64 65 73 69 72 65 64 20 72 65 73 75 6c 74 3a desired result:
1a40: 22 29 0a 20 20 20 20 20 20 20 20 20 20 28 6e 65 "). (ne
1a50: 77 6c 69 6e 65 29 0a 20 20 20 20 20 20 20 20 20 wline).
1a60: 20 28 64 69 73 70 6c 61 79 20 22 20 20 3d 3e 20 (display " =>
1a70: 22 29 0a 20 20 20 20 20 20 20 20 20 20 28 77 72 "). (wr
1a80: 69 74 65 20 64 65 73 69 72 65 64 2d 72 65 73 75 ite desired-resu
1a90: 6c 74 29 0a 20 20 20 20 20 20 20 20 20 20 28 73 lt). (s
1aa0: 65 74 21 20 6d 79 2d 63 68 65 63 6b 2d 77 72 6f et! my-check-wro
1ab0: 6e 67 20 28 2b 20 6d 79 2d 63 68 65 63 6b 2d 77 ng (+ my-check-w
1ac0: 72 6f 6e 67 20 31 29 29 29 29 0a 20 20 20 20 28 rong 1)))). (
1ad0: 6e 65 77 6c 69 6e 65 29 29 29 0a 0a 3b 20 28 6d newline)))..; (m
1ae0: 79 2d 63 68 65 63 6b 2d 65 63 20 3c 71 75 61 6c y-check-ec <qual
1af0: 69 66 69 65 72 3e 2a 20 3c 6f 6b 3f 3e 20 3c 65 ifier>* <ok?> <e
1b00: 78 70 72 3e 29 0a 3b 20 20 20 20 72 75 6e 73 20 xpr>).; runs
1b10: 28 65 76 65 72 79 3f 2d 65 63 20 3c 71 75 61 6c (every?-ec <qual
1b20: 69 66 69 65 72 3e 2a 20 3c 6f 6b 3f 3e 29 2c 20 ifier>* <ok?>),
1b30: 63 6f 75 6e 74 69 6e 67 20 74 68 65 20 74 69 6d counting the tim
1b40: 65 73 20 3c 6f 6b 3f 3e 0a 3b 20 20 20 20 69 73 es <ok?>.; is
1b50: 20 65 76 61 6c 75 61 74 65 64 20 61 73 20 61 20 evaluated as a
1b60: 63 6f 72 72 65 63 74 20 65 78 61 6d 70 6c 65 2c correct example,
1b70: 20 61 6e 64 20 73 74 6f 70 70 69 6e 67 20 61 74 and stopping at
1b80: 20 74 68 65 20 66 69 72 73 74 0a 3b 20 20 20 20 the first.;
1b90: 63 6f 75 6e 74 65 72 20 65 78 61 6d 70 6c 65 20 counter example
1ba0: 66 6f 72 20 77 68 69 63 68 20 3c 65 78 70 72 3e for which <expr>
1bb0: 20 70 72 6f 76 69 64 65 73 20 74 68 65 20 61 72 provides the ar
1bc0: 67 75 6d 65 6e 74 2e 0a 0a 28 64 65 66 69 6e 65 gument...(define
1bd0: 2d 73 79 6e 74 61 78 20 6d 79 2d 63 68 65 63 6b -syntax my-check
1be0: 2d 65 63 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 -ec. (syntax-ru
1bf0: 6c 65 73 20 28 6e 65 73 74 65 64 29 0a 20 20 20 les (nested).
1c00: 20 28 28 6d 79 2d 63 68 65 63 6b 2d 65 63 20 28 ((my-check-ec (
1c10: 6e 65 73 74 65 64 20 71 31 20 2e 2e 2e 29 20 71 nested q1 ...) q
1c20: 20 65 74 63 31 20 65 74 63 32 20 65 74 63 20 2e etc1 etc2 etc .
1c30: 2e 2e 29 0a 20 20 20 20 20 28 6d 79 2d 63 68 65 ..). (my-che
1c40: 63 6b 2d 65 63 20 28 6e 65 73 74 65 64 20 71 31 ck-ec (nested q1
1c50: 20 2e 2e 2e 20 71 29 20 65 74 63 31 20 65 74 63 ... q) etc1 etc
1c60: 32 20 65 74 63 20 2e 2e 2e 29 29 0a 20 20 20 20 2 etc ...)).
1c70: 28 28 6d 79 2d 63 68 65 63 6b 2d 65 63 20 71 31 ((my-check-ec q1
1c80: 20 71 32 20 20 20 20 20 20 20 20 20 20 20 20 20 q2
1c90: 65 74 63 31 20 65 74 63 32 20 65 74 63 20 2e 2e etc1 etc2 etc ..
1ca0: 2e 29 0a 20 20 20 20 20 28 6d 79 2d 63 68 65 63 .). (my-chec
1cb0: 6b 2d 65 63 20 28 6e 65 73 74 65 64 20 71 31 20 k-ec (nested q1
1cc0: 71 32 29 20 20 20 20 65 74 63 31 20 65 74 63 32 q2) etc1 etc2
1cd0: 20 65 74 63 20 2e 2e 2e 29 29 0a 20 20 20 20 28 etc ...)). (
1ce0: 28 6d 79 2d 63 68 65 63 6b 2d 65 63 20 6f 6b 3f (my-check-ec ok?
1cf0: 20 65 78 70 72 29 0a 20 20 20 20 20 28 6d 79 2d expr). (my-
1d00: 63 68 65 63 6b 2d 65 63 20 28 6e 65 73 74 65 64 check-ec (nested
1d10: 29 20 6f 6b 3f 20 65 78 70 72 29 29 0a 20 20 20 ) ok? expr)).
1d20: 20 28 28 6d 79 2d 63 68 65 63 6b 2d 65 63 20 28 ((my-check-ec (
1d30: 6e 65 73 74 65 64 20 71 20 2e 2e 2e 29 20 6f 6b nested q ...) ok
1d40: 3f 20 65 78 70 72 29 0a 20 20 20 20 20 28 6d 79 ? expr). (my
1d50: 2d 63 68 65 63 6b 2d 65 63 2d 70 72 6f 63 0a 20 -check-ec-proc.
1d60: 20 20 20 20 20 27 28 65 76 65 72 79 3f 2d 65 63 '(every?-ec
1d70: 20 71 20 2e 2e 2e 20 6f 6b 3f 29 0a 20 20 20 20 q ... ok?).
1d80: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 (lambda ().
1d90: 20 20 20 20 20 28 66 69 72 73 74 2d 65 63 20 0a (first-ec .
1da0: 20 20 20 20 20 20 20 20 20 27 6f 6b 0a 20 20 20 'ok.
1db0: 20 20 20 20 20 20 28 6e 65 73 74 65 64 20 71 20 (nested q
1dc0: 2e 2e 2e 29 0a 20 20 20 20 20 20 20 20 20 28 3a ...). (:
1dd0: 6c 65 74 20 6f 6b 20 6f 6b 3f 29 0a 20 20 20 20 let ok ok?).
1de0: 20 20 20 20 20 28 62 65 67 69 6e 20 0a 20 20 20 (begin .
1df0: 20 20 20 20 20 20 20 20 28 69 66 20 6f 6b 0a 20 (if ok.
1e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
1e10: 65 74 21 20 6d 79 2d 63 68 65 63 6b 2d 63 6f 72 et! my-check-cor
1e20: 72 65 63 74 20 28 2b 20 6d 79 2d 63 68 65 63 6b rect (+ my-check
1e30: 2d 63 6f 72 72 65 63 74 20 31 29 29 0a 20 20 20 -correct 1)).
1e40: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 (set
1e50: 21 20 6d 79 2d 63 68 65 63 6b 2d 77 72 6f 6e 67 ! my-check-wrong
1e60: 20 20 20 28 2b 20 6d 79 2d 63 68 65 63 6b 2d 77 (+ my-check-w
1e70: 72 6f 6e 67 20 20 20 31 29 29 29 29 0a 20 20 20 rong 1)))).
1e80: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 6f (if (not o
1e90: 6b 29 29 0a 20 20 20 20 20 20 20 20 20 28 6c 69 k)). (li
1ea0: 73 74 20 65 78 70 72 29 29 29 0a 20 20 20 20 20 st expr))).
1eb0: 20 27 65 78 70 72 29 29 0a 20 20 20 20 28 28 6d 'expr)). ((m
1ec0: 79 2d 63 68 65 63 6b 2d 65 63 20 71 20 6f 6b 3f y-check-ec q ok?
1ed0: 20 65 78 70 72 29 0a 20 20 20 20 20 28 6d 79 2d expr). (my-
1ee0: 63 68 65 63 6b 2d 65 63 20 28 6e 65 73 74 65 64 check-ec (nested
1ef0: 20 71 29 20 6f 6b 3f 20 65 78 70 72 29 29 29 29 q) ok? expr))))
1f00: 0a 0a 28 64 65 66 69 6e 65 20 28 6d 79 2d 63 68 ..(define (my-ch
1f10: 65 63 6b 2d 65 63 2d 70 72 6f 63 20 65 78 70 72 eck-ec-proc expr
1f20: 20 74 68 75 6e 6b 20 61 72 67 2d 63 6f 75 6e 74 thunk arg-count
1f30: 65 72 2d 65 78 61 6d 70 6c 65 29 0a 20 20 28 6c er-example). (l
1f40: 65 74 20 28 28 6d 79 2d 63 68 65 63 6b 2d 63 6f et ((my-check-co
1f50: 72 72 65 63 74 2d 73 61 76 65 20 6d 79 2d 63 68 rrect-save my-ch
1f60: 65 63 6b 2d 63 6f 72 72 65 63 74 29 29 0a 20 20 eck-correct)).
1f70: 20 20 28 6e 65 77 6c 69 6e 65 29 0a 20 20 20 20 (newline).
1f80: 28 6d 79 2d 70 72 65 74 74 79 2d 77 72 69 74 65 (my-pretty-write
1f90: 20 65 78 70 72 29 0a 20 20 20 20 28 64 69 73 70 expr). (disp
1fa0: 6c 61 79 20 22 20 20 3d 3e 20 22 29 0a 20 20 20 lay " => ").
1fb0: 20 28 6c 65 74 20 28 28 72 65 73 75 6c 74 20 28 (let ((result (
1fc0: 74 68 75 6e 6b 29 29 29 0a 20 20 20 20 20 20 28 thunk))). (
1fd0: 69 66 20 28 65 71 76 3f 20 72 65 73 75 6c 74 20 if (eqv? result
1fe0: 27 6f 6b 29 0a 20 20 20 20 20 20 20 20 20 20 28 'ok). (
1ff0: 62 65 67 69 6e 20 0a 20 20 20 20 20 20 20 20 20 begin .
2000: 20 20 20 28 64 69 73 70 6c 61 79 20 22 23 74 20 (display "#t
2010: 3b 20 63 6f 72 72 65 63 74 20 28 22 29 0a 20 20 ; correct (").
2020: 20 20 20 20 20 20 20 20 20 20 28 77 72 69 74 65 (write
2030: 20 28 2d 20 6d 79 2d 63 68 65 63 6b 2d 63 6f 72 (- my-check-cor
2040: 72 65 63 74 20 6d 79 2d 63 68 65 63 6b 2d 63 6f rect my-check-co
2050: 72 72 65 63 74 2d 73 61 76 65 29 29 0a 20 20 20 rrect-save)).
2060: 20 20 20 20 20 20 20 20 20 28 64 69 73 70 6c 61 (displa
2070: 79 20 22 20 65 78 61 6d 70 6c 65 73 29 22 29 0a y " examples)").
2080: 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 77 (new
2090: 6c 69 6e 65 29 29 0a 20 20 20 20 20 20 20 20 20 line)).
20a0: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
20b0: 20 20 20 20 28 64 69 73 70 6c 61 79 20 22 23 66 (display "#f
20c0: 20 3b 20 2a 2a 2a 20 77 72 6f 6e 67 20 2a 2a 2a ; *** wrong ***
20d0: 20 28 61 66 74 65 72 20 22 29 0a 20 20 20 20 20 (after ").
20e0: 20 20 20 20 20 20 20 28 77 72 69 74 65 20 28 2d (write (-
20f0: 20 6d 79 2d 63 68 65 63 6b 2d 63 6f 72 72 65 63 my-check-correc
2100: 74 20 6d 79 2d 63 68 65 63 6b 2d 63 6f 72 72 65 t my-check-corre
2110: 63 74 2d 73 61 76 65 29 29 20 20 20 20 20 20 20 ct-save))
2120: 20 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 .
2130: 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 22 20 (display "
2140: 63 6f 72 72 65 63 74 20 65 78 61 6d 70 6c 65 73 correct examples
2150: 29 2e 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 ).").
2160: 20 28 6e 65 77 6c 69 6e 65 29 0a 20 20 20 20 20 (newline).
2170: 20 20 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 (display
2180: 22 20 20 20 20 20 20 20 20 3b 20 41 72 67 75 6d " ; Argum
2190: 65 6e 74 20 6f 66 20 74 68 65 20 66 69 72 73 74 ent of the first
21a0: 20 63 6f 75 6e 74 65 72 20 65 78 61 6d 70 6c 65 counter example
21b0: 3a 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 :").
21c0: 28 6e 65 77 6c 69 6e 65 29 0a 20 20 20 20 20 20 (newline).
21d0: 20 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 22 (display "
21e0: 20 20 20 20 20 20 20 20 3b 20 20 20 22 29 0a 20 ; ").
21f0: 20 20 20 20 20 20 20 20 20 20 20 28 77 72 69 74 (writ
2200: 65 20 61 72 67 2d 63 6f 75 6e 74 65 72 2d 65 78 e arg-counter-ex
2210: 61 6d 70 6c 65 29 0a 20 20 20 20 20 20 20 20 20 ample).
2220: 20 20 20 28 64 69 73 70 6c 61 79 20 22 20 3d 20 (display " =
2230: 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 "). (
2240: 77 72 69 74 65 20 28 63 61 72 20 72 65 73 75 6c write (car resul
2250: 74 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e t)))))))..(defin
2260: 65 20 28 6d 79 2d 63 68 65 63 6b 2d 73 75 6d 6d e (my-check-summ
2270: 61 72 79 29 0a 20 20 28 62 65 67 69 6e 0a 20 20 ary). (begin.
2280: 20 20 28 6e 65 77 6c 69 6e 65 29 0a 20 20 20 20 (newline).
2290: 28 6e 65 77 6c 69 6e 65 29 0a 20 20 20 20 28 64 (newline). (d
22a0: 69 73 70 6c 61 79 20 22 2a 2a 2a 20 63 6f 72 72 isplay "*** corr
22b0: 65 63 74 20 65 78 61 6d 70 6c 65 73 3a 20 22 29 ect examples: ")
22c0: 0a 20 20 20 20 28 64 69 73 70 6c 61 79 20 6d 79 . (display my
22d0: 2d 63 68 65 63 6b 2d 63 6f 72 72 65 63 74 29 0a -check-correct).
22e0: 20 20 20 20 28 6e 65 77 6c 69 6e 65 29 0a 20 20 (newline).
22f0: 20 20 28 64 69 73 70 6c 61 79 20 22 2a 2a 2a 20 (display "***
2300: 77 72 6f 6e 67 20 65 78 61 6d 70 6c 65 73 3a 20 wrong examples:
2310: 20 20 22 29 0a 20 20 20 20 28 64 69 73 70 6c 61 "). (displa
2320: 79 20 6d 79 2d 63 68 65 63 6b 2d 77 72 6f 6e 67 y my-check-wrong
2330: 29 0a 20 20 20 20 28 6e 65 77 6c 69 6e 65 29 0a ). (newline).
2340: 20 20 20 20 28 6e 65 77 6c 69 6e 65 29 29 29 0a (newline))).
2350: 0a 3b 20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .; =============
2360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
23a0: 0a 0a 3b 20 41 62 73 74 72 61 63 74 69 6f 6e 73 ..; Abstractions
23b0: 20 65 74 63 2e 0a 3b 20 3d 3d 3d 3d 3d 3d 3d 3d etc..; ========
23c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi
23d0: 6e 65 20 63 69 20 69 6e 74 65 67 65 72 2d 63 6f ne ci integer-co
23e0: 6d 70 61 72 65 29 20 3b 20 76 65 72 79 20 66 72 mpare) ; very fr
23f0: 65 71 75 65 6e 74 6c 79 20 75 73 65 64 0a 0a 3b equently used..;
2400: 20 28 72 65 73 75 6c 74 2d 6f 6b 3f 20 61 63 74 (result-ok? act
2410: 75 61 6c 20 64 65 73 69 72 65 64 29 0a 3b 20 20 ual desired).;
2420: 20 74 65 73 74 73 20 69 66 20 61 63 74 75 61 6c tests if actual
2430: 20 61 6e 64 20 64 65 73 69 72 65 64 20 73 70 65 and desired spe
2440: 63 69 66 79 20 74 68 65 20 73 61 6d 65 20 6f 72 cify the same or
2450: 64 65 72 69 6e 67 2e 0a 0a 28 64 65 66 69 6e 65 dering...(define
2460: 20 28 72 65 73 75 6c 74 2d 6f 6b 3f 20 61 63 74 (result-ok? act
2470: 75 61 6c 20 64 65 73 69 72 65 64 29 0a 20 20 28 ual desired). (
2480: 65 71 76 3f 20 61 63 74 75 61 6c 20 64 65 73 69 eqv? actual desi
2490: 72 65 64 29 29 0a 0a 3b 20 28 6d 79 2d 63 68 65 red))..; (my-che
24a0: 63 6b 2d 63 6f 6d 70 61 72 65 20 63 6f 6d 70 61 ck-compare compa
24b0: 72 65 20 69 6e 63 72 65 61 73 69 6e 67 2d 65 6c re increasing-el
24c0: 65 6d 65 6e 74 73 29 0a 3b 20 20 20 20 65 76 61 ements).; eva
24d0: 6c 75 61 74 65 73 20 28 63 6f 6d 70 61 72 65 20 luates (compare
24e0: 78 20 79 29 20 66 6f 72 20 78 2c 20 79 20 69 6e x y) for x, y in
24f0: 20 69 6e 63 72 65 61 73 69 6e 67 2d 65 6c 65 6d increasing-elem
2500: 65 6e 74 73 0a 3b 20 20 20 20 61 6e 64 20 63 68 ents.; and ch
2510: 65 63 6b 73 20 74 68 65 20 72 65 73 75 6c 74 20 ecks the result
2520: 61 67 61 69 6e 73 74 20 2d 31 2c 20 30 2c 20 6f against -1, 0, o
2530: 72 20 31 20 64 65 70 65 6e 64 69 6e 67 20 6f 6e r 1 depending on
2540: 0a 3b 20 20 20 20 74 68 65 20 70 6f 73 69 74 69 .; the positi
2550: 6f 6e 20 6f 66 20 78 20 61 6e 64 20 79 20 69 6e on of x and y in
2560: 20 74 68 65 20 6c 69 73 74 20 69 6e 63 72 65 61 the list increa
2570: 73 69 6e 67 2d 65 6c 65 6d 65 6e 74 73 2e 0a 0a sing-elements...
2580: 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d (define-syntax m
2590: 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 72 65 0a y-check-compare.
25a0: 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 (syntax-rules
25b0: 28 29 0a 20 20 20 20 28 28 6d 79 2d 63 68 65 63 (). ((my-chec
25c0: 6b 2d 63 6f 6d 70 61 72 65 20 63 6f 6d 70 61 72 k-compare compar
25d0: 65 20 69 6e 63 72 65 61 73 69 6e 67 2d 65 6c 65 e increasing-ele
25e0: 6d 65 6e 74 73 29 0a 20 20 20 20 20 28 6d 79 2d ments). (my-
25f0: 63 68 65 63 6b 2d 65 63 0a 20 20 20 20 20 20 28 check-ec. (
2600: 3a 6c 69 73 74 20 78 20 28 69 6e 64 65 78 20 69 :list x (index i
2610: 78 29 20 69 6e 63 72 65 61 73 69 6e 67 2d 65 6c x) increasing-el
2620: 65 6d 65 6e 74 73 29 0a 20 20 20 20 20 20 28 3a ements). (:
2630: 6c 69 73 74 20 79 20 28 69 6e 64 65 78 20 69 79 list y (index iy
2640: 29 20 69 6e 63 72 65 61 73 69 6e 67 2d 65 6c 65 ) increasing-ele
2650: 6d 65 6e 74 73 29 0a 20 20 20 20 20 20 28 72 65 ments). (re
2660: 73 75 6c 74 2d 6f 6b 3f 20 28 63 6f 6d 70 61 72 sult-ok? (compar
2670: 65 20 78 20 79 29 20 28 63 69 20 69 78 20 69 79 e x y) (ci ix iy
2680: 29 29 0a 20 20 20 20 20 20 28 6c 69 73 74 20 78 )). (list x
2690: 20 79 29 29 29 29 29 0a 0a 3b 20 73 6f 72 74 65 y)))))..; sorte
26a0: 64 20 6c 69 73 74 73 0a 0a 28 64 65 66 69 6e 65 d lists..(define
26b0: 20 6d 79 2d 62 6f 6f 6c 65 61 6e 73 20 20 20 27 my-booleans '
26c0: 28 23 66 20 23 74 29 29 0a 28 64 65 66 69 6e 65 (#f #t)).(define
26d0: 20 6d 79 2d 63 68 61 72 73 20 20 20 20 20 20 27 my-chars '
26e0: 28 23 5c 61 20 23 5c 62 20 23 5c 63 29 29 0a 28 (#\a #\b #\c)).(
26f0: 64 65 66 69 6e 65 20 6d 79 2d 63 68 61 72 73 2d define my-chars-
2700: 63 69 20 20 20 27 28 23 5c 61 20 23 5c 42 20 23 ci '(#\a #\B #
2710: 5c 63 20 23 5c 44 29 29 0a 28 64 65 66 69 6e 65 \c #\D)).(define
2720: 20 6d 79 2d 73 74 72 69 6e 67 73 20 20 20 20 27 my-strings '
2730: 28 22 22 20 22 61 22 20 22 61 61 22 20 22 61 62 ("" "a" "aa" "ab
2740: 22 20 22 62 22 20 22 62 61 22 20 22 62 62 22 29 " "b" "ba" "bb")
2750: 29 0a 28 64 65 66 69 6e 65 20 6d 79 2d 73 74 72 ).(define my-str
2760: 69 6e 67 73 2d 63 69 20 27 28 22 22 20 22 61 22 ings-ci '("" "a"
2770: 20 22 61 41 22 20 22 41 62 22 20 22 42 22 20 22 "aA" "Ab" "B" "
2780: 62 41 22 20 22 42 42 22 29 29 0a 28 64 65 66 69 bA" "BB")).(defi
2790: 6e 65 20 6d 79 2d 73 79 6d 62 6f 6c 73 20 20 20 ne my-symbols
27a0: 20 27 28 61 20 61 61 20 61 62 20 62 20 62 61 20 '(a aa ab b ba
27b0: 62 62 29 29 0a 0a 28 64 65 66 69 6e 65 20 6d 79 bb))..(define my
27c0: 2d 72 65 61 6c 73 0a 20 20 28 61 70 70 65 6e 64 -reals. (append
27d0: 2d 65 63 20 28 3a 72 61 6e 67 65 20 78 6e 20 2d -ec (:range xn -
27e0: 36 20 37 29 20 0a 20 20 20 20 20 20 20 20 20 20 6 7) .
27f0: 20 20 20 28 3a 6c 65 74 20 78 20 28 2f 20 78 6e (:let x (/ xn
2800: 20 33 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 3)).
2810: 20 20 28 6c 69 73 74 20 78 20 28 2b 20 78 20 28 (list x (+ x (
2820: 65 78 61 63 74 2d 3e 69 6e 65 78 61 63 74 20 28 exact->inexact (
2830: 2f 20 31 20 31 30 30 29 29 29 29 29 29 0a 0a 28 / 1 100))))))..(
2840: 64 65 66 69 6e 65 20 6d 79 2d 72 61 74 69 6f 6e define my-ration
2850: 61 6c 73 0a 20 20 28 6c 69 73 74 2d 65 63 20 28 als. (list-ec (
2860: 3a 6c 69 73 74 20 78 20 6d 79 2d 72 65 61 6c 73 :list x my-reals
2870: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 61 6e ). (an
2880: 64 20 28 65 78 61 63 74 3f 20 78 29 20 28 72 61 d (exact? x) (ra
2890: 74 69 6f 6e 61 6c 3f 20 78 29 29 0a 20 20 20 20 tional? x)).
28a0: 20 20 20 20 20 20 20 78 29 29 0a 0a 28 64 65 66 x))..(def
28b0: 69 6e 65 20 6d 79 2d 69 6e 74 65 67 65 72 73 0a ine my-integers.
28c0: 20 20 28 6c 69 73 74 2d 65 63 20 28 3a 6c 69 73 (list-ec (:lis
28d0: 74 20 78 20 6d 79 2d 72 65 61 6c 73 29 0a 20 20 t x my-reals).
28e0: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 61 6e (if (an
28f0: 64 20 28 65 78 61 63 74 3f 20 78 29 20 28 69 6e d (exact? x) (in
2900: 74 65 67 65 72 3f 20 78 29 29 29 0a 20 20 20 20 teger? x))).
2910: 20 20 20 20 20 20 20 78 29 29 0a 0a 23 3b 28 64 x))..#;(d
2920: 65 66 69 6e 65 20 6d 79 2d 63 6f 6d 70 6c 65 78 efine my-complex
2930: 65 73 0a 20 20 28 6c 69 73 74 2d 65 63 20 28 3a es. (list-ec (:
2940: 6c 69 73 74 20 72 65 2d 78 20 6d 79 2d 72 65 61 list re-x my-rea
2950: 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 ls). (
2960: 69 66 20 28 69 6e 65 78 61 63 74 3f 20 72 65 2d if (inexact? re-
2970: 78 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 x)). (
2980: 3a 6c 69 73 74 20 69 6d 2d 78 20 6d 79 2d 72 65 :list im-x my-re
2990: 61 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 als).
29a0: 28 69 66 20 28 69 6e 65 78 61 63 74 3f 20 69 6d (if (inexact? im
29b0: 2d 78 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 -x)).
29c0: 28 6d 61 6b 65 2d 72 65 63 74 61 6e 67 75 6c 61 (make-rectangula
29d0: 72 20 72 65 2d 78 20 69 6d 2d 78 29 29 29 0a 0a r re-x im-x)))..
29e0: 28 64 65 66 69 6e 65 20 6d 79 2d 6c 69 73 74 73 (define my-lists
29f0: 0a 20 20 27 28 28 29 20 28 31 29 20 28 31 20 31 . '(() (1) (1 1
2a00: 29 20 28 31 20 32 29 20 28 32 29 20 28 32 20 31 ) (1 2) (2) (2 1
2a10: 29 20 28 32 20 32 29 29 29 0a 0a 28 64 65 66 69 ) (2 2)))..(defi
2a20: 6e 65 20 6d 79 2d 76 65 63 74 6f 72 2d 61 73 2d ne my-vector-as-
2a30: 6c 69 73 74 73 0a 20 20 28 6d 61 70 20 6c 69 73 lists. (map lis
2a40: 74 2d 3e 76 65 63 74 6f 72 20 6d 79 2d 6c 69 73 t->vector my-lis
2a50: 74 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 6d 79 ts))..(define my
2a60: 2d 6c 69 73 74 2d 61 73 2d 76 65 63 74 6f 72 73 -list-as-vectors
2a70: 0a 20 20 27 28 28 29 20 28 31 29 20 28 32 29 20 . '(() (1) (2)
2a80: 28 31 20 31 29 20 28 31 20 32 29 20 28 32 20 31 (1 1) (1 2) (2 1
2a90: 29 20 28 32 20 32 29 29 29 0a 0a 28 64 65 66 69 ) (2 2)))..(defi
2aa0: 6e 65 20 6d 79 2d 76 65 63 74 6f 72 73 0a 20 20 ne my-vectors.
2ab0: 28 6d 61 70 20 6c 69 73 74 2d 3e 76 65 63 74 6f (map list->vecto
2ac0: 72 20 6d 79 2d 6c 69 73 74 2d 61 73 2d 76 65 63 r my-list-as-vec
2ad0: 74 6f 72 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 tors))..(define
2ae0: 6d 79 2d 6e 75 6c 6c 2d 6f 72 2d 70 61 69 72 73 my-null-or-pairs
2af0: 20 0a 20 20 27 28 28 29 0a 20 20 20 20 28 31 29 . '((). (1)
2b00: 20 28 31 20 31 29 20 28 31 20 32 29 20 28 31 20 (1 1) (1 2) (1
2b10: 2e 20 31 29 20 28 31 20 2e 20 32 29 20 0a 20 20 . 1) (1 . 2) .
2b20: 20 20 28 32 29 20 28 32 20 31 29 20 28 32 20 32 (2) (2 1) (2 2
2b30: 29 20 28 32 20 2e 20 31 29 20 28 32 20 2e 20 32 ) (2 . 1) (2 . 2
2b40: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 6d 79 2d )))..(define my-
2b50: 6f 62 6a 65 63 74 73 0a 20 20 28 61 70 70 65 6e objects. (appen
2b60: 64 20 6d 79 2d 6e 75 6c 6c 2d 6f 72 2d 70 61 69 d my-null-or-pai
2b70: 72 73 0a 20 20 20 20 20 20 20 20 20 20 6d 79 2d rs. my-
2b80: 62 6f 6f 6c 65 61 6e 73 0a 20 20 20 20 20 20 20 booleans.
2b90: 20 20 20 6d 79 2d 63 68 61 72 73 0a 20 20 20 20 my-chars.
2ba0: 20 20 20 20 20 20 6d 79 2d 73 74 72 69 6e 67 73 my-strings
2bb0: 0a 20 20 20 20 20 20 20 20 20 20 6d 79 2d 73 79 . my-sy
2bc0: 6d 62 6f 6c 73 0a 20 20 20 20 20 20 20 20 20 20 mbols.
2bd0: 6d 79 2d 69 6e 74 65 67 65 72 73 0a 20 20 20 20 my-integers.
2be0: 20 20 20 20 20 20 6d 79 2d 76 65 63 74 6f 72 73 my-vectors
2bf0: 29 29 0a 0a 3b 20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..; ==========
2c00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c40: 3d 3d 3d 0a 0a 3b 20 54 68 65 20 63 68 65 63 6b ===..; The check
2c50: 73 0a 3b 20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a s.; ==========..
2c60: 28 64 65 66 69 6e 65 20 28 63 68 65 63 6b 3a 69 (define (check:i
2c70: 66 33 29 0a 20 20 0a 20 20 3b 20 62 61 73 69 63 f3). . ; basic
2c80: 20 66 75 6e 63 74 69 6f 6e 61 6c 69 74 79 0a 20 functionality.
2c90: 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 69 . (my-check (i
2ca0: 66 33 20 2d 31 20 27 6e 20 27 7a 20 27 70 29 20 f3 -1 'n 'z 'p)
2cb0: 3d 3e 20 27 6e 29 0a 20 20 28 6d 79 2d 63 68 65 => 'n). (my-che
2cc0: 63 6b 20 28 69 66 33 20 20 30 20 27 6e 20 27 7a ck (if3 0 'n 'z
2cd0: 20 27 70 29 20 3d 3e 20 27 7a 29 0a 20 20 28 6d 'p) => 'z). (m
2ce0: 79 2d 63 68 65 63 6b 20 28 69 66 33 20 20 31 20 y-check (if3 1
2cf0: 27 6e 20 27 7a 20 27 70 29 20 3d 3e 20 27 70 29 'n 'z 'p) => 'p)
2d00: 0a 20 20 0a 20 20 3b 20 63 68 65 63 6b 20 61 72 . . ; check ar
2d10: 67 75 6d 65 6e 74 73 20 61 72 65 20 65 76 61 6c guments are eval
2d20: 75 61 74 65 64 20 6f 6e 6c 79 20 6f 6e 63 65 0a uated only once.
2d30: 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 0a . (my-check .
2d40: 20 20 20 28 6c 65 74 20 28 28 78 20 2d 31 29 29 (let ((x -1))
2d50: 0a 20 20 20 20 20 28 69 66 33 20 28 6c 65 74 20 . (if3 (let
2d60: 28 28 78 30 20 78 29 29 20 28 73 65 74 21 20 78 ((x0 x)) (set! x
2d70: 20 28 2b 20 78 20 31 29 29 20 78 30 29 20 27 6e (+ x 1)) x0) 'n
2d80: 20 27 7a 20 27 70 29 29 0a 20 20 20 3d 3e 20 27 'z 'p)). => '
2d90: 6e 29 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 n). . (my-chec
2da0: 6b 20 0a 20 20 20 28 6c 65 74 20 28 28 78 20 2d k . (let ((x -
2db0: 31 29 20 28 79 20 30 29 29 20 0a 20 20 20 20 20 1) (y 0)) .
2dc0: 28 69 66 33 20 28 6c 65 74 20 28 28 78 30 20 78 (if3 (let ((x0 x
2dd0: 29 29 20 28 73 65 74 21 20 78 20 28 2b 20 78 20 )) (set! x (+ x
2de0: 31 29 29 20 78 30 29 0a 20 20 20 20 20 20 20 20 1)) x0).
2df0: 20 20 28 62 65 67 69 6e 20 28 73 65 74 21 20 79 (begin (set! y
2e00: 20 28 2b 20 79 20 31 29 29 20 20 20 79 29 0a 20 (+ y 1)) y).
2e10: 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 20 (begin
2e20: 28 73 65 74 21 20 79 20 28 2b 20 79 20 31 30 29 (set! y (+ y 10)
2e30: 29 20 20 79 29 0a 20 20 20 20 20 20 20 20 20 20 ) y).
2e40: 28 62 65 67 69 6e 20 28 73 65 74 21 20 79 20 28 (begin (set! y (
2e50: 2b 20 79 20 31 30 30 29 29 20 79 29 29 29 0a 20 + y 100)) y))).
2e60: 20 20 3d 3e 20 31 29 0a 20 20 0a 20 20 28 6d 79 => 1). . (my
2e70: 2d 63 68 65 63 6b 20 0a 20 20 20 28 6c 65 74 20 -check . (let
2e80: 28 28 78 20 30 29 20 28 79 20 30 29 29 20 0a 20 ((x 0) (y 0)) .
2e90: 20 20 20 20 28 69 66 33 20 28 6c 65 74 20 28 28 (if3 (let ((
2ea0: 78 30 20 78 29 29 20 28 73 65 74 21 20 78 20 28 x0 x)) (set! x (
2eb0: 2b 20 78 20 31 29 29 20 78 30 29 0a 20 20 20 20 + x 1)) x0).
2ec0: 20 20 20 20 20 20 28 62 65 67 69 6e 20 28 73 65 (begin (se
2ed0: 74 21 20 79 20 28 2b 20 79 20 31 29 29 20 20 20 t! y (+ y 1))
2ee0: 79 29 0a 20 20 20 20 20 20 20 20 20 20 28 62 65 y). (be
2ef0: 67 69 6e 20 28 73 65 74 21 20 79 20 28 2b 20 79 gin (set! y (+ y
2f00: 20 31 30 29 29 20 20 79 29 0a 20 20 20 20 20 20 10)) y).
2f10: 20 20 20 20 28 62 65 67 69 6e 20 28 73 65 74 21 (begin (set!
2f20: 20 79 20 28 2b 20 79 20 31 30 30 29 29 20 79 29 y (+ y 100)) y)
2f30: 29 29 0a 20 20 20 3d 3e 20 31 30 29 0a 20 20 0a )). => 10). .
2f40: 20 20 28 6d 79 2d 63 68 65 63 6b 20 0a 20 20 20 (my-check .
2f50: 28 6c 65 74 20 28 28 78 20 31 29 20 28 79 20 30 (let ((x 1) (y 0
2f60: 29 29 20 0a 20 20 20 20 20 28 69 66 33 20 28 6c )) . (if3 (l
2f70: 65 74 20 28 28 78 30 20 78 29 29 20 28 73 65 74 et ((x0 x)) (set
2f80: 21 20 78 20 28 2b 20 78 20 31 29 29 20 78 30 29 ! x (+ x 1)) x0)
2f90: 0a 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 . (begi
2fa0: 6e 20 28 73 65 74 21 20 79 20 28 2b 20 79 20 31 n (set! y (+ y 1
2fb0: 29 29 20 20 20 79 29 0a 20 20 20 20 20 20 20 20 )) y).
2fc0: 20 20 28 62 65 67 69 6e 20 28 73 65 74 21 20 79 (begin (set! y
2fd0: 20 28 2b 20 79 20 31 30 29 29 20 20 79 29 0a 20 (+ y 10)) y).
2fe0: 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 20 (begin
2ff0: 28 73 65 74 21 20 79 20 28 2b 20 79 20 31 30 30 (set! y (+ y 100
3000: 29 29 20 79 29 29 29 0a 20 20 20 3d 3e 20 31 30 )) y))). => 10
3010: 30 29 0a 20 20 0a 20 20 29 20 3b 20 63 68 65 63 0). . ) ; chec
3020: 6b 3a 69 66 33 0a 0a 28 64 65 66 69 6e 65 2d 73 k:if3..(define-s
3030: 79 6e 74 61 78 20 6d 79 2d 63 68 65 63 6b 2d 69 yntax my-check-i
3040: 66 32 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c f2. (syntax-rul
3050: 65 73 20 28 29 0a 20 20 20 20 28 28 6d 79 2d 63 es (). ((my-c
3060: 68 65 63 6b 2d 69 66 32 20 69 66 2d 72 65 6c 3f heck-if2 if-rel?
3070: 20 72 65 6c 29 0a 20 20 20 20 20 28 62 65 67 69 rel). (begi
3080: 6e 0a 20 20 20 20 20 20 20 3b 20 63 68 65 63 6b n. ; check
3090: 20 72 65 73 75 6c 74 0a 20 20 20 20 20 20 20 28 result. (
30a0: 6d 79 2d 63 68 65 63 6b 20 28 69 66 2d 72 65 6c my-check (if-rel
30b0: 3f 20 2d 31 20 27 79 65 73 20 27 6e 6f 29 20 3d ? -1 'yes 'no) =
30c0: 3e 20 28 69 66 20 28 72 65 6c 20 2d 31 20 30 29 > (if (rel -1 0)
30d0: 20 27 79 65 73 20 27 6e 6f 29 29 0a 20 20 20 20 'yes 'no)).
30e0: 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 69 66 (my-check (if
30f0: 2d 72 65 6c 3f 20 20 30 20 27 79 65 73 20 27 6e -rel? 0 'yes 'n
3100: 6f 29 20 3d 3e 20 28 69 66 20 28 72 65 6c 20 20 o) => (if (rel
3110: 30 20 30 29 20 27 79 65 73 20 27 6e 6f 29 29 0a 0 0) 'yes 'no)).
3120: 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b (my-check
3130: 20 28 69 66 2d 72 65 6c 3f 20 20 31 20 27 79 65 (if-rel? 1 'ye
3140: 73 20 27 6e 6f 29 20 3d 3e 20 28 69 66 20 28 72 s 'no) => (if (r
3150: 65 6c 20 20 31 20 30 29 20 27 79 65 73 20 27 6e el 1 0) 'yes 'n
3160: 6f 29 29 0a 20 20 20 20 20 20 20 0a 20 20 20 20 o)). .
3170: 20 20 20 3b 20 63 68 65 63 6b 20 72 65 73 75 6c ; check resul
3180: 74 20 6f 66 20 27 6c 61 74 65 72 61 6c 6c 79 20 t of 'laterally
3190: 63 68 61 6c 6c 65 6e 67 65 64 20 69 66 27 0a 20 challenged if'.
31a0: 20 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 (my-check
31b0: 28 6c 65 74 20 28 28 78 20 23 66 29 29 20 28 69 (let ((x #f)) (i
31c0: 66 2d 72 65 6c 3f 20 2d 31 20 28 73 65 74 21 20 f-rel? -1 (set!
31d0: 78 20 23 74 29 29 20 78 29 20 3d 3e 20 28 72 65 x #t)) x) => (re
31e0: 6c 20 2d 31 20 30 29 29 0a 20 20 20 20 20 20 20 l -1 0)).
31f0: 28 6d 79 2d 63 68 65 63 6b 20 28 6c 65 74 20 28 (my-check (let (
3200: 28 78 20 23 66 29 29 20 28 69 66 2d 72 65 6c 3f (x #f)) (if-rel?
3210: 20 20 30 20 28 73 65 74 21 20 78 20 23 74 29 29 0 (set! x #t))
3220: 20 78 29 20 3d 3e 20 28 72 65 6c 20 20 30 20 30 x) => (rel 0 0
3230: 29 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 )). (my-ch
3240: 65 63 6b 20 28 6c 65 74 20 28 28 78 20 23 66 29 eck (let ((x #f)
3250: 29 20 28 69 66 2d 72 65 6c 3f 20 20 31 20 28 73 ) (if-rel? 1 (s
3260: 65 74 21 20 78 20 23 74 29 29 20 78 29 20 3d 3e et! x #t)) x) =>
3270: 20 28 72 65 6c 20 20 31 20 30 29 29 0a 20 20 20 (rel 1 0)).
3280: 20 20 20 20 0a 20 20 20 20 20 20 20 3b 20 63 68 . ; ch
3290: 65 63 6b 20 74 68 61 74 20 3c 63 3e 20 69 73 20 eck that <c> is
32a0: 65 76 61 6c 75 61 74 65 64 20 65 78 61 63 74 6c evaluated exactl
32b0: 79 20 6f 6e 63 65 0a 20 20 20 20 20 20 20 28 6d y once. (m
32c0: 79 2d 63 68 65 63 6b 20 28 6c 65 74 20 28 28 6e y-check (let ((n
32d0: 20 30 29 29 20 28 69 66 2d 72 65 6c 3f 20 28 62 0)) (if-rel? (b
32e0: 65 67 69 6e 20 28 73 65 74 21 20 6e 20 28 2b 20 egin (set! n (+
32f0: 6e 20 31 29 29 20 2d 31 29 20 23 74 20 23 66 29 n 1)) -1) #t #f)
3300: 20 6e 29 20 3d 3e 20 31 29 0a 20 20 20 20 20 20 n) => 1).
3310: 20 28 6d 79 2d 63 68 65 63 6b 20 28 6c 65 74 20 (my-check (let
3320: 28 28 6e 20 30 29 29 20 28 69 66 2d 72 65 6c 3f ((n 0)) (if-rel?
3330: 20 28 62 65 67 69 6e 20 28 73 65 74 21 20 6e 20 (begin (set! n
3340: 28 2b 20 6e 20 31 29 29 20 20 30 29 20 23 74 20 (+ n 1)) 0) #t
3350: 23 66 29 20 6e 29 20 3d 3e 20 31 29 0a 20 20 20 #f) n) => 1).
3360: 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 6c (my-check (l
3370: 65 74 20 28 28 6e 20 30 29 29 20 28 69 66 2d 72 et ((n 0)) (if-r
3380: 65 6c 3f 20 28 62 65 67 69 6e 20 28 73 65 74 21 el? (begin (set!
3390: 20 6e 20 28 2b 20 6e 20 31 29 29 20 20 31 29 20 n (+ n 1)) 1)
33a0: 23 74 20 23 66 29 20 6e 29 20 3d 3e 20 31 29 0a #t #f) n) => 1).
33b0: 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b (my-check
33c0: 20 28 6c 65 74 20 28 28 6e 20 30 29 29 20 28 69 (let ((n 0)) (i
33d0: 66 2d 72 65 6c 3f 20 28 62 65 67 69 6e 20 28 73 f-rel? (begin (s
33e0: 65 74 21 20 6e 20 28 2b 20 6e 20 31 29 29 20 2d et! n (+ n 1)) -
33f0: 31 29 20 23 74 29 20 6e 29 20 3d 3e 20 31 29 0a 1) #t) n) => 1).
3400: 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b (my-check
3410: 20 28 6c 65 74 20 28 28 6e 20 30 29 29 20 28 69 (let ((n 0)) (i
3420: 66 2d 72 65 6c 3f 20 28 62 65 67 69 6e 20 28 73 f-rel? (begin (s
3430: 65 74 21 20 6e 20 28 2b 20 6e 20 31 29 29 20 20 et! n (+ n 1))
3440: 30 29 20 23 74 29 20 6e 29 20 3d 3e 20 31 29 0a 0) #t) n) => 1).
3450: 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b (my-check
3460: 20 28 6c 65 74 20 28 28 6e 20 30 29 29 20 28 69 (let ((n 0)) (i
3470: 66 2d 72 65 6c 3f 20 28 62 65 67 69 6e 20 28 73 f-rel? (begin (s
3480: 65 74 21 20 6e 20 28 2b 20 6e 20 31 29 29 20 20 et! n (+ n 1))
3490: 31 29 20 23 74 29 20 6e 29 20 3d 3e 20 31 29 0a 1) #t) n) => 1).
34a0: 20 20 20 20 20 20 20 29 29 29 29 0a 0a 28 64 65 ))))..(de
34b0: 66 69 6e 65 20 28 63 68 65 63 6b 3a 69 66 73 29 fine (check:ifs)
34c0: 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d . . (my-check-
34d0: 69 66 32 20 69 66 3d 3f 20 20 20 20 20 3d 29 0a if2 if=? =).
34e0: 20 20 28 6d 79 2d 63 68 65 63 6b 2d 69 66 32 20 (my-check-if2
34f0: 69 66 3c 3f 20 20 20 20 20 3c 29 0a 20 20 28 6d if<? <). (m
3500: 79 2d 63 68 65 63 6b 2d 69 66 32 20 69 66 3e 3f y-check-if2 if>?
3510: 20 20 20 20 20 3e 29 0a 20 20 28 6d 79 2d 63 68 >). (my-ch
3520: 65 63 6b 2d 69 66 32 20 69 66 3c 3d 3f 20 20 20 eck-if2 if<=?
3530: 20 3c 3d 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b <=). (my-check
3540: 2d 69 66 32 20 69 66 3e 3d 3f 20 20 20 20 3e 3d -if2 if>=? >=
3550: 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d 69 66 ). (my-check-if
3560: 32 20 69 66 2d 6e 6f 74 3d 3f 20 28 6c 61 6d 62 2 if-not=? (lamb
3570: 64 61 20 28 78 20 79 29 20 28 6e 6f 74 20 28 3d da (x y) (not (=
3580: 20 78 20 79 29 29 29 29 0a 20 20 0a 20 20 29 20 x y)))). . )
3590: 3b 20 63 68 65 63 6b 3a 69 66 32 0a 0a 3b 20 3c ; check:if2..; <
35a0: 3f 20 65 74 63 2e 20 6d 61 63 72 6f 73 0a 0a 28 ? etc. macros..(
35b0: 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d 79 define-syntax my
35c0: 2d 63 68 65 63 6b 2d 63 68 61 69 6e 32 0a 20 20 -check-chain2.
35d0: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 (syntax-rules ()
35e0: 0a 20 20 20 20 28 28 6d 79 2d 63 68 65 63 6b 2d . ((my-check-
35f0: 63 68 61 69 6e 32 20 72 65 6c 3f 20 72 65 6c 29 chain2 rel? rel)
3600: 0a 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 . (begin.
3610: 20 20 20 20 3b 20 61 6c 6c 20 63 68 61 69 6e 73 ; all chains
3620: 20 6f 66 20 6c 65 6e 67 74 68 20 32 0a 20 20 20 of length 2.
3630: 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 72 (my-check (r
3640: 65 6c 3f 20 63 69 20 30 20 30 29 20 3d 3e 20 28 el? ci 0 0) => (
3650: 72 65 6c 20 30 20 30 29 29 0a 20 20 20 20 20 20 rel 0 0)).
3660: 20 28 6d 79 2d 63 68 65 63 6b 20 28 72 65 6c 3f (my-check (rel?
3670: 20 63 69 20 30 20 31 29 20 3d 3e 20 28 72 65 6c ci 0 1) => (rel
3680: 20 30 20 31 29 29 0a 20 20 20 20 20 20 20 28 6d 0 1)). (m
3690: 79 2d 63 68 65 63 6b 20 28 72 65 6c 3f 20 63 69 y-check (rel? ci
36a0: 20 31 20 30 29 20 3d 3e 20 28 72 65 6c 20 31 20 1 0) => (rel 1
36b0: 30 29 29 0a 20 20 20 20 20 20 20 0a 20 20 20 20 0)). .
36c0: 20 20 20 3b 20 75 73 69 6e 67 20 64 65 66 61 75 ; using defau
36d0: 6c 74 2d 63 6f 6d 70 61 72 65 0a 20 20 20 20 20 lt-compare.
36e0: 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 72 65 6c (my-check (rel
36f0: 3f 20 30 20 30 29 20 3d 3e 20 28 72 65 6c 20 30 ? 0 0) => (rel 0
3700: 20 30 29 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 0)). (my-
3710: 63 68 65 63 6b 20 28 72 65 6c 3f 20 30 20 31 29 check (rel? 0 1)
3720: 20 3d 3e 20 28 72 65 6c 20 30 20 31 29 29 0a 20 => (rel 0 1)).
3730: 20 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 (my-check
3740: 28 72 65 6c 3f 20 31 20 30 29 20 3d 3e 20 28 72 (rel? 1 0) => (r
3750: 65 6c 20 31 20 30 29 29 0a 0a 20 20 20 20 20 20 el 1 0))..
3760: 20 3b 20 61 73 20 61 20 63 6f 6d 62 69 6e 61 74 ; as a combinat
3770: 6f 72 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 or. (my-ch
3780: 65 63 6b 20 28 28 72 65 6c 3f 20 63 69 29 20 30 eck ((rel? ci) 0
3790: 20 30 29 20 3d 3e 20 28 72 65 6c 20 30 20 30 29 0) => (rel 0 0)
37a0: 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 ). (my-che
37b0: 63 6b 20 28 28 72 65 6c 3f 20 63 69 29 20 30 20 ck ((rel? ci) 0
37c0: 31 29 20 3d 3e 20 28 72 65 6c 20 30 20 31 29 29 1) => (rel 0 1))
37d0: 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 63 . (my-chec
37e0: 6b 20 28 28 72 65 6c 3f 20 63 69 29 20 31 20 30 k ((rel? ci) 1 0
37f0: 29 20 3d 3e 20 28 72 65 6c 20 31 20 30 29 29 0a ) => (rel 1 0)).
3800: 0a 20 20 20 20 20 20 20 3b 20 75 73 69 6e 67 20 . ; using
3810: 64 65 66 61 75 6c 74 2d 63 6f 6d 70 61 72 65 20 default-compare
3820: 61 73 20 61 20 63 6f 6d 62 69 6e 61 74 6f 72 0a as a combinator.
3830: 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b (my-check
3840: 20 28 28 72 65 6c 3f 29 20 30 20 30 29 20 3d 3e ((rel?) 0 0) =>
3850: 20 28 72 65 6c 20 30 20 30 29 29 0a 20 20 20 20 (rel 0 0)).
3860: 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 28 72 (my-check ((r
3870: 65 6c 3f 29 20 30 20 31 29 20 3d 3e 20 28 72 65 el?) 0 1) => (re
3880: 6c 20 30 20 31 29 29 0a 20 20 20 20 20 20 20 28 l 0 1)). (
3890: 6d 79 2d 63 68 65 63 6b 20 28 28 72 65 6c 3f 29 my-check ((rel?)
38a0: 20 31 20 30 29 20 3d 3e 20 28 72 65 6c 20 31 20 1 0) => (rel 1
38b0: 30 29 29 0a 20 20 20 20 20 20 20 29 29 29 29 0a 0)). )))).
38c0: 0a 28 64 65 66 69 6e 65 20 28 6c 69 73 74 2d 3e .(define (list->
38d0: 73 65 74 20 78 73 29 20 3b 20 78 73 20 61 20 6c set xs) ; xs a l
38e0: 69 73 74 20 6f 66 20 69 6e 74 65 67 65 72 73 0a ist of integers.
38f0: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 78 73 29 (if (null? xs)
3900: 0a 20 20 20 20 20 20 27 28 29 0a 20 20 20 20 20 . '().
3910: 20 28 6c 65 74 20 28 28 6d 61 78 2d 78 73 0a 20 (let ((max-xs.
3920: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
3930: 20 6d 61 78 2d 77 69 74 68 6f 75 74 2d 61 70 70 max-without-app
3940: 6c 79 20 28 28 6d 20 31 29 20 28 78 73 20 78 73 ly ((m 1) (xs xs
3950: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
3960: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 78 73 29 (if (null? xs)
3970: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3980: 20 20 20 20 6d 0a 20 20 20 20 20 20 20 20 20 20 m.
3990: 20 20 20 20 20 20 20 20 20 28 6d 61 78 2d 77 69 (max-wi
39a0: 74 68 6f 75 74 2d 61 70 70 6c 79 20 28 6d 61 78 thout-apply (max
39b0: 20 6d 20 28 63 61 72 20 78 73 29 29 20 28 63 64 m (car xs)) (cd
39c0: 72 20 78 73 29 29 29 29 29 29 0a 20 20 20 20 20 r xs)))))).
39d0: 20 20 20 28 6c 65 74 20 28 28 69 6e 2d 78 73 3f (let ((in-xs?
39e0: 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 28 2b (make-vector (+
39f0: 20 6d 61 78 2d 78 73 20 31 29 20 23 66 29 29 29 max-xs 1) #f)))
3a00: 0a 20 20 20 20 20 20 20 20 20 20 28 64 6f 2d 65 . (do-e
3a10: 63 20 28 3a 6c 69 73 74 20 78 20 78 73 29 20 28 c (:list x xs) (
3a20: 76 65 63 74 6f 72 2d 73 65 74 21 20 69 6e 2d 78 vector-set! in-x
3a30: 73 3f 20 78 20 23 74 29 29 0a 20 20 20 20 20 20 s? x #t)).
3a40: 20 20 20 20 28 6c 69 73 74 2d 65 63 20 28 3a 76 (list-ec (:v
3a50: 65 63 74 6f 72 20 69 6e 3f 20 28 69 6e 64 65 78 ector in? (index
3a60: 20 78 29 20 69 6e 2d 78 73 3f 29 0a 20 20 20 20 x) in-xs?).
3a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3a80: 69 66 20 69 6e 3f 29 0a 20 20 20 20 20 20 20 20 if in?).
3a90: 20 20 20 20 20 20 20 20 20 20 20 78 29 29 29 29 x))))
3aa0: 29 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 )..(define-synta
3ab0: 78 20 61 72 67 75 6d 65 6e 74 73 2d 75 73 65 64 x arguments-used
3ac0: 20 3b 20 73 65 74 20 6f 66 20 61 72 67 75 6d 65 ; set of argume
3ad0: 6e 74 73 20 28 69 6e 74 65 67 65 72 2c 20 3e 3d nts (integer, >=
3ae0: 30 29 20 75 73 65 64 20 69 6e 20 63 6f 6d 70 61 0) used in compa
3af0: 72 65 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c re. (syntax-rul
3b00: 65 73 20 28 29 0a 20 20 20 20 28 28 61 72 67 75 es (). ((argu
3b10: 6d 65 6e 74 73 2d 75 73 65 64 20 28 72 65 6c 31 ments-used (rel1
3b20: 2f 72 65 6c 32 20 63 6f 6d 70 61 72 65 20 61 72 /rel2 compare ar
3b30: 67 20 2e 2e 2e 29 29 0a 20 20 20 20 20 28 6c 65 g ...)). (le
3b40: 74 20 28 28 75 73 65 64 20 27 28 29 29 29 0a 20 t ((used '())).
3b50: 20 20 20 20 20 20 28 72 65 6c 31 2f 72 65 6c 32 (rel1/rel2
3b60: 20 28 6c 61 6d 62 64 61 20 28 78 20 79 29 0a 20 (lambda (x y).
3b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b80: 20 20 20 28 73 65 74 21 20 75 73 65 64 20 28 63 (set! used (c
3b90: 6f 6e 73 20 78 20 28 63 6f 6e 73 20 79 20 75 73 ons x (cons y us
3ba0: 65 64 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ed))).
3bb0: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 70 61 (compa
3bc0: 72 65 20 78 20 79 29 29 0a 20 20 20 20 20 20 20 re x y)).
3bd0: 20 20 20 20 20 20 20 20 20 20 20 61 72 67 20 2e arg .
3be0: 2e 2e 29 0a 20 20 20 20 20 20 20 28 6c 69 73 74 ..). (list
3bf0: 2d 3e 73 65 74 20 75 73 65 64 29 29 29 29 29 0a ->set used))))).
3c00: 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 .(define-syntax
3c10: 6d 79 2d 63 68 65 63 6b 2d 63 68 61 69 6e 33 0a my-check-chain3.
3c20: 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 (syntax-rules
3c30: 28 29 0a 20 20 20 20 28 28 6d 79 2d 63 68 65 63 (). ((my-chec
3c40: 6b 2d 63 68 61 69 6e 33 20 72 65 6c 31 2f 72 65 k-chain3 rel1/re
3c50: 6c 32 3f 20 72 65 6c 31 20 72 65 6c 32 29 0a 20 l2? rel1 rel2).
3c60: 20 20 20 20 28 62 65 67 69 6e 20 20 20 20 20 0a (begin .
3c70: 20 20 20 20 20 20 20 3b 20 61 6c 6c 20 63 68 61 ; all cha
3c80: 69 6e 73 20 6f 66 20 6c 65 6e 67 74 68 20 33 0a ins of length 3.
3c90: 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b (my-check
3ca0: 20 28 72 65 6c 31 2f 72 65 6c 32 3f 20 63 69 20 (rel1/rel2? ci
3cb0: 30 20 30 20 30 29 20 3d 3e 20 28 61 6e 64 20 28 0 0 0) => (and (
3cc0: 72 65 6c 31 20 30 20 30 29 20 28 72 65 6c 32 20 rel1 0 0) (rel2
3cd0: 30 20 30 29 29 29 0a 20 20 20 20 20 20 20 28 6d 0 0))). (m
3ce0: 79 2d 63 68 65 63 6b 20 28 72 65 6c 31 2f 72 65 y-check (rel1/re
3cf0: 6c 32 3f 20 63 69 20 30 20 30 20 31 29 20 3d 3e l2? ci 0 0 1) =>
3d00: 20 28 61 6e 64 20 28 72 65 6c 31 20 30 20 30 29 (and (rel1 0 0)
3d10: 20 28 72 65 6c 32 20 30 20 31 29 29 29 0a 20 20 (rel2 0 1))).
3d20: 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 (my-check (
3d30: 72 65 6c 31 2f 72 65 6c 32 3f 20 63 69 20 30 20 rel1/rel2? ci 0
3d40: 31 20 30 29 20 3d 3e 20 28 61 6e 64 20 28 72 65 1 0) => (and (re
3d50: 6c 31 20 30 20 31 29 20 28 72 65 6c 32 20 31 20 l1 0 1) (rel2 1
3d60: 30 29 29 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 0))). (my-
3d70: 63 68 65 63 6b 20 28 72 65 6c 31 2f 72 65 6c 32 check (rel1/rel2
3d80: 3f 20 63 69 20 31 20 30 20 30 29 20 3d 3e 20 28 ? ci 1 0 0) => (
3d90: 61 6e 64 20 28 72 65 6c 31 20 31 20 30 29 20 28 and (rel1 1 0) (
3da0: 72 65 6c 32 20 30 20 30 29 29 29 0a 20 20 20 20 rel2 0 0))).
3db0: 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 72 65 (my-check (re
3dc0: 6c 31 2f 72 65 6c 32 3f 20 63 69 20 31 20 31 20 l1/rel2? ci 1 1
3dd0: 30 29 20 3d 3e 20 28 61 6e 64 20 28 72 65 6c 31 0) => (and (rel1
3de0: 20 31 20 31 29 20 28 72 65 6c 32 20 31 20 30 29 1 1) (rel2 1 0)
3df0: 29 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 )). (my-ch
3e00: 65 63 6b 20 28 72 65 6c 31 2f 72 65 6c 32 3f 20 eck (rel1/rel2?
3e10: 63 69 20 31 20 30 20 31 29 20 3d 3e 20 28 61 6e ci 1 0 1) => (an
3e20: 64 20 28 72 65 6c 31 20 31 20 30 29 20 28 72 65 d (rel1 1 0) (re
3e30: 6c 32 20 30 20 31 29 29 29 0a 20 20 20 20 20 20 l2 0 1))).
3e40: 20 28 6d 79 2d 63 68 65 63 6b 20 28 72 65 6c 31 (my-check (rel1
3e50: 2f 72 65 6c 32 3f 20 63 69 20 30 20 31 20 31 29 /rel2? ci 0 1 1)
3e60: 20 3d 3e 20 28 61 6e 64 20 28 72 65 6c 31 20 30 => (and (rel1 0
3e70: 20 31 29 20 28 72 65 6c 32 20 31 20 31 29 29 29 1) (rel2 1 1)))
3e80: 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 63 . (my-chec
3e90: 6b 20 28 72 65 6c 31 2f 72 65 6c 32 3f 20 63 69 k (rel1/rel2? ci
3ea0: 20 30 20 31 20 32 29 20 3d 3e 20 28 61 6e 64 20 0 1 2) => (and
3eb0: 28 72 65 6c 31 20 30 20 31 29 20 28 72 65 6c 32 (rel1 0 1) (rel2
3ec0: 20 31 20 32 29 29 29 0a 20 20 20 20 20 20 20 28 1 2))). (
3ed0: 6d 79 2d 63 68 65 63 6b 20 28 72 65 6c 31 2f 72 my-check (rel1/r
3ee0: 65 6c 32 3f 20 63 69 20 30 20 32 20 31 29 20 3d el2? ci 0 2 1) =
3ef0: 3e 20 28 61 6e 64 20 28 72 65 6c 31 20 30 20 32 > (and (rel1 0 2
3f00: 29 20 28 72 65 6c 32 20 32 20 31 29 29 29 0a 20 ) (rel2 2 1))).
3f10: 20 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 (my-check
3f20: 28 72 65 6c 31 2f 72 65 6c 32 3f 20 63 69 20 31 (rel1/rel2? ci 1
3f30: 20 32 20 30 29 20 3d 3e 20 28 61 6e 64 20 28 72 2 0) => (and (r
3f40: 65 6c 31 20 31 20 32 29 20 28 72 65 6c 32 20 32 el1 1 2) (rel2 2
3f50: 20 30 29 29 29 0a 20 20 20 20 20 20 20 28 6d 79 0))). (my
3f60: 2d 63 68 65 63 6b 20 28 72 65 6c 31 2f 72 65 6c -check (rel1/rel
3f70: 32 3f 20 63 69 20 31 20 30 20 32 29 20 3d 3e 20 2? ci 1 0 2) =>
3f80: 28 61 6e 64 20 28 72 65 6c 31 20 31 20 30 29 20 (and (rel1 1 0)
3f90: 28 72 65 6c 32 20 30 20 32 29 29 29 0a 20 20 20 (rel2 0 2))).
3fa0: 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 72 (my-check (r
3fb0: 65 6c 31 2f 72 65 6c 32 3f 20 63 69 20 32 20 30 el1/rel2? ci 2 0
3fc0: 20 31 29 20 3d 3e 20 28 61 6e 64 20 28 72 65 6c 1) => (and (rel
3fd0: 31 20 32 20 30 29 20 28 72 65 6c 32 20 30 20 31 1 2 0) (rel2 0 1
3fe0: 29 29 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 ))). (my-c
3ff0: 68 65 63 6b 20 28 72 65 6c 31 2f 72 65 6c 32 3f heck (rel1/rel2?
4000: 20 63 69 20 32 20 31 20 30 29 20 3d 3e 20 28 61 ci 2 1 0) => (a
4010: 6e 64 20 28 72 65 6c 31 20 32 20 31 29 20 28 72 nd (rel1 2 1) (r
4020: 65 6c 32 20 31 20 30 29 29 29 0a 20 20 20 20 20 el2 1 0))).
4030: 20 20 0a 20 20 20 20 20 20 20 3b 20 75 73 69 6e . ; usin
4040: 67 20 64 65 66 61 75 6c 74 2d 63 6f 6d 70 61 72 g default-compar
4050: 65 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 e. (my-che
4060: 63 6b 20 28 72 65 6c 31 2f 72 65 6c 32 3f 20 30 ck (rel1/rel2? 0
4070: 20 30 20 30 29 20 3d 3e 20 28 61 6e 64 20 28 72 0 0) => (and (r
4080: 65 6c 31 20 30 20 30 29 20 28 72 65 6c 32 20 30 el1 0 0) (rel2 0
4090: 20 30 29 29 29 0a 20 20 20 20 20 20 20 28 6d 79 0))). (my
40a0: 2d 63 68 65 63 6b 20 28 72 65 6c 31 2f 72 65 6c -check (rel1/rel
40b0: 32 3f 20 30 20 30 20 31 29 20 3d 3e 20 28 61 6e 2? 0 0 1) => (an
40c0: 64 20 28 72 65 6c 31 20 30 20 30 29 20 28 72 65 d (rel1 0 0) (re
40d0: 6c 32 20 30 20 31 29 29 29 0a 20 20 20 20 20 20 l2 0 1))).
40e0: 20 28 6d 79 2d 63 68 65 63 6b 20 28 72 65 6c 31 (my-check (rel1
40f0: 2f 72 65 6c 32 3f 20 30 20 31 20 30 29 20 3d 3e /rel2? 0 1 0) =>
4100: 20 28 61 6e 64 20 28 72 65 6c 31 20 30 20 31 29 (and (rel1 0 1)
4110: 20 28 72 65 6c 32 20 31 20 30 29 29 29 0a 20 20 (rel2 1 0))).
4120: 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 (my-check (
4130: 72 65 6c 31 2f 72 65 6c 32 3f 20 31 20 30 20 30 rel1/rel2? 1 0 0
4140: 29 20 3d 3e 20 28 61 6e 64 20 28 72 65 6c 31 20 ) => (and (rel1
4150: 31 20 30 29 20 28 72 65 6c 32 20 30 20 30 29 29 1 0) (rel2 0 0))
4160: 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 ). (my-che
4170: 63 6b 20 28 72 65 6c 31 2f 72 65 6c 32 3f 20 31 ck (rel1/rel2? 1
4180: 20 31 20 30 29 20 3d 3e 20 28 61 6e 64 20 28 72 1 0) => (and (r
4190: 65 6c 31 20 31 20 31 29 20 28 72 65 6c 32 20 31 el1 1 1) (rel2 1
41a0: 20 30 29 29 29 0a 20 20 20 20 20 20 20 28 6d 79 0))). (my
41b0: 2d 63 68 65 63 6b 20 28 72 65 6c 31 2f 72 65 6c -check (rel1/rel
41c0: 32 3f 20 31 20 30 20 31 29 20 3d 3e 20 28 61 6e 2? 1 0 1) => (an
41d0: 64 20 28 72 65 6c 31 20 31 20 30 29 20 28 72 65 d (rel1 1 0) (re
41e0: 6c 32 20 30 20 31 29 29 29 0a 20 20 20 20 20 20 l2 0 1))).
41f0: 20 28 6d 79 2d 63 68 65 63 6b 20 28 72 65 6c 31 (my-check (rel1
4200: 2f 72 65 6c 32 3f 20 30 20 31 20 31 29 20 3d 3e /rel2? 0 1 1) =>
4210: 20 28 61 6e 64 20 28 72 65 6c 31 20 30 20 31 29 (and (rel1 0 1)
4220: 20 28 72 65 6c 32 20 31 20 31 29 29 29 0a 20 20 (rel2 1 1))).
4230: 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 (my-check (
4240: 72 65 6c 31 2f 72 65 6c 32 3f 20 30 20 31 20 32 rel1/rel2? 0 1 2
4250: 29 20 3d 3e 20 28 61 6e 64 20 28 72 65 6c 31 20 ) => (and (rel1
4260: 30 20 31 29 20 28 72 65 6c 32 20 31 20 32 29 29 0 1) (rel2 1 2))
4270: 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 ). (my-che
4280: 63 6b 20 28 72 65 6c 31 2f 72 65 6c 32 3f 20 30 ck (rel1/rel2? 0
4290: 20 32 20 31 29 20 3d 3e 20 28 61 6e 64 20 28 72 2 1) => (and (r
42a0: 65 6c 31 20 30 20 32 29 20 28 72 65 6c 32 20 32 el1 0 2) (rel2 2
42b0: 20 31 29 29 29 0a 20 20 20 20 20 20 20 28 6d 79 1))). (my
42c0: 2d 63 68 65 63 6b 20 28 72 65 6c 31 2f 72 65 6c -check (rel1/rel
42d0: 32 3f 20 31 20 32 20 30 29 20 3d 3e 20 28 61 6e 2? 1 2 0) => (an
42e0: 64 20 28 72 65 6c 31 20 31 20 32 29 20 28 72 65 d (rel1 1 2) (re
42f0: 6c 32 20 32 20 30 29 29 29 0a 20 20 20 20 20 20 l2 2 0))).
4300: 20 28 6d 79 2d 63 68 65 63 6b 20 28 72 65 6c 31 (my-check (rel1
4310: 2f 72 65 6c 32 3f 20 31 20 30 20 32 29 20 3d 3e /rel2? 1 0 2) =>
4320: 20 28 61 6e 64 20 28 72 65 6c 31 20 31 20 30 29 (and (rel1 1 0)
4330: 20 28 72 65 6c 32 20 30 20 32 29 29 29 0a 20 20 (rel2 0 2))).
4340: 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 (my-check (
4350: 72 65 6c 31 2f 72 65 6c 32 3f 20 32 20 30 20 31 rel1/rel2? 2 0 1
4360: 29 20 3d 3e 20 28 61 6e 64 20 28 72 65 6c 31 20 ) => (and (rel1
4370: 32 20 30 29 20 28 72 65 6c 32 20 30 20 31 29 29 2 0) (rel2 0 1))
4380: 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 ). (my-che
4390: 63 6b 20 28 72 65 6c 31 2f 72 65 6c 32 3f 20 32 ck (rel1/rel2? 2
43a0: 20 31 20 30 29 20 3d 3e 20 28 61 6e 64 20 28 72 1 0) => (and (r
43b0: 65 6c 31 20 32 20 31 29 20 28 72 65 6c 32 20 31 el1 2 1) (rel2 1
43c0: 20 30 29 29 29 0a 20 20 20 20 20 20 20 0a 20 20 0))). .
43d0: 20 20 20 20 20 3b 20 61 73 20 61 20 63 6f 6d 62 ; as a comb
43e0: 69 6e 61 74 6f 72 0a 20 20 20 20 20 20 20 28 6d inator. (m
43f0: 79 2d 63 68 65 63 6b 20 28 28 72 65 6c 31 2f 72 y-check ((rel1/r
4400: 65 6c 32 3f 20 63 69 29 20 30 20 30 20 30 29 20 el2? ci) 0 0 0)
4410: 3d 3e 20 28 61 6e 64 20 28 72 65 6c 31 20 30 20 => (and (rel1 0
4420: 30 29 20 28 72 65 6c 32 20 30 20 30 29 29 29 0a 0) (rel2 0 0))).
4430: 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b (my-check
4440: 20 28 28 72 65 6c 31 2f 72 65 6c 32 3f 20 63 69 ((rel1/rel2? ci
4450: 29 20 30 20 30 20 31 29 20 3d 3e 20 28 61 6e 64 ) 0 0 1) => (and
4460: 20 28 72 65 6c 31 20 30 20 30 29 20 28 72 65 6c (rel1 0 0) (rel
4470: 32 20 30 20 31 29 29 29 0a 20 20 20 20 20 20 20 2 0 1))).
4480: 28 6d 79 2d 63 68 65 63 6b 20 28 28 72 65 6c 31 (my-check ((rel1
4490: 2f 72 65 6c 32 3f 20 63 69 29 20 30 20 31 20 30 /rel2? ci) 0 1 0
44a0: 29 20 3d 3e 20 28 61 6e 64 20 28 72 65 6c 31 20 ) => (and (rel1
44b0: 30 20 31 29 20 28 72 65 6c 32 20 31 20 30 29 29 0 1) (rel2 1 0))
44c0: 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 ). (my-che
44d0: 63 6b 20 28 28 72 65 6c 31 2f 72 65 6c 32 3f 20 ck ((rel1/rel2?
44e0: 63 69 29 20 31 20 30 20 30 29 20 3d 3e 20 28 61 ci) 1 0 0) => (a
44f0: 6e 64 20 28 72 65 6c 31 20 31 20 30 29 20 28 72 nd (rel1 1 0) (r
4500: 65 6c 32 20 30 20 30 29 29 29 0a 20 20 20 20 20 el2 0 0))).
4510: 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 28 72 65 (my-check ((re
4520: 6c 31 2f 72 65 6c 32 3f 20 63 69 29 20 31 20 31 l1/rel2? ci) 1 1
4530: 20 30 29 20 3d 3e 20 28 61 6e 64 20 28 72 65 6c 0) => (and (rel
4540: 31 20 31 20 31 29 20 28 72 65 6c 32 20 31 20 30 1 1 1) (rel2 1 0
4550: 29 29 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 ))). (my-c
4560: 68 65 63 6b 20 28 28 72 65 6c 31 2f 72 65 6c 32 heck ((rel1/rel2
4570: 3f 20 63 69 29 20 31 20 30 20 31 29 20 3d 3e 20 ? ci) 1 0 1) =>
4580: 28 61 6e 64 20 28 72 65 6c 31 20 31 20 30 29 20 (and (rel1 1 0)
4590: 28 72 65 6c 32 20 30 20 31 29 29 29 0a 20 20 20 (rel2 0 1))).
45a0: 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 28 (my-check ((
45b0: 72 65 6c 31 2f 72 65 6c 32 3f 20 63 69 29 20 30 rel1/rel2? ci) 0
45c0: 20 31 20 31 29 20 3d 3e 20 28 61 6e 64 20 28 72 1 1) => (and (r
45d0: 65 6c 31 20 30 20 31 29 20 28 72 65 6c 32 20 31 el1 0 1) (rel2 1
45e0: 20 31 29 29 29 0a 20 20 20 20 20 20 20 28 6d 79 1))). (my
45f0: 2d 63 68 65 63 6b 20 28 28 72 65 6c 31 2f 72 65 -check ((rel1/re
4600: 6c 32 3f 20 63 69 29 20 30 20 31 20 32 29 20 3d l2? ci) 0 1 2) =
4610: 3e 20 28 61 6e 64 20 28 72 65 6c 31 20 30 20 31 > (and (rel1 0 1
4620: 29 20 28 72 65 6c 32 20 31 20 32 29 29 29 0a 20 ) (rel2 1 2))).
4630: 20 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 (my-check
4640: 28 28 72 65 6c 31 2f 72 65 6c 32 3f 20 63 69 29 ((rel1/rel2? ci)
4650: 20 30 20 32 20 31 29 20 3d 3e 20 28 61 6e 64 20 0 2 1) => (and
4660: 28 72 65 6c 31 20 30 20 32 29 20 28 72 65 6c 32 (rel1 0 2) (rel2
4670: 20 32 20 31 29 29 29 0a 20 20 20 20 20 20 20 28 2 1))). (
4680: 6d 79 2d 63 68 65 63 6b 20 28 28 72 65 6c 31 2f my-check ((rel1/
4690: 72 65 6c 32 3f 20 63 69 29 20 31 20 32 20 30 29 rel2? ci) 1 2 0)
46a0: 20 3d 3e 20 28 61 6e 64 20 28 72 65 6c 31 20 31 => (and (rel1 1
46b0: 20 32 29 20 28 72 65 6c 32 20 32 20 30 29 29 29 2) (rel2 2 0)))
46c0: 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 63 . (my-chec
46d0: 6b 20 28 28 72 65 6c 31 2f 72 65 6c 32 3f 20 63 k ((rel1/rel2? c
46e0: 69 29 20 31 20 30 20 32 29 20 3d 3e 20 28 61 6e i) 1 0 2) => (an
46f0: 64 20 28 72 65 6c 31 20 31 20 30 29 20 28 72 65 d (rel1 1 0) (re
4700: 6c 32 20 30 20 32 29 29 29 0a 20 20 20 20 20 20 l2 0 2))).
4710: 20 28 6d 79 2d 63 68 65 63 6b 20 28 28 72 65 6c (my-check ((rel
4720: 31 2f 72 65 6c 32 3f 20 63 69 29 20 32 20 30 20 1/rel2? ci) 2 0
4730: 31 29 20 3d 3e 20 28 61 6e 64 20 28 72 65 6c 31 1) => (and (rel1
4740: 20 32 20 30 29 20 28 72 65 6c 32 20 30 20 31 29 2 0) (rel2 0 1)
4750: 29 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 )). (my-ch
4760: 65 63 6b 20 28 28 72 65 6c 31 2f 72 65 6c 32 3f eck ((rel1/rel2?
4770: 20 63 69 29 20 32 20 31 20 30 29 20 3d 3e 20 28 ci) 2 1 0) => (
4780: 61 6e 64 20 28 72 65 6c 31 20 32 20 31 29 20 28 and (rel1 2 1) (
4790: 72 65 6c 32 20 31 20 30 29 29 29 0a 0a 20 20 20 rel2 1 0)))..
47a0: 20 20 20 20 3b 20 61 73 20 61 20 63 6f 6d 62 69 ; as a combi
47b0: 6e 61 74 6f 72 20 75 73 69 6e 67 20 64 65 66 61 nator using defa
47c0: 75 6c 74 2d 63 6f 6d 70 61 72 65 0a 20 20 20 20 ult-compare.
47d0: 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 28 72 (my-check ((r
47e0: 65 6c 31 2f 72 65 6c 32 3f 29 20 30 20 30 20 30 el1/rel2?) 0 0 0
47f0: 29 20 3d 3e 20 28 61 6e 64 20 28 72 65 6c 31 20 ) => (and (rel1
4800: 30 20 30 29 20 28 72 65 6c 32 20 30 20 30 29 29 0 0) (rel2 0 0))
4810: 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 ). (my-che
4820: 63 6b 20 28 28 72 65 6c 31 2f 72 65 6c 32 3f 29 ck ((rel1/rel2?)
4830: 20 30 20 30 20 31 29 20 3d 3e 20 28 61 6e 64 20 0 0 1) => (and
4840: 28 72 65 6c 31 20 30 20 30 29 20 28 72 65 6c 32 (rel1 0 0) (rel2
4850: 20 30 20 31 29 29 29 0a 20 20 20 20 20 20 20 28 0 1))). (
4860: 6d 79 2d 63 68 65 63 6b 20 28 28 72 65 6c 31 2f my-check ((rel1/
4870: 72 65 6c 32 3f 29 20 30 20 31 20 30 29 20 3d 3e rel2?) 0 1 0) =>
4880: 20 28 61 6e 64 20 28 72 65 6c 31 20 30 20 31 29 (and (rel1 0 1)
4890: 20 28 72 65 6c 32 20 31 20 30 29 29 29 0a 20 20 (rel2 1 0))).
48a0: 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 (my-check (
48b0: 28 72 65 6c 31 2f 72 65 6c 32 3f 29 20 31 20 30 (rel1/rel2?) 1 0
48c0: 20 30 29 20 3d 3e 20 28 61 6e 64 20 28 72 65 6c 0) => (and (rel
48d0: 31 20 31 20 30 29 20 28 72 65 6c 32 20 30 20 30 1 1 0) (rel2 0 0
48e0: 29 29 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 ))). (my-c
48f0: 68 65 63 6b 20 28 28 72 65 6c 31 2f 72 65 6c 32 heck ((rel1/rel2
4900: 3f 29 20 31 20 31 20 30 29 20 3d 3e 20 28 61 6e ?) 1 1 0) => (an
4910: 64 20 28 72 65 6c 31 20 31 20 31 29 20 28 72 65 d (rel1 1 1) (re
4920: 6c 32 20 31 20 30 29 29 29 0a 20 20 20 20 20 20 l2 1 0))).
4930: 20 28 6d 79 2d 63 68 65 63 6b 20 28 28 72 65 6c (my-check ((rel
4940: 31 2f 72 65 6c 32 3f 29 20 31 20 30 20 31 29 20 1/rel2?) 1 0 1)
4950: 3d 3e 20 28 61 6e 64 20 28 72 65 6c 31 20 31 20 => (and (rel1 1
4960: 30 29 20 28 72 65 6c 32 20 30 20 31 29 29 29 0a 0) (rel2 0 1))).
4970: 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b (my-check
4980: 20 28 28 72 65 6c 31 2f 72 65 6c 32 3f 29 20 30 ((rel1/rel2?) 0
4990: 20 31 20 31 29 20 3d 3e 20 28 61 6e 64 20 28 72 1 1) => (and (r
49a0: 65 6c 31 20 30 20 31 29 20 28 72 65 6c 32 20 31 el1 0 1) (rel2 1
49b0: 20 31 29 29 29 0a 20 20 20 20 20 20 20 28 6d 79 1))). (my
49c0: 2d 63 68 65 63 6b 20 28 28 72 65 6c 31 2f 72 65 -check ((rel1/re
49d0: 6c 32 3f 29 20 30 20 31 20 32 29 20 3d 3e 20 28 l2?) 0 1 2) => (
49e0: 61 6e 64 20 28 72 65 6c 31 20 30 20 31 29 20 28 and (rel1 0 1) (
49f0: 72 65 6c 32 20 31 20 32 29 29 29 0a 20 20 20 20 rel2 1 2))).
4a00: 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 28 72 (my-check ((r
4a10: 65 6c 31 2f 72 65 6c 32 3f 29 20 30 20 32 20 31 el1/rel2?) 0 2 1
4a20: 29 20 3d 3e 20 28 61 6e 64 20 28 72 65 6c 31 20 ) => (and (rel1
4a30: 30 20 32 29 20 28 72 65 6c 32 20 32 20 31 29 29 0 2) (rel2 2 1))
4a40: 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 ). (my-che
4a50: 63 6b 20 28 28 72 65 6c 31 2f 72 65 6c 32 3f 29 ck ((rel1/rel2?)
4a60: 20 31 20 32 20 30 29 20 3d 3e 20 28 61 6e 64 20 1 2 0) => (and
4a70: 28 72 65 6c 31 20 31 20 32 29 20 28 72 65 6c 32 (rel1 1 2) (rel2
4a80: 20 32 20 30 29 29 29 0a 20 20 20 20 20 20 20 28 2 0))). (
4a90: 6d 79 2d 63 68 65 63 6b 20 28 28 72 65 6c 31 2f my-check ((rel1/
4aa0: 72 65 6c 32 3f 29 20 31 20 30 20 32 29 20 3d 3e rel2?) 1 0 2) =>
4ab0: 20 28 61 6e 64 20 28 72 65 6c 31 20 31 20 30 29 (and (rel1 1 0)
4ac0: 20 28 72 65 6c 32 20 30 20 32 29 29 29 0a 20 20 (rel2 0 2))).
4ad0: 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 (my-check (
4ae0: 28 72 65 6c 31 2f 72 65 6c 32 3f 29 20 32 20 30 (rel1/rel2?) 2 0
4af0: 20 31 29 20 3d 3e 20 28 61 6e 64 20 28 72 65 6c 1) => (and (rel
4b00: 31 20 32 20 30 29 20 28 72 65 6c 32 20 30 20 31 1 2 0) (rel2 0 1
4b10: 29 29 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 ))). (my-c
4b20: 68 65 63 6b 20 28 28 72 65 6c 31 2f 72 65 6c 32 heck ((rel1/rel2
4b30: 3f 29 20 32 20 31 20 30 29 20 3d 3e 20 28 61 6e ?) 2 1 0) => (an
4b40: 64 20 28 72 65 6c 31 20 32 20 31 29 20 28 72 65 d (rel1 2 1) (re
4b50: 6c 32 20 31 20 30 29 29 29 0a 20 20 20 20 20 20 l2 1 0))).
4b60: 20 0a 20 20 20 20 20 20 20 3b 20 74 65 73 74 20 . ; test
4b70: 69 66 20 61 6c 6c 20 61 72 67 75 6d 65 6e 74 73 if all arguments
4b80: 20 61 72 65 20 74 79 70 65 20 63 68 65 63 6b 65 are type checke
4b90: 64 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 d. (my-che
4ba0: 63 6b 20 28 61 72 67 75 6d 65 6e 74 73 2d 75 73 ck (arguments-us
4bb0: 65 64 20 28 72 65 6c 31 2f 72 65 6c 32 3f 20 63 ed (rel1/rel2? c
4bc0: 69 20 30 20 31 20 32 29 29 20 3d 3e 20 27 28 30 i 0 1 2)) => '(0
4bd0: 20 31 20 32 29 29 0a 20 20 20 20 20 20 20 28 6d 1 2)). (m
4be0: 79 2d 63 68 65 63 6b 20 28 61 72 67 75 6d 65 6e y-check (argumen
4bf0: 74 73 2d 75 73 65 64 20 28 72 65 6c 31 2f 72 65 ts-used (rel1/re
4c00: 6c 32 3f 20 63 69 20 30 20 32 20 31 29 29 20 3d l2? ci 0 2 1)) =
4c10: 3e 20 27 28 30 20 31 20 32 29 29 0a 20 20 20 20 > '(0 1 2)).
4c20: 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 61 72 (my-check (ar
4c30: 67 75 6d 65 6e 74 73 2d 75 73 65 64 20 28 72 65 guments-used (re
4c40: 6c 31 2f 72 65 6c 32 3f 20 63 69 20 31 20 32 20 l1/rel2? ci 1 2
4c50: 30 29 29 20 3d 3e 20 27 28 30 20 31 20 32 29 29 0)) => '(0 1 2))
4c60: 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 63 . (my-chec
4c70: 6b 20 28 61 72 67 75 6d 65 6e 74 73 2d 75 73 65 k (arguments-use
4c80: 64 20 28 72 65 6c 31 2f 72 65 6c 32 3f 20 63 69 d (rel1/rel2? ci
4c90: 20 31 20 30 20 32 29 29 20 3d 3e 20 27 28 30 20 1 0 2)) => '(0
4ca0: 31 20 32 29 29 0a 20 20 20 20 20 20 20 28 6d 79 1 2)). (my
4cb0: 2d 63 68 65 63 6b 20 28 61 72 67 75 6d 65 6e 74 -check (argument
4cc0: 73 2d 75 73 65 64 20 28 72 65 6c 31 2f 72 65 6c s-used (rel1/rel
4cd0: 32 3f 20 63 69 20 32 20 30 20 31 29 29 20 3d 3e 2? ci 2 0 1)) =>
4ce0: 20 27 28 30 20 31 20 32 29 29 0a 20 20 20 20 20 '(0 1 2)).
4cf0: 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 61 72 67 (my-check (arg
4d00: 75 6d 65 6e 74 73 2d 75 73 65 64 20 28 72 65 6c uments-used (rel
4d10: 31 2f 72 65 6c 32 3f 20 63 69 20 32 20 31 20 30 1/rel2? ci 2 1 0
4d20: 29 29 20 3d 3e 20 27 28 30 20 31 20 32 29 29 0a )) => '(0 1 2)).
4d30: 20 20 20 20 20 20 20 29 29 29 29 0a 0a 28 64 65 ))))..(de
4d40: 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d 79 2d 63 fine-syntax my-c
4d50: 68 65 63 6b 2d 63 68 61 69 6e 0a 20 20 28 73 79 heck-chain. (sy
4d60: 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 ntax-rules ().
4d70: 20 20 28 28 6d 79 2d 63 68 65 63 6b 2d 63 68 61 ((my-check-cha
4d80: 69 6e 20 63 68 61 69 6e 2d 72 65 6c 3f 20 72 65 in chain-rel? re
4d90: 6c 29 0a 20 20 20 20 20 28 62 65 67 69 6e 0a 20 l). (begin.
4da0: 20 20 20 20 20 20 3b 20 74 68 65 20 63 68 61 69 ; the chai
4db0: 6e 20 6f 66 20 6c 65 6e 67 74 68 20 30 0a 20 20 n of length 0.
4dc0: 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 (my-check (
4dd0: 63 68 61 69 6e 2d 72 65 6c 3f 20 63 69 29 20 3d chain-rel? ci) =
4de0: 3e 20 23 74 29 0a 20 20 20 20 20 20 20 0a 20 20 > #t). .
4df0: 20 20 20 20 20 3b 20 61 20 63 68 61 69 6e 20 6f ; a chain o
4e00: 66 20 6c 65 6e 67 74 68 20 31 0a 20 20 20 20 20 f length 1.
4e10: 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 63 68 61 (my-check (cha
4e20: 69 6e 2d 72 65 6c 3f 20 63 69 20 30 29 20 3d 3e in-rel? ci 0) =>
4e30: 20 23 74 29 0a 20 20 20 20 20 20 20 0a 20 20 20 #t). .
4e40: 20 20 20 20 3b 20 61 6c 6c 20 63 68 61 69 6e 73 ; all chains
4e50: 20 6f 66 20 6c 65 6e 67 74 68 20 32 0a 20 20 20 of length 2.
4e60: 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 63 (my-check (c
4e70: 68 61 69 6e 2d 72 65 6c 3f 20 63 69 20 30 20 30 hain-rel? ci 0 0
4e80: 29 20 3d 3e 20 28 72 65 6c 20 30 20 30 29 29 0a ) => (rel 0 0)).
4e90: 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b (my-check
4ea0: 20 28 63 68 61 69 6e 2d 72 65 6c 3f 20 63 69 20 (chain-rel? ci
4eb0: 30 20 31 29 20 3d 3e 20 28 72 65 6c 20 30 20 31 0 1) => (rel 0 1
4ec0: 29 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 )). (my-ch
4ed0: 65 63 6b 20 28 63 68 61 69 6e 2d 72 65 6c 3f 20 eck (chain-rel?
4ee0: 63 69 20 31 20 30 29 20 3d 3e 20 28 72 65 6c 20 ci 1 0) => (rel
4ef0: 31 20 30 29 29 0a 20 20 20 20 20 20 20 0a 20 20 1 0)). .
4f00: 20 20 20 20 20 3b 20 61 6c 6c 20 63 68 61 69 6e ; all chain
4f10: 73 20 6f 66 20 6c 65 6e 67 74 68 20 33 0a 20 20 s of length 3.
4f20: 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 (my-check (
4f30: 63 68 61 69 6e 2d 72 65 6c 3f 20 63 69 20 30 20 chain-rel? ci 0
4f40: 30 20 30 29 20 3d 3e 20 28 72 65 6c 20 30 20 30 0 0) => (rel 0 0
4f50: 20 30 29 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 0)). (my-
4f60: 63 68 65 63 6b 20 28 63 68 61 69 6e 2d 72 65 6c check (chain-rel
4f70: 3f 20 63 69 20 30 20 30 20 31 29 20 3d 3e 20 28 ? ci 0 0 1) => (
4f80: 72 65 6c 20 30 20 30 20 31 29 29 0a 20 20 20 20 rel 0 0 1)).
4f90: 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 63 68 (my-check (ch
4fa0: 61 69 6e 2d 72 65 6c 3f 20 63 69 20 30 20 31 20 ain-rel? ci 0 1
4fb0: 30 29 20 3d 3e 20 28 72 65 6c 20 30 20 31 20 30 0) => (rel 0 1 0
4fc0: 29 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 )). (my-ch
4fd0: 65 63 6b 20 28 63 68 61 69 6e 2d 72 65 6c 3f 20 eck (chain-rel?
4fe0: 63 69 20 31 20 30 20 30 29 20 3d 3e 20 28 72 65 ci 1 0 0) => (re
4ff0: 6c 20 31 20 30 20 30 29 29 0a 20 20 20 20 20 20 l 1 0 0)).
5000: 20 28 6d 79 2d 63 68 65 63 6b 20 28 63 68 61 69 (my-check (chai
5010: 6e 2d 72 65 6c 3f 20 63 69 20 31 20 31 20 30 29 n-rel? ci 1 1 0)
5020: 20 3d 3e 20 28 72 65 6c 20 31 20 31 20 30 29 29 => (rel 1 1 0))
5030: 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 63 . (my-chec
5040: 6b 20 28 63 68 61 69 6e 2d 72 65 6c 3f 20 63 69 k (chain-rel? ci
5050: 20 31 20 30 20 31 29 20 3d 3e 20 28 72 65 6c 20 1 0 1) => (rel
5060: 31 20 30 20 31 29 29 0a 20 20 20 20 20 20 20 28 1 0 1)). (
5070: 6d 79 2d 63 68 65 63 6b 20 28 63 68 61 69 6e 2d my-check (chain-
5080: 72 65 6c 3f 20 63 69 20 30 20 31 20 31 29 20 3d rel? ci 0 1 1) =
5090: 3e 20 28 72 65 6c 20 30 20 31 20 31 29 29 0a 20 > (rel 0 1 1)).
50a0: 20 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 (my-check
50b0: 28 63 68 61 69 6e 2d 72 65 6c 3f 20 63 69 20 30 (chain-rel? ci 0
50c0: 20 31 20 32 29 20 3d 3e 20 28 72 65 6c 20 30 20 1 2) => (rel 0
50d0: 31 20 32 29 29 0a 20 20 20 20 20 20 20 28 6d 79 1 2)). (my
50e0: 2d 63 68 65 63 6b 20 28 63 68 61 69 6e 2d 72 65 -check (chain-re
50f0: 6c 3f 20 63 69 20 30 20 32 20 31 29 20 3d 3e 20 l? ci 0 2 1) =>
5100: 28 72 65 6c 20 30 20 32 20 31 29 29 0a 20 20 20 (rel 0 2 1)).
5110: 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 63 (my-check (c
5120: 68 61 69 6e 2d 72 65 6c 3f 20 63 69 20 31 20 32 hain-rel? ci 1 2
5130: 20 30 29 20 3d 3e 20 28 72 65 6c 20 31 20 32 20 0) => (rel 1 2
5140: 30 29 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 0)). (my-c
5150: 68 65 63 6b 20 28 63 68 61 69 6e 2d 72 65 6c 3f heck (chain-rel?
5160: 20 63 69 20 31 20 30 20 32 29 20 3d 3e 20 28 72 ci 1 0 2) => (r
5170: 65 6c 20 31 20 30 20 32 29 29 0a 20 20 20 20 20 el 1 0 2)).
5180: 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 63 68 61 (my-check (cha
5190: 69 6e 2d 72 65 6c 3f 20 63 69 20 32 20 30 20 31 in-rel? ci 2 0 1
51a0: 29 20 3d 3e 20 28 72 65 6c 20 32 20 30 20 31 29 ) => (rel 2 0 1)
51b0: 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 ). (my-che
51c0: 63 6b 20 28 63 68 61 69 6e 2d 72 65 6c 3f 20 63 ck (chain-rel? c
51d0: 69 20 32 20 31 20 30 29 20 3d 3e 20 28 72 65 6c i 2 1 0) => (rel
51e0: 20 32 20 31 20 30 29 29 0a 20 20 20 20 20 20 20 2 1 0)).
51f0: 0a 20 20 20 20 20 20 20 3b 20 63 68 65 63 6b 20 . ; check
5200: 69 66 20 61 6c 6c 20 61 72 67 75 6d 65 6e 74 73 if all arguments
5210: 20 61 72 65 20 75 73 65 64 0a 20 20 20 20 20 20 are used.
5220: 20 28 6d 79 2d 63 68 65 63 6b 20 28 61 72 67 75 (my-check (argu
5230: 6d 65 6e 74 73 2d 75 73 65 64 20 28 63 68 61 69 ments-used (chai
5240: 6e 2d 72 65 6c 3f 20 63 69 20 30 29 29 20 3d 3e n-rel? ci 0)) =>
5250: 20 27 28 30 29 29 0a 20 20 20 20 20 20 20 28 6d '(0)). (m
5260: 79 2d 63 68 65 63 6b 20 28 61 72 67 75 6d 65 6e y-check (argumen
5270: 74 73 2d 75 73 65 64 20 28 63 68 61 69 6e 2d 72 ts-used (chain-r
5280: 65 6c 3f 20 63 69 20 30 20 31 29 29 20 3d 3e 20 el? ci 0 1)) =>
5290: 27 28 30 20 31 29 29 0a 20 20 20 20 20 20 20 28 '(0 1)). (
52a0: 6d 79 2d 63 68 65 63 6b 20 28 61 72 67 75 6d 65 my-check (argume
52b0: 6e 74 73 2d 75 73 65 64 20 28 63 68 61 69 6e 2d nts-used (chain-
52c0: 72 65 6c 3f 20 63 69 20 31 20 30 29 29 20 3d 3e rel? ci 1 0)) =>
52d0: 20 27 28 30 20 31 29 29 0a 20 20 20 20 20 20 20 '(0 1)).
52e0: 28 6d 79 2d 63 68 65 63 6b 20 28 61 72 67 75 6d (my-check (argum
52f0: 65 6e 74 73 2d 75 73 65 64 20 28 63 68 61 69 6e ents-used (chain
5300: 2d 72 65 6c 3f 20 63 69 20 30 20 31 20 32 29 29 -rel? ci 0 1 2))
5310: 20 3d 3e 20 27 28 30 20 31 20 32 29 29 0a 20 20 => '(0 1 2)).
5320: 20 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 (my-check (
5330: 61 72 67 75 6d 65 6e 74 73 2d 75 73 65 64 20 28 arguments-used (
5340: 63 68 61 69 6e 2d 72 65 6c 3f 20 63 69 20 30 20 chain-rel? ci 0
5350: 32 20 31 29 29 20 3d 3e 20 27 28 30 20 31 20 32 2 1)) => '(0 1 2
5360: 29 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 )). (my-ch
5370: 65 63 6b 20 28 61 72 67 75 6d 65 6e 74 73 2d 75 eck (arguments-u
5380: 73 65 64 20 28 63 68 61 69 6e 2d 72 65 6c 3f 20 sed (chain-rel?
5390: 63 69 20 31 20 32 20 30 29 29 20 3d 3e 20 27 28 ci 1 2 0)) => '(
53a0: 30 20 31 20 32 29 29 0a 20 20 20 20 20 20 20 28 0 1 2)). (
53b0: 6d 79 2d 63 68 65 63 6b 20 28 61 72 67 75 6d 65 my-check (argume
53c0: 6e 74 73 2d 75 73 65 64 20 28 63 68 61 69 6e 2d nts-used (chain-
53d0: 72 65 6c 3f 20 63 69 20 31 20 30 20 32 29 29 20 rel? ci 1 0 2))
53e0: 3d 3e 20 27 28 30 20 31 20 32 29 29 0a 20 20 20 => '(0 1 2)).
53f0: 20 20 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 61 (my-check (a
5400: 72 67 75 6d 65 6e 74 73 2d 75 73 65 64 20 28 63 rguments-used (c
5410: 68 61 69 6e 2d 72 65 6c 3f 20 63 69 20 32 20 30 hain-rel? ci 2 0
5420: 20 31 29 29 20 3d 3e 20 27 28 30 20 31 20 32 29 1)) => '(0 1 2)
5430: 29 0a 20 20 20 20 20 20 20 28 6d 79 2d 63 68 65 ). (my-che
5440: 63 6b 20 28 61 72 67 75 6d 65 6e 74 73 2d 75 73 ck (arguments-us
5450: 65 64 20 28 63 68 61 69 6e 2d 72 65 6c 3f 20 63 ed (chain-rel? c
5460: 69 20 32 20 31 20 30 29 29 20 3d 3e 20 27 28 30 i 2 1 0)) => '(0
5470: 20 31 20 32 29 29 0a 20 20 20 20 20 20 20 29 29 1 2)). ))
5480: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 68 65 ))..(define (che
5490: 63 6b 3a 70 72 65 64 69 63 61 74 65 73 2d 66 72 ck:predicates-fr
54a0: 6f 6d 2d 63 6f 6d 70 61 72 65 29 0a 20 20 0a 20 om-compare). .
54b0: 20 28 6d 79 2d 63 68 65 63 6b 2d 63 68 61 69 6e (my-check-chain
54c0: 32 20 3d 3f 20 20 20 20 3d 29 0a 20 20 28 6d 79 2 =? =). (my
54d0: 2d 63 68 65 63 6b 2d 63 68 61 69 6e 32 20 3c 3f -check-chain2 <?
54e0: 20 20 20 20 3c 29 0a 20 20 28 6d 79 2d 63 68 65 <). (my-che
54f0: 63 6b 2d 63 68 61 69 6e 32 20 3e 3f 20 20 20 20 ck-chain2 >?
5500: 3e 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 >). (my-check-c
5510: 68 61 69 6e 32 20 3c 3d 3f 20 20 20 3c 3d 29 0a hain2 <=? <=).
5520: 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 68 61 69 (my-check-chai
5530: 6e 32 20 3e 3d 3f 20 20 20 3e 3d 29 0a 20 20 28 n2 >=? >=). (
5540: 6d 79 2d 63 68 65 63 6b 2d 63 68 61 69 6e 32 20 my-check-chain2
5550: 6e 6f 74 3d 3f 20 28 6c 61 6d 62 64 61 20 28 78 not=? (lambda (x
5560: 20 79 29 20 28 6e 6f 74 20 28 3d 20 78 20 79 29 y) (not (= x y)
5570: 29 29 29 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 ))). . (my-che
5580: 63 6b 2d 63 68 61 69 6e 33 20 3c 2f 3c 3f 20 20 ck-chain3 </<?
5590: 20 3c 20 20 3c 29 0a 20 20 28 6d 79 2d 63 68 65 < <). (my-che
55a0: 63 6b 2d 63 68 61 69 6e 33 20 3c 2f 3c 3d 3f 20 ck-chain3 </<=?
55b0: 20 3c 20 20 3c 3d 29 0a 20 20 28 6d 79 2d 63 68 < <=). (my-ch
55c0: 65 63 6b 2d 63 68 61 69 6e 33 20 3c 3d 2f 3c 3f eck-chain3 <=/<?
55d0: 20 20 3c 3d 20 3c 29 0a 20 20 28 6d 79 2d 63 68 <= <). (my-ch
55e0: 65 63 6b 2d 63 68 61 69 6e 33 20 3c 3d 2f 3c 3d eck-chain3 <=/<=
55f0: 3f 20 3c 3d 20 3c 3d 29 0a 20 20 0a 20 20 28 6d ? <= <=). . (m
5600: 79 2d 63 68 65 63 6b 2d 63 68 61 69 6e 33 20 3e y-check-chain3 >
5610: 2f 3e 3f 20 20 20 3e 20 20 3e 29 0a 20 20 28 6d />? > >). (m
5620: 79 2d 63 68 65 63 6b 2d 63 68 61 69 6e 33 20 3e y-check-chain3 >
5630: 2f 3e 3d 3f 20 20 3e 20 20 3e 3d 29 0a 20 20 28 />=? > >=). (
5640: 6d 79 2d 63 68 65 63 6b 2d 63 68 61 69 6e 33 20 my-check-chain3
5650: 3e 3d 2f 3e 3f 20 20 3e 3d 20 3e 29 0a 20 20 28 >=/>? >= >). (
5660: 6d 79 2d 63 68 65 63 6b 2d 63 68 61 69 6e 33 20 my-check-chain3
5670: 3e 3d 2f 3e 3d 3f 20 3e 3d 20 3e 3d 29 0a 20 20 >=/>=? >= >=).
5680: 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 68 61 . (my-check-cha
5690: 69 6e 20 63 68 61 69 6e 3d 3f 20 20 3d 29 0a 20 in chain=? =).
56a0: 20 28 6d 79 2d 63 68 65 63 6b 2d 63 68 61 69 6e (my-check-chain
56b0: 20 63 68 61 69 6e 3c 3f 20 20 3c 29 0a 20 20 28 chain<? <). (
56c0: 6d 79 2d 63 68 65 63 6b 2d 63 68 61 69 6e 20 63 my-check-chain c
56d0: 68 61 69 6e 3e 3f 20 20 3e 29 0a 20 20 28 6d 79 hain>? >). (my
56e0: 2d 63 68 65 63 6b 2d 63 68 61 69 6e 20 63 68 61 -check-chain cha
56f0: 69 6e 3c 3d 3f 20 3c 3d 29 0a 20 20 28 6d 79 2d in<=? <=). (my-
5700: 63 68 65 63 6b 2d 63 68 61 69 6e 20 63 68 61 69 check-chain chai
5710: 6e 3e 3d 3f 20 3e 3d 29 0a 20 20 0a 20 20 29 20 n>=? >=). . )
5720: 3b 20 63 68 65 63 6b 3a 70 72 65 64 69 63 61 74 ; check:predicat
5730: 65 73 2d 66 72 6f 6d 2d 63 6f 6d 70 61 72 65 0a es-from-compare.
5740: 0a 3b 20 70 61 69 72 77 69 73 65 2d 6e 6f 74 3d .; pairwise-not=
5750: 3f 0a 0a 28 64 65 66 69 6e 65 20 70 61 69 72 77 ?..(define pairw
5760: 69 73 65 2d 6e 6f 74 3d 3f 3a 6c 6f 6e 67 2d 73 ise-not=?:long-s
5770: 65 71 75 65 6e 63 65 73 0a 20 20 28 6c 65 74 20 equences. (let
5780: 28 29 0a 20 20 20 20 0a 20 20 20 20 28 64 65 66 (). . (def
5790: 69 6e 65 20 28 65 78 74 72 65 6d 61 6c 2d 70 69 ine (extremal-pi
57a0: 76 6f 74 2d 73 65 71 75 65 6e 63 65 20 72 29 0a vot-sequence r).
57b0: 20 20 20 20 20 20 3b 20 54 68 65 20 65 78 74 72 ; The extr
57c0: 65 6d 61 6c 20 70 69 76 6f 74 20 73 65 71 75 65 emal pivot seque
57d0: 6e 63 65 20 6f 66 20 6f 72 64 65 72 20 72 20 69 nce of order r i
57e0: 73 20 61 20 0a 20 20 20 20 20 20 3b 20 70 65 72 s a . ; per
57f0: 6d 75 74 61 74 69 6f 6e 20 6f 66 20 7b 30 2e 2e mutation of {0..
5800: 32 5e 28 72 2b 31 29 2d 32 7d 20 73 75 63 68 20 2^(r+1)-2} such
5810: 74 68 61 74 20 74 68 65 0a 20 20 20 20 20 20 3b that the. ;
5820: 20 6d 69 64 64 6c 65 20 65 6c 65 6d 65 6e 74 20 middle element
5830: 69 73 20 6d 69 6e 69 6d 61 6c 2c 20 61 6e 64 20 is minimal, and
5840: 74 68 69 73 20 70 72 6f 70 65 72 74 79 0a 20 20 this property.
5850: 20 20 20 20 3b 20 68 6f 6c 64 73 20 72 65 63 75 ; holds recu
5860: 72 73 69 76 65 6c 79 20 66 6f 72 20 65 61 63 68 rsively for each
5870: 20 62 69 6e 61 72 79 20 73 75 62 64 69 76 69 73 binary subdivis
5880: 69 6f 6e 2e 0a 20 20 20 20 20 20 3b 20 20 20 54 ion.. ; T
5890: 68 69 73 20 73 65 71 75 65 6e 63 65 20 65 78 70 his sequence exp
58a0: 6f 73 65 73 20 61 20 6e 61 69 76 65 20 69 6d 70 oses a naive imp
58b0: 6c 65 6d 65 6e 74 61 74 69 6f 6e 20 6f 66 0a 20 lementation of.
58c0: 20 20 20 20 20 3b 20 70 61 69 72 77 69 73 65 2d ; pairwise-
58d0: 6e 6f 74 3d 3f 20 63 68 6f 73 69 6e 67 20 74 68 not=? chosing th
58e0: 65 20 6d 69 64 64 6c 65 20 65 6c 65 6d 65 6e 74 e middle element
58f0: 20 61 73 20 70 69 76 6f 74 2e 0a 20 20 20 20 20 as pivot..
5900: 20 28 69 66 20 28 7a 65 72 6f 3f 20 72 29 0a 20 (if (zero? r).
5910: 20 20 20 20 20 20 20 20 20 27 28 30 29 0a 20 20 '(0).
5920: 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 (let* ((
5930: 73 20 28 65 78 74 72 65 6d 61 6c 2d 70 69 76 6f s (extremal-pivo
5940: 74 2d 73 65 71 75 65 6e 63 65 20 28 2d 20 72 20 t-sequence (- r
5950: 31 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 1))).
5960: 20 20 20 20 20 20 28 6e 73 20 28 6c 65 6e 67 74 (ns (lengt
5970: 68 20 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 h s))).
5980: 20 20 20 28 61 70 70 65 6e 64 20 28 6c 69 73 74 (append (list
5990: 2d 65 63 20 28 3a 6c 69 73 74 20 78 20 73 29 20 -ec (:list x s)
59a0: 28 2b 20 78 20 31 29 29 0a 20 20 20 20 20 20 20 (+ x 1)).
59b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 27 28 30 '(0
59c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
59d0: 20 20 20 20 20 20 28 6c 69 73 74 2d 65 63 20 28 (list-ec (
59e0: 3a 6c 69 73 74 20 78 20 73 29 20 28 2b 20 78 20 :list x s) (+ x
59f0: 6e 73 20 31 29 29 29 29 29 29 0a 20 20 20 20 0a ns 1)))))). .
5a00: 20 20 20 20 28 6c 69 73 74 20 28 6c 69 73 74 2d (list (list-
5a10: 65 63 20 28 3a 20 69 20 34 30 39 36 29 20 69 29 ec (: i 4096) i)
5a20: 0a 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 . (list
5a30: 2d 65 63 20 28 3a 20 69 20 34 30 39 37 20 30 20 -ec (: i 4097 0
5a40: 2d 31 29 20 69 29 0a 20 20 20 20 20 20 20 20 20 -1) i).
5a50: 20 28 6c 69 73 74 2d 65 63 20 28 3a 20 69 20 34 (list-ec (: i 4
5a60: 30 39 39 29 20 28 6d 6f 64 75 6c 6f 20 28 2a 20 099) (modulo (*
5a70: 31 30 30 33 20 69 29 20 34 30 39 39 29 29 0a 20 1003 i) 4099)).
5a80: 20 20 20 20 20 20 20 20 20 28 65 78 74 72 65 6d (extrem
5a90: 61 6c 2d 70 69 76 6f 74 2d 73 65 71 75 65 6e 63 al-pivot-sequenc
5aa0: 65 20 31 31 29 29 29 29 0a 0a 28 64 65 66 69 6e e 11))))..(defin
5ab0: 65 20 70 61 69 72 77 69 73 65 2d 6e 6f 74 3d 3f e pairwise-not=?
5ac0: 3a 73 68 6f 72 74 2d 73 65 71 75 65 6e 63 65 73 :short-sequences
5ad0: 0a 20 20 28 6c 65 74 20 28 29 0a 20 20 20 20 0a . (let (). .
5ae0: 20 20 20 20 28 64 65 66 69 6e 65 20 28 63 6f 6d (define (com
5af0: 62 69 6e 61 74 69 6f 6e 73 2f 72 65 70 65 61 74 binations/repeat
5b00: 73 20 6e 20 6c 29 0a 20 20 20 20 20 20 3b 20 72 s n l). ; r
5b10: 65 74 75 72 6e 20 6c 69 73 74 20 6f 66 20 61 6c eturn list of al
5b20: 6c 20 73 75 62 6c 69 73 74 73 20 6f 66 20 6c 20 l sublists of l
5b30: 6f 66 20 73 69 7a 65 20 6e 2c 0a 20 20 20 20 20 of size n,.
5b40: 20 3b 20 74 68 65 20 6f 72 64 65 72 20 6f 66 20 ; the order of
5b50: 74 68 65 20 65 6c 65 6d 65 6e 74 73 20 6f 63 63 the elements occ
5b60: 75 72 20 69 6e 20 74 68 65 20 73 75 62 6c 69 73 ur in the sublis
5b70: 74 73 20 0a 20 20 20 20 20 20 3b 20 6f 66 20 74 ts . ; of t
5b80: 68 65 20 6f 75 74 70 75 74 20 69 73 20 74 68 65 he output is the
5b90: 20 73 61 6d 65 20 61 73 20 69 6e 20 74 68 65 20 same as in the
5ba0: 69 6e 70 75 74 0a 20 20 20 20 20 20 28 6c 65 74 input. (let
5bb0: 20 28 28 6c 65 6e 20 28 6c 65 6e 67 74 68 20 6c ((len (length l
5bc0: 29 29 29 0a 20 20 20 20 20 20 20 20 28 63 6f 6e ))). (con
5bd0: 64 0a 20 20 20 20 20 20 20 20 20 20 28 28 3d 20 d. ((=
5be0: 6e 20 30 29 20 20 20 27 28 29 29 0a 20 20 20 20 n 0) '()).
5bf0: 20 20 20 20 20 20 28 28 3d 20 6e 20 31 29 20 20 ((= n 1)
5c00: 20 28 6d 61 70 20 6c 69 73 74 20 6c 29 29 0a 20 (map list l)).
5c10: 20 20 20 20 20 20 20 20 20 28 28 3d 20 6c 65 6e ((= len
5c20: 20 31 29 20 28 64 6f 20 28 28 72 20 27 28 29 20 1) (do ((r '()
5c30: 28 63 6f 6e 73 20 28 63 61 72 20 6c 29 20 72 29 (cons (car l) r)
5c40: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5c50: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 20 6e (i n
5c60: 20 28 2d 20 69 20 31 29 29 29 0a 20 20 20 20 20 (- i 1))).
5c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c80: 20 20 28 28 3d 20 69 20 30 29 20 28 6c 69 73 74 ((= i 0) (list
5c90: 20 72 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 r)))).
5ca0: 20 28 65 6c 73 65 20 20 20 20 20 20 28 61 70 70 (else (app
5cb0: 65 6e 64 20 28 63 6f 6d 62 69 6e 61 74 69 6f 6e end (combination
5cc0: 73 2f 72 65 70 65 61 74 73 20 6e 20 28 63 64 72 s/repeats n (cdr
5cd0: 20 6c 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 l)).
5ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5cf0: 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 (map (lambda (
5d00: 63 29 20 28 63 6f 6e 73 20 28 63 61 72 20 6c 29 c) (cons (car l)
5d10: 20 63 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 c)).
5d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d30: 20 20 20 20 20 20 20 28 63 6f 6d 62 69 6e 61 74 (combinat
5d40: 69 6f 6e 73 2f 72 65 70 65 61 74 73 20 28 2d 20 ions/repeats (-
5d50: 6e 20 31 29 20 6c 29 29 29 29 29 29 29 0a 20 20 n 1) l))))))).
5d60: 20 20 0a 20 20 20 20 28 64 65 66 69 6e 65 20 28 . (define (
5d70: 70 65 72 6d 75 74 61 74 69 6f 6e 73 20 6c 29 0a permutations l).
5d80: 20 20 20 20 20 20 3b 20 72 65 74 75 72 6e 20 61 ; return a
5d90: 20 6c 69 73 74 20 6f 66 20 61 6c 6c 20 70 65 72 list of all per
5da0: 6d 75 74 61 74 69 6f 6e 73 20 6f 66 20 6c 0a 20 mutations of l.
5db0: 20 20 20 20 20 28 6c 65 74 20 28 28 6c 65 6e 20 (let ((len
5dc0: 28 6c 65 6e 67 74 68 20 6c 29 29 29 0a 20 20 20 (length l))).
5dd0: 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 (cond.
5de0: 20 20 20 20 20 28 28 3d 20 6c 65 6e 20 30 29 20 ((= len 0)
5df0: 27 28 28 29 29 29 0a 20 20 20 20 20 20 20 20 20 '(())).
5e00: 20 28 28 3d 20 6c 65 6e 20 31 29 20 28 6c 69 73 ((= len 1) (lis
5e10: 74 20 6c 29 29 0a 20 20 20 20 20 20 20 20 20 20 t l)).
5e20: 28 65 6c 73 65 20 20 20 20 20 20 28 61 70 70 6c (else (appl
5e30: 79 20 61 70 70 65 6e 64 0a 20 20 20 20 20 20 20 y append.
5e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e50: 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 (map (lambd
5e60: 61 20 28 70 29 20 28 69 6e 73 65 72 74 2d 65 76 a (p) (insert-ev
5e70: 65 72 79 2d 77 68 65 72 65 20 28 63 61 72 20 6c ery-where (car l
5e80: 29 20 70 29 29 0a 20 20 20 20 20 20 20 20 20 20 ) p)).
5e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ea0: 20 20 20 20 20 20 20 28 70 65 72 6d 75 74 61 74 (permutat
5eb0: 69 6f 6e 73 20 28 63 64 72 20 6c 29 29 29 29 29 ions (cdr l)))))
5ec0: 29 29 29 20 20 20 20 20 20 0a 20 20 20 20 0a 20 ))) . .
5ed0: 20 20 20 28 64 65 66 69 6e 65 20 28 69 6e 73 65 (define (inse
5ee0: 72 74 2d 65 76 65 72 79 2d 77 68 65 72 65 20 78 rt-every-where x
5ef0: 20 78 73 29 0a 20 20 20 20 20 20 28 6c 65 74 20 xs). (let
5f00: 6c 6f 6f 70 20 28 28 72 65 73 75 6c 74 20 27 28 loop ((result '(
5f10: 29 29 20 28 62 65 66 6f 72 65 20 27 28 29 29 20 )) (before '())
5f20: 28 61 66 74 65 72 20 20 78 73 29 29 0a 20 20 20 (after xs)).
5f30: 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 20 (let ((new
5f40: 28 61 70 70 65 6e 64 20 62 65 66 6f 72 65 20 28 (append before (
5f50: 63 6f 6e 73 20 78 20 61 66 74 65 72 29 29 29 29 cons x after))))
5f60: 0a 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 . (cond
5f70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6e . ((n
5f80: 75 6c 6c 3f 20 61 66 74 65 72 29 20 28 63 6f 6e ull? after) (con
5f90: 73 20 6e 65 77 20 72 65 73 75 6c 74 29 29 0a 20 s new result)).
5fa0: 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 (else
5fb0: 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 (loop
5fc0: 28 63 6f 6e 73 20 6e 65 77 20 72 65 73 75 6c 74 (cons new result
5fd0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ff0: 20 20 20 28 61 70 70 65 6e 64 20 62 65 66 6f 72 (append befor
6000: 65 20 28 6c 69 73 74 20 28 63 61 72 20 61 66 74 e (list (car aft
6010: 65 72 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 er))).
6020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6030: 20 20 20 20 20 20 20 28 63 64 72 20 61 66 74 65 (cdr afte
6040: 72 29 29 29 29 29 29 29 20 0a 20 20 20 20 0a 20 r))))))) . .
6050: 20 20 20 28 64 65 66 69 6e 65 20 28 73 65 71 75 (define (sequ
6060: 65 6e 63 65 73 20 6e 20 6d 61 78 29 0a 20 20 20 ences n max).
6070: 20 20 20 28 61 70 70 6c 79 20 61 70 70 65 6e 64 (apply append
6080: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d . (m
6090: 61 70 20 70 65 72 6d 75 74 61 74 69 6f 6e 73 0a ap permutations.
60a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
60b0: 20 20 28 63 6f 6d 62 69 6e 61 74 69 6f 6e 73 2f (combinations/
60c0: 72 65 70 65 61 74 73 20 6e 20 28 6c 69 73 74 2d repeats n (list-
60d0: 65 63 20 28 3a 20 69 20 6d 61 78 29 20 69 29 29 ec (: i max) i))
60e0: 29 29 29 0a 20 20 20 20 0a 20 20 20 20 28 61 70 ))). . (ap
60f0: 70 65 6e 64 2d 65 63 20 28 3a 20 6e 20 35 29 20 pend-ec (: n 5)
6100: 28 73 65 71 75 65 6e 63 65 73 20 6e 20 35 29 29 (sequences n 5))
6110: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6c ))..(define (col
6120: 6c 69 64 69 6e 67 2d 63 6f 6d 70 61 72 65 20 78 liding-compare x
6130: 20 79 29 0a 20 20 28 63 69 20 28 6d 6f 64 75 6c y). (ci (modul
6140: 6f 20 78 20 33 29 20 28 6d 6f 64 75 6c 6f 20 79 o x 3) (modulo y
6150: 20 33 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 3)))..(define (
6160: 6e 61 69 76 65 2d 70 61 69 72 77 69 73 65 2d 6e naive-pairwise-n
6170: 6f 74 3d 3f 20 63 6f 6d 70 61 72 65 20 2e 20 78 ot=? compare . x
6180: 73 29 0a 20 20 28 6c 65 74 20 28 28 78 73 20 28 s). (let ((xs (
6190: 6c 69 73 74 2d 3e 76 65 63 74 6f 72 20 78 73 29 list->vector xs)
61a0: 29 29 0a 20 20 20 20 28 65 76 65 72 79 3f 2d 65 )). (every?-e
61b0: 63 20 28 3a 72 61 6e 67 65 20 69 20 28 2d 20 28 c (:range i (- (
61c0: 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 78 73 vector-length xs
61d0: 29 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 20 ) 1)).
61e0: 20 20 20 20 20 28 3a 6c 65 74 20 78 73 2d 69 20 (:let xs-i
61f0: 28 76 65 63 74 6f 72 2d 72 65 66 20 78 73 20 69 (vector-ref xs i
6200: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
6210: 20 20 28 3a 72 61 6e 67 65 20 6a 20 28 2b 20 69 (:range j (+ i
6220: 20 31 29 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 1) (vector-leng
6230: 74 68 20 78 73 29 29 0a 20 20 20 20 20 20 20 20 th xs)).
6240: 20 20 20 20 20 20 20 28 3a 6c 65 74 20 78 73 2d (:let xs-
6250: 6a 20 28 76 65 63 74 6f 72 2d 72 65 66 20 78 73 j (vector-ref xs
6260: 20 6a 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 j)).
6270: 20 20 20 20 28 6e 6f 74 3d 3f 20 63 6f 6d 70 61 (not=? compa
6280: 72 65 20 78 73 2d 69 20 78 73 2d 6a 29 29 29 29 re xs-i xs-j))))
6290: 0a 0a 28 64 65 66 69 6e 65 20 28 63 68 65 63 6b ..(define (check
62a0: 3a 70 61 69 72 77 69 73 65 2d 6e 6f 74 3d 3f 29 :pairwise-not=?)
62b0: 0a 20 20 0a 20 20 3b 20 30 2d 61 72 79 2c 20 31 . . ; 0-ary, 1
62c0: 2d 61 72 79 0a 20 20 28 6d 79 2d 63 68 65 63 6b -ary. (my-check
62d0: 20 28 70 61 69 72 77 69 73 65 2d 6e 6f 74 3d 3f (pairwise-not=?
62e0: 20 63 69 29 20 20 20 3d 3e 20 23 74 29 0a 20 20 ci) => #t).
62f0: 28 6d 79 2d 63 68 65 63 6b 20 28 70 61 69 72 77 (my-check (pairw
6300: 69 73 65 2d 6e 6f 74 3d 3f 20 63 69 20 30 29 20 ise-not=? ci 0)
6310: 3d 3e 20 23 74 29 0a 20 20 0a 20 20 3b 20 32 2d => #t). . ; 2-
6320: 61 72 79 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 ary. (my-check
6330: 28 70 61 69 72 77 69 73 65 2d 6e 6f 74 3d 3f 20 (pairwise-not=?
6340: 63 69 20 30 20 30 29 20 3d 3e 20 23 66 29 0a 20 ci 0 0) => #f).
6350: 20 28 6d 79 2d 63 68 65 63 6b 20 28 70 61 69 72 (my-check (pair
6360: 77 69 73 65 2d 6e 6f 74 3d 3f 20 63 69 20 30 20 wise-not=? ci 0
6370: 31 29 20 3d 3e 20 23 74 29 0a 20 20 28 6d 79 2d 1) => #t). (my-
6380: 63 68 65 63 6b 20 28 70 61 69 72 77 69 73 65 2d check (pairwise-
6390: 6e 6f 74 3d 3f 20 63 69 20 31 20 30 29 20 3d 3e not=? ci 1 0) =>
63a0: 20 23 74 29 0a 20 20 0a 20 20 3b 20 33 2d 61 72 #t). . ; 3-ar
63b0: 79 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 70 y. (my-check (p
63c0: 61 69 72 77 69 73 65 2d 6e 6f 74 3d 3f 20 63 69 airwise-not=? ci
63d0: 20 30 20 30 20 30 29 20 3d 3e 20 23 66 29 0a 20 0 0 0) => #f).
63e0: 20 28 6d 79 2d 63 68 65 63 6b 20 28 70 61 69 72 (my-check (pair
63f0: 77 69 73 65 2d 6e 6f 74 3d 3f 20 63 69 20 30 20 wise-not=? ci 0
6400: 30 20 31 29 20 3d 3e 20 23 66 29 0a 20 20 28 6d 0 1) => #f). (m
6410: 79 2d 63 68 65 63 6b 20 28 70 61 69 72 77 69 73 y-check (pairwis
6420: 65 2d 6e 6f 74 3d 3f 20 63 69 20 30 20 31 20 30 e-not=? ci 0 1 0
6430: 29 20 3d 3e 20 23 66 29 0a 20 20 28 6d 79 2d 63 ) => #f). (my-c
6440: 68 65 63 6b 20 28 70 61 69 72 77 69 73 65 2d 6e heck (pairwise-n
6450: 6f 74 3d 3f 20 63 69 20 31 20 30 20 30 29 20 3d ot=? ci 1 0 0) =
6460: 3e 20 23 66 29 0a 20 20 28 6d 79 2d 63 68 65 63 > #f). (my-chec
6470: 6b 20 28 70 61 69 72 77 69 73 65 2d 6e 6f 74 3d k (pairwise-not=
6480: 3f 20 63 69 20 31 20 31 20 30 29 20 3d 3e 20 23 ? ci 1 1 0) => #
6490: 66 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 f). (my-check (
64a0: 70 61 69 72 77 69 73 65 2d 6e 6f 74 3d 3f 20 63 pairwise-not=? c
64b0: 69 20 31 20 30 20 31 29 20 3d 3e 20 23 66 29 0a i 1 0 1) => #f).
64c0: 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 70 61 69 (my-check (pai
64d0: 72 77 69 73 65 2d 6e 6f 74 3d 3f 20 63 69 20 30 rwise-not=? ci 0
64e0: 20 31 20 31 29 20 3d 3e 20 23 66 29 0a 20 20 28 1 1) => #f). (
64f0: 6d 79 2d 63 68 65 63 6b 20 28 70 61 69 72 77 69 my-check (pairwi
6500: 73 65 2d 6e 6f 74 3d 3f 20 63 69 20 30 20 31 20 se-not=? ci 0 1
6510: 32 29 20 3d 3e 20 23 74 29 0a 20 20 28 6d 79 2d 2) => #t). (my-
6520: 63 68 65 63 6b 20 28 70 61 69 72 77 69 73 65 2d check (pairwise-
6530: 6e 6f 74 3d 3f 20 63 69 20 30 20 32 20 31 29 20 not=? ci 0 2 1)
6540: 3d 3e 20 23 74 29 0a 20 20 28 6d 79 2d 63 68 65 => #t). (my-che
6550: 63 6b 20 28 70 61 69 72 77 69 73 65 2d 6e 6f 74 ck (pairwise-not
6560: 3d 3f 20 63 69 20 31 20 32 20 30 29 20 3d 3e 20 =? ci 1 2 0) =>
6570: 23 74 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 #t). (my-check
6580: 28 70 61 69 72 77 69 73 65 2d 6e 6f 74 3d 3f 20 (pairwise-not=?
6590: 63 69 20 31 20 30 20 32 29 20 3d 3e 20 23 74 29 ci 1 0 2) => #t)
65a0: 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 70 61 . (my-check (pa
65b0: 69 72 77 69 73 65 2d 6e 6f 74 3d 3f 20 63 69 20 irwise-not=? ci
65c0: 32 20 30 20 31 29 20 3d 3e 20 23 74 29 0a 20 20 2 0 1) => #t).
65d0: 28 6d 79 2d 63 68 65 63 6b 20 28 70 61 69 72 77 (my-check (pairw
65e0: 69 73 65 2d 6e 6f 74 3d 3f 20 63 69 20 32 20 31 ise-not=? ci 2 1
65f0: 20 30 29 20 3d 3e 20 23 74 29 0a 20 20 0a 20 20 0) => #t). .
6600: 3b 20 6e 2d 61 72 79 2c 20 6e 20 6c 61 72 67 65 ; n-ary, n large
6610: 3a 20 5b 30 2e 2e 6e 2d 31 5d 2c 20 5b 6e 2c 6e : [0..n-1], [n,n
6620: 2d 31 2e 2e 31 5d 2c 20 35 5e 5b 30 2e 2e 39 36 -1..1], 5^[0..96
6630: 5d 20 6d 6f 64 20 39 37 0a 20 20 28 6d 79 2d 63 ] mod 97. (my-c
6640: 68 65 63 6b 20 28 61 70 70 6c 79 20 70 61 69 72 heck (apply pair
6650: 77 69 73 65 2d 6e 6f 74 3d 3f 20 63 69 20 28 6c wise-not=? ci (l
6660: 69 73 74 2d 65 63 20 28 3a 20 69 20 31 30 29 20 ist-ec (: i 10)
6670: 69 29 29 20 3d 3e 20 23 74 29 0a 20 20 28 6d 79 i)) => #t). (my
6680: 2d 63 68 65 63 6b 20 28 61 70 70 6c 79 20 70 61 -check (apply pa
6690: 69 72 77 69 73 65 2d 6e 6f 74 3d 3f 20 63 69 20 irwise-not=? ci
66a0: 28 6c 69 73 74 2d 65 63 20 28 3a 20 69 20 31 30 (list-ec (: i 10
66b0: 30 29 20 69 29 29 20 3d 3e 20 23 74 29 0a 20 20 0) i)) => #t).
66c0: 28 6d 79 2d 63 68 65 63 6b 20 28 61 70 70 6c 79 (my-check (apply
66d0: 20 70 61 69 72 77 69 73 65 2d 6e 6f 74 3d 3f 20 pairwise-not=?
66e0: 63 69 20 28 6c 69 73 74 2d 65 63 20 28 3a 20 69 ci (list-ec (: i
66f0: 20 31 30 30 30 29 20 69 29 29 20 3d 3e 20 23 74 1000) i)) => #t
6700: 29 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b ). . (my-check
6710: 20 28 61 70 70 6c 79 20 70 61 69 72 77 69 73 65 (apply pairwise
6720: 2d 6e 6f 74 3d 3f 20 63 69 20 28 6c 69 73 74 2d -not=? ci (list-
6730: 65 63 20 28 3a 20 69 20 31 30 20 30 20 2d 31 29 ec (: i 10 0 -1)
6740: 20 69 29 29 20 3d 3e 20 23 74 29 0a 20 20 28 6d i)) => #t). (m
6750: 79 2d 63 68 65 63 6b 20 28 61 70 70 6c 79 20 70 y-check (apply p
6760: 61 69 72 77 69 73 65 2d 6e 6f 74 3d 3f 20 63 69 airwise-not=? ci
6770: 20 28 6c 69 73 74 2d 65 63 20 28 3a 20 69 20 31 (list-ec (: i 1
6780: 30 30 20 30 20 2d 31 29 20 69 29 29 20 3d 3e 20 00 0 -1) i)) =>
6790: 23 74 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 #t). (my-check
67a0: 28 61 70 70 6c 79 20 70 61 69 72 77 69 73 65 2d (apply pairwise-
67b0: 6e 6f 74 3d 3f 20 63 69 20 28 6c 69 73 74 2d 65 not=? ci (list-e
67c0: 63 20 28 3a 20 69 20 31 30 30 30 20 30 20 2d 31 c (: i 1000 0 -1
67d0: 29 20 69 29 29 20 3d 3e 20 23 74 29 0a 20 20 0a ) i)) => #t). .
67e0: 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 61 70 70 (my-check (app
67f0: 6c 79 20 70 61 69 72 77 69 73 65 2d 6e 6f 74 3d ly pairwise-not=
6800: 3f 20 63 69 20 0a 20 20 20 20 20 20 20 20 20 20 ? ci .
6810: 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 2d 65 (list-e
6820: 63 20 28 3a 20 69 20 39 37 29 20 28 6d 6f 64 75 c (: i 97) (modu
6830: 6c 6f 20 28 2a 20 35 20 69 29 20 39 37 29 29 29 lo (* 5 i) 97)))
6840: 0a 20 20 20 20 20 20 20 20 20 20 20 20 3d 3e 20 . =>
6850: 23 74 29 0a 20 20 0a 20 20 3b 20 62 75 72 79 20 #t). . ; bury
6860: 61 6e 6f 74 68 65 72 20 63 6f 70 79 20 6f 66 20 another copy of
6870: 37 32 20 3d 20 35 5e 35 30 20 6d 6f 64 20 39 37 72 = 5^50 mod 97
6880: 20 69 6e 20 35 5e 5b 30 2e 2e 39 36 5d 20 6d 6f in 5^[0..96] mo
6890: 64 20 39 37 0a 20 20 28 6d 79 2d 63 68 65 63 6b d 97. (my-check
68a0: 20 28 61 70 70 6c 79 20 70 61 69 72 77 69 73 65 (apply pairwise
68b0: 2d 6e 6f 74 3d 3f 20 63 69 20 0a 20 20 20 20 20 -not=? ci .
68c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
68d0: 70 70 65 6e 64 20 28 6c 69 73 74 2d 65 63 20 28 ppend (list-ec (
68e0: 3a 20 69 20 30 20 32 33 29 20 28 6d 6f 64 75 6c : i 0 23) (modul
68f0: 6f 20 28 2a 20 35 20 69 29 20 39 37 29 29 0a 20 o (* 5 i) 97)).
6900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6910: 20 20 20 20 20 20 20 20 20 20 27 28 37 32 29 0a '(72).
6920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6930: 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 (list
6940: 2d 65 63 20 28 3a 20 69 20 32 33 20 39 37 29 20 -ec (: i 23 97)
6950: 28 6d 6f 64 75 6c 6f 20 28 2a 20 35 20 69 29 20 (modulo (* 5 i)
6960: 39 37 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 97)))).
6970: 20 20 20 3d 3e 20 23 66 29 0a 20 20 28 6d 79 2d => #f). (my-
6980: 63 68 65 63 6b 20 28 61 70 70 6c 79 20 70 61 69 check (apply pai
6990: 72 77 69 73 65 2d 6e 6f 74 3d 3f 20 63 69 20 0a rwise-not=? ci .
69a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
69b0: 20 20 20 28 61 70 70 65 6e 64 20 28 6c 69 73 74 (append (list
69c0: 2d 65 63 20 28 3a 20 69 20 30 20 37 35 29 20 28 -ec (: i 0 75) (
69d0: 6d 6f 64 75 6c 6f 20 28 2a 20 35 20 69 29 20 39 modulo (* 5 i) 9
69e0: 37 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 7)).
69f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 '
6a00: 28 37 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 (72).
6a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6a20: 28 6c 69 73 74 2d 65 63 20 28 3a 20 69 20 37 35 (list-ec (: i 75
6a30: 20 39 37 29 20 28 6d 6f 64 75 6c 6f 20 28 2a 20 97) (modulo (*
6a40: 35 20 69 29 20 39 37 29 29 29 29 0a 20 20 20 20 5 i) 97)))).
6a50: 20 20 20 20 20 20 20 20 3d 3e 20 23 66 29 0a 20 => #f).
6a60: 20 0a 20 20 3b 20 63 68 65 63 6b 20 69 66 20 61 . ; check if a
6a70: 6c 6c 20 61 72 67 75 6d 65 6e 74 73 20 61 72 65 ll arguments are
6a80: 20 75 73 65 64 0a 20 20 28 6d 79 2d 63 68 65 63 used. (my-chec
6a90: 6b 20 28 61 72 67 75 6d 65 6e 74 73 2d 75 73 65 k (arguments-use
6aa0: 64 20 28 70 61 69 72 77 69 73 65 2d 6e 6f 74 3d d (pairwise-not=
6ab0: 3f 20 63 69 20 30 29 29 20 3d 3e 20 27 28 30 29 ? ci 0)) => '(0)
6ac0: 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 61 ). (my-check (a
6ad0: 72 67 75 6d 65 6e 74 73 2d 75 73 65 64 20 28 70 rguments-used (p
6ae0: 61 69 72 77 69 73 65 2d 6e 6f 74 3d 3f 20 63 69 airwise-not=? ci
6af0: 20 30 20 31 29 29 20 3d 3e 20 27 28 30 20 31 29 0 1)) => '(0 1)
6b00: 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 61 ). (my-check (a
6b10: 72 67 75 6d 65 6e 74 73 2d 75 73 65 64 20 28 70 rguments-used (p
6b20: 61 69 72 77 69 73 65 2d 6e 6f 74 3d 3f 20 63 69 airwise-not=? ci
6b30: 20 31 20 30 29 29 20 3d 3e 20 27 28 30 20 31 29 1 0)) => '(0 1)
6b40: 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 61 ). (my-check (a
6b50: 72 67 75 6d 65 6e 74 73 2d 75 73 65 64 20 28 70 rguments-used (p
6b60: 61 69 72 77 69 73 65 2d 6e 6f 74 3d 3f 20 63 69 airwise-not=? ci
6b70: 20 30 20 32 20 31 29 29 20 3d 3e 20 27 28 30 20 0 2 1)) => '(0
6b80: 31 20 32 29 29 0a 20 20 28 6d 79 2d 63 68 65 63 1 2)). (my-chec
6b90: 6b 20 28 61 72 67 75 6d 65 6e 74 73 2d 75 73 65 k (arguments-use
6ba0: 64 20 28 70 61 69 72 77 69 73 65 2d 6e 6f 74 3d d (pairwise-not=
6bb0: 3f 20 63 69 20 31 20 32 20 30 29 29 20 3d 3e 20 ? ci 1 2 0)) =>
6bc0: 27 28 30 20 31 20 32 29 29 0a 20 20 28 6d 79 2d '(0 1 2)). (my-
6bd0: 63 68 65 63 6b 20 28 61 72 67 75 6d 65 6e 74 73 check (arguments
6be0: 2d 75 73 65 64 20 28 70 61 69 72 77 69 73 65 2d -used (pairwise-
6bf0: 6e 6f 74 3d 3f 20 63 69 20 31 20 30 20 32 29 29 not=? ci 1 0 2))
6c00: 20 3d 3e 20 27 28 30 20 31 20 32 29 29 0a 20 20 => '(0 1 2)).
6c10: 28 6d 79 2d 63 68 65 63 6b 20 28 61 72 67 75 6d (my-check (argum
6c20: 65 6e 74 73 2d 75 73 65 64 20 28 70 61 69 72 77 ents-used (pairw
6c30: 69 73 65 2d 6e 6f 74 3d 3f 20 63 69 20 32 20 30 ise-not=? ci 2 0
6c40: 20 31 29 29 20 3d 3e 20 27 28 30 20 31 20 32 29 1)) => '(0 1 2)
6c50: 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 61 ). (my-check (a
6c60: 72 67 75 6d 65 6e 74 73 2d 75 73 65 64 20 28 70 rguments-used (p
6c70: 61 69 72 77 69 73 65 2d 6e 6f 74 3d 3f 20 63 69 airwise-not=? ci
6c80: 20 32 20 31 20 30 29 29 20 3d 3e 20 27 28 30 20 2 1 0)) => '(0
6c90: 31 20 32 29 29 0a 20 20 28 6d 79 2d 63 68 65 63 1 2)). (my-chec
6ca0: 6b 20 28 61 72 67 75 6d 65 6e 74 73 2d 75 73 65 k (arguments-use
6cb0: 64 20 28 70 61 69 72 77 69 73 65 2d 6e 6f 74 3d d (pairwise-not=
6cc0: 3f 20 63 69 20 30 20 30 20 30 20 31 20 30 20 30 ? ci 0 0 0 1 0 0
6cd0: 20 30 20 32 20 30 20 30 20 30 20 33 29 29 0a 20 0 2 0 0 0 3)).
6ce0: 20 20 20 20 20 20 20 20 20 20 20 3d 3e 20 27 28 => '(
6cf0: 30 20 31 20 32 20 33 29 29 0a 20 20 0a 20 20 3b 0 1 2 3)). . ;
6d00: 20 47 75 65 73 73 20 69 66 20 74 68 65 20 69 6d Guess if the im
6d10: 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 20 69 73 20 plementation is
6d20: 4f 28 6e 20 6c 6f 67 20 6e 29 3a 0a 20 20 3b 20 O(n log n):. ;
6d30: 20 20 54 68 65 20 74 65 73 74 20 69 73 20 72 75 The test is ru
6d40: 6e 20 66 6f 72 20 32 5e 65 20 70 61 69 72 77 69 n for 2^e pairwi
6d50: 73 65 20 75 6e 65 71 75 61 6c 20 69 6e 70 75 74 se unequal input
6d60: 73 2c 20 65 20 3e 3d 20 31 2c 0a 20 20 3b 20 20 s, e >= 1,. ;
6d70: 20 61 6e 64 20 74 68 65 20 6e 75 6d 62 65 72 20 and the number
6d80: 6f 66 20 63 61 6c 6c 73 20 74 6f 20 74 68 65 20 of calls to the
6d90: 63 6f 6d 70 61 72 65 20 70 72 6f 63 65 64 75 72 compare procedur
6da0: 65 20 69 73 20 63 6f 75 6e 74 65 64 2e 0a 20 20 e is counted..
6db0: 3b 20 20 20 20 20 61 6c 6c 20 70 61 69 72 73 3a ; all pairs:
6dc0: 20 20 20 20 20 20 20 20 20 20 41 20 3d 20 42 69 A = Bi
6dd0: 6e 6f 6d 69 61 6c 5b 32 5e 65 2c 20 32 5d 20 3d nomial[2^e, 2] =
6de0: 20 32 5e 28 32 20 65 20 2d 20 31 29 20 2a 20 28 2^(2 e - 1) * (
6df0: 31 20 2d 20 32 5e 2d 65 29 2e 0a 20 20 3b 20 20 1 - 2^-e).. ;
6e00: 20 20 20 64 69 76 69 64 65 20 61 6e 64 20 63 6f divide and co
6e10: 6e 71 75 65 72 3a 20 44 20 3d 20 65 20 32 5e 65 nquer: D = e 2^e
6e20: 2e 0a 20 20 3b 20 20 20 53 69 6e 63 65 20 61 6e .. ; Since an
6e30: 20 69 6d 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 20 implementation
6e40: 63 61 6e 20 62 65 20 72 61 6e 64 6f 6d 69 7a 65 can be randomize
6e50: 64 2c 20 74 68 65 20 61 63 74 75 61 6c 20 63 6f d, the actual co
6e60: 75 6e 74 20 6d 61 79 0a 20 20 3b 20 20 20 62 65 unt may. ; be
6e70: 20 61 20 72 61 6e 64 6f 6d 20 6e 75 6d 62 65 72 a random number
6e80: 2e 20 57 65 20 70 75 74 20 61 20 74 68 72 65 73 . We put a thres
6e90: 68 6f 6c 64 20 61 74 20 31 30 30 20 65 20 32 5e hold at 100 e 2^
6ea0: 65 20 61 6e 64 20 63 68 6f 6f 73 65 0a 20 20 3b e and choose. ;
6eb0: 20 20 20 65 20 73 75 63 68 20 74 68 61 74 20 41 e such that A
6ec0: 2f 44 20 3e 3d 20 31 35 30 2c 20 69 2e 65 2e 20 /D >= 150, i.e.
6ed0: 65 20 3e 3d 20 31 32 2e 0a 20 20 3b 20 20 20 20 e >= 12.. ;
6ee0: 20 54 68 65 20 74 65 73 74 20 69 73 20 61 70 70 The test is app
6ef0: 6c 69 65 64 20 74 6f 20 73 65 76 65 72 61 6c 20 lied to several
6f00: 69 6e 70 75 74 73 20 74 68 61 74 20 61 72 65 20 inputs that are
6f10: 6b 6e 6f 77 6e 20 74 6f 20 63 61 75 73 65 0a 20 known to cause.
6f20: 20 3b 20 20 20 74 72 6f 75 62 6c 65 20 69 6e 20 ; trouble in
6f30: 73 69 6d 70 6c 69 73 74 69 63 20 73 6f 72 74 69 simplistic sorti
6f40: 6e 67 20 61 6c 67 6f 72 69 74 68 6d 73 3a 20 28 ng algorithms: (
6f50: 30 2e 2e 32 5e 65 2d 31 29 2c 20 28 32 5e 65 2b 0..2^e-1), (2^e+
6f60: 31 2c 32 5e 65 2e 2e 31 29 2c 0a 20 20 3b 20 20 1,2^e..1),. ;
6f70: 20 61 20 70 73 65 75 64 6f 2d 72 61 6e 64 6f 6d a pseudo-random
6f80: 20 70 65 72 6d 75 74 61 74 69 6f 6e 2c 20 61 6e permutation, an
6f90: 64 20 61 20 73 65 71 75 65 6e 63 65 20 77 69 74 d a sequence wit
6fa0: 68 20 61 6e 20 65 78 74 72 65 6d 61 6c 20 70 69 h an extremal pi
6fb0: 76 6f 74 0a 20 20 3b 20 20 20 61 74 20 74 68 65 vot. ; at the
6fc0: 20 63 65 6e 74 65 72 20 6f 66 20 65 61 63 68 20 center of each
6fd0: 73 75 62 73 65 71 75 65 6e 63 65 2e 0a 20 20 0a subsequence.. .
6fe0: 20 20 28 6d 79 2d 63 68 65 63 6b 2d 65 63 20 0a (my-check-ec .
6ff0: 20 20 20 28 3a 6c 69 73 74 20 69 6e 70 75 74 20 (:list input
7000: 70 61 69 72 77 69 73 65 2d 6e 6f 74 3d 3f 3a 6c pairwise-not=?:l
7010: 6f 6e 67 2d 73 65 71 75 65 6e 63 65 73 29 0a 20 ong-sequences).
7020: 20 20 28 6c 65 74 20 28 28 63 6f 6d 70 61 72 65 (let ((compare
7030: 73 20 30 29 29 0a 20 20 20 20 20 28 61 70 70 6c s 0)). (appl
7040: 79 20 70 61 69 72 77 69 73 65 2d 6e 6f 74 3d 3f y pairwise-not=?
7050: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 6c . (l
7060: 61 6d 62 64 61 20 28 78 20 79 29 0a 20 20 20 20 ambda (x y).
7070: 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 (set!
7080: 63 6f 6d 70 61 72 65 73 20 28 2b 20 63 6f 6d 70 compares (+ comp
7090: 61 72 65 73 20 31 29 29 0a 20 20 20 20 20 20 20 ares 1)).
70a0: 20 20 20 20 20 20 20 28 63 69 20 78 20 79 29 29 (ci x y))
70b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 69 6e 70 . inp
70c0: 75 74 29 0a 20 20 20 20 20 3b 20 20 20 20 20 28 ut). ; (
70d0: 64 69 73 70 6c 61 79 20 63 6f 6d 70 61 72 65 73 display compares
70e0: 29 20 28 6e 65 77 6c 69 6e 65 29 0a 20 20 20 20 ) (newline).
70f0: 20 28 3c 20 63 6f 6d 70 61 72 65 73 20 28 2a 20 (< compares (*
7100: 31 30 30 20 31 32 20 34 30 39 36 29 29 29 0a 20 100 12 4096))).
7110: 20 20 28 6c 65 6e 67 74 68 20 69 6e 70 75 74 29 (length input)
7120: 29 0a 20 20 0a 20 20 3b 20 63 68 65 63 6b 20 6d ). . ; check m
7130: 61 6e 79 20 73 68 6f 72 74 20 73 65 71 75 65 6e any short sequen
7140: 63 65 73 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 ces. . (my-che
7150: 63 6b 2d 65 63 20 0a 20 20 20 28 3a 6c 69 73 74 ck-ec . (:list
7160: 20 69 6e 70 75 74 20 70 61 69 72 77 69 73 65 2d input pairwise-
7170: 6e 6f 74 3d 3f 3a 73 68 6f 72 74 2d 73 65 71 75 not=?:short-sequ
7180: 65 6e 63 65 73 29 0a 20 20 20 28 65 71 3f 0a 20 ences). (eq?.
7190: 20 20 20 28 61 70 70 6c 79 20 70 61 69 72 77 69 (apply pairwi
71a0: 73 65 2d 6e 6f 74 3d 3f 20 63 6f 6c 6c 69 64 69 se-not=? collidi
71b0: 6e 67 2d 63 6f 6d 70 61 72 65 20 69 6e 70 75 74 ng-compare input
71c0: 29 0a 20 20 20 20 28 61 70 70 6c 79 20 6e 61 69 ). (apply nai
71d0: 76 65 2d 70 61 69 72 77 69 73 65 2d 6e 6f 74 3d ve-pairwise-not=
71e0: 3f 20 63 6f 6c 6c 69 64 69 6e 67 2d 63 6f 6d 70 ? colliding-comp
71f0: 61 72 65 20 69 6e 70 75 74 29 29 0a 20 20 20 69 are input)). i
7200: 6e 70 75 74 29 0a 20 20 0a 20 20 3b 20 63 68 65 nput). . ; che
7210: 63 6b 20 69 66 20 74 68 65 20 61 72 67 75 6d 65 ck if the argume
7220: 6e 74 73 20 61 72 65 20 75 73 65 64 20 66 6f 72 nts are used for
7230: 20 73 68 6f 72 74 20 73 65 71 75 65 6e 63 65 73 short sequences
7240: 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d . . (my-check-
7250: 65 63 20 0a 20 20 20 28 3a 6c 69 73 74 20 69 6e ec . (:list in
7260: 70 75 74 20 70 61 69 72 77 69 73 65 2d 6e 6f 74 put pairwise-not
7270: 3d 3f 3a 73 68 6f 72 74 2d 73 65 71 75 65 6e 63 =?:short-sequenc
7280: 65 73 29 0a 20 20 20 28 6c 65 74 20 28 28 61 72 es). (let ((ar
7290: 67 73 20 27 28 29 29 29 0a 20 20 20 20 20 28 61 gs '())). (a
72a0: 70 70 6c 79 20 70 61 69 72 77 69 73 65 2d 6e 6f pply pairwise-no
72b0: 74 3d 3f 20 0a 20 20 20 20 20 20 20 20 20 20 20 t=? .
72c0: 20 28 6c 61 6d 62 64 61 20 28 78 20 79 29 0a 20 (lambda (x y).
72d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 (se
72e0: 74 21 20 61 72 67 73 20 28 63 6f 6e 73 20 78 20 t! args (cons x
72f0: 28 63 6f 6e 73 20 79 20 61 72 67 73 29 29 29 0a (cons y args))).
7300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
7310: 6f 6c 6c 69 64 69 6e 67 2d 63 6f 6d 70 61 72 65 olliding-compare
7320: 20 78 20 79 29 29 0a 20 20 20 20 20 20 20 20 20 x y)).
7330: 20 20 20 69 6e 70 75 74 29 0a 20 20 20 20 20 28 input). (
7340: 65 71 75 61 6c 3f 20 28 6c 69 73 74 2d 3e 73 65 equal? (list->se
7350: 74 20 61 72 67 73 29 20 28 6c 69 73 74 2d 3e 73 t args) (list->s
7360: 65 74 20 69 6e 70 75 74 29 29 29 0a 20 20 20 69 et input))). i
7370: 6e 70 75 74 29 0a 20 20 0a 20 20 29 20 3b 20 63 nput). . ) ; c
7380: 68 65 63 6b 3a 70 61 69 72 77 69 73 65 2d 6e 6f heck:pairwise-no
7390: 74 3d 3f 0a 0a 0a 3b 20 6d 69 6e 2f 6d 61 78 0a t=?...; min/max.
73a0: 0a 28 64 65 66 69 6e 65 20 6d 69 6e 2f 6d 61 78 .(define min/max
73b0: 3a 73 65 71 75 65 6e 63 65 73 0a 20 20 28 61 70 :sequences. (ap
73c0: 70 65 6e 64 20 70 61 69 72 77 69 73 65 2d 6e 6f pend pairwise-no
73d0: 74 3d 3f 3a 73 68 6f 72 74 2d 73 65 71 75 65 6e t=?:short-sequen
73e0: 63 65 73 0a 20 20 20 20 20 20 20 20 20 20 70 61 ces. pa
73f0: 69 72 77 69 73 65 2d 6e 6f 74 3d 3f 3a 6c 6f 6e irwise-not=?:lon
7400: 67 2d 73 65 71 75 65 6e 63 65 73 29 29 0a 0a 28 g-sequences))..(
7410: 64 65 66 69 6e 65 20 28 63 68 65 63 6b 3a 6d 69 define (check:mi
7420: 6e 2f 6d 61 78 29 0a 20 20 0a 20 20 3b 20 61 6c n/max). . ; al
7430: 6c 20 6c 69 73 74 73 20 6f 66 20 6c 65 6e 67 74 l lists of lengt
7440: 68 20 31 2c 32 2c 33 0a 20 20 28 6d 79 2d 63 68 h 1,2,3. (my-ch
7450: 65 63 6b 20 28 6d 69 6e 2d 63 6f 6d 70 61 72 65 eck (min-compare
7460: 20 63 69 20 30 29 20 3d 3e 20 30 29 0a 20 20 28 ci 0) => 0). (
7470: 6d 79 2d 63 68 65 63 6b 20 28 6d 69 6e 2d 63 6f my-check (min-co
7480: 6d 70 61 72 65 20 63 69 20 30 20 30 29 20 3d 3e mpare ci 0 0) =>
7490: 20 30 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 0). (my-check
74a0: 28 6d 69 6e 2d 63 6f 6d 70 61 72 65 20 63 69 20 (min-compare ci
74b0: 30 20 31 29 20 3d 3e 20 30 29 0a 20 20 28 6d 79 0 1) => 0). (my
74c0: 2d 63 68 65 63 6b 20 28 6d 69 6e 2d 63 6f 6d 70 -check (min-comp
74d0: 61 72 65 20 63 69 20 31 20 30 29 20 3d 3e 20 30 are ci 1 0) => 0
74e0: 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 6d ). (my-check (m
74f0: 69 6e 2d 63 6f 6d 70 61 72 65 20 63 69 20 30 20 in-compare ci 0
7500: 30 20 30 29 20 3d 3e 20 30 29 0a 20 20 28 6d 79 0 0) => 0). (my
7510: 2d 63 68 65 63 6b 20 28 6d 69 6e 2d 63 6f 6d 70 -check (min-comp
7520: 61 72 65 20 63 69 20 30 20 30 20 31 29 20 3d 3e are ci 0 0 1) =>
7530: 20 30 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 0). (my-check
7540: 28 6d 69 6e 2d 63 6f 6d 70 61 72 65 20 63 69 20 (min-compare ci
7550: 30 20 31 20 30 29 20 3d 3e 20 30 29 0a 20 20 28 0 1 0) => 0). (
7560: 6d 79 2d 63 68 65 63 6b 20 28 6d 69 6e 2d 63 6f my-check (min-co
7570: 6d 70 61 72 65 20 63 69 20 31 20 30 20 30 29 20 mpare ci 1 0 0)
7580: 3d 3e 20 30 29 0a 20 20 28 6d 79 2d 63 68 65 63 => 0). (my-chec
7590: 6b 20 28 6d 69 6e 2d 63 6f 6d 70 61 72 65 20 63 k (min-compare c
75a0: 69 20 31 20 31 20 30 29 20 3d 3e 20 30 29 0a 20 i 1 1 0) => 0).
75b0: 20 28 6d 79 2d 63 68 65 63 6b 20 28 6d 69 6e 2d (my-check (min-
75c0: 63 6f 6d 70 61 72 65 20 63 69 20 31 20 30 20 31 compare ci 1 0 1
75d0: 29 20 3d 3e 20 30 29 0a 20 20 28 6d 79 2d 63 68 ) => 0). (my-ch
75e0: 65 63 6b 20 28 6d 69 6e 2d 63 6f 6d 70 61 72 65 eck (min-compare
75f0: 20 63 69 20 30 20 31 20 31 29 20 3d 3e 20 30 29 ci 0 1 1) => 0)
7600: 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 6d 69 . (my-check (mi
7610: 6e 2d 63 6f 6d 70 61 72 65 20 63 69 20 30 20 31 n-compare ci 0 1
7620: 20 32 29 20 3d 3e 20 30 29 0a 20 20 28 6d 79 2d 2) => 0). (my-
7630: 63 68 65 63 6b 20 28 6d 69 6e 2d 63 6f 6d 70 61 check (min-compa
7640: 72 65 20 63 69 20 30 20 32 20 31 29 20 3d 3e 20 re ci 0 2 1) =>
7650: 30 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 0). (my-check (
7660: 6d 69 6e 2d 63 6f 6d 70 61 72 65 20 63 69 20 31 min-compare ci 1
7670: 20 32 20 30 29 20 3d 3e 20 30 29 0a 20 20 28 6d 2 0) => 0). (m
7680: 79 2d 63 68 65 63 6b 20 28 6d 69 6e 2d 63 6f 6d y-check (min-com
7690: 70 61 72 65 20 63 69 20 31 20 30 20 32 29 20 3d pare ci 1 0 2) =
76a0: 3e 20 30 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b > 0). (my-check
76b0: 20 28 6d 69 6e 2d 63 6f 6d 70 61 72 65 20 63 69 (min-compare ci
76c0: 20 32 20 30 20 31 29 20 3d 3e 20 30 29 0a 20 20 2 0 1) => 0).
76d0: 28 6d 79 2d 63 68 65 63 6b 20 28 6d 69 6e 2d 63 (my-check (min-c
76e0: 6f 6d 70 61 72 65 20 63 69 20 32 20 31 20 30 29 ompare ci 2 1 0)
76f0: 20 3d 3e 20 30 29 0a 20 20 0a 20 20 28 6d 79 2d => 0). . (my-
7700: 63 68 65 63 6b 20 28 6d 61 78 2d 63 6f 6d 70 61 check (max-compa
7710: 72 65 20 63 69 20 30 29 20 3d 3e 20 30 29 0a 20 re ci 0) => 0).
7720: 20 28 6d 79 2d 63 68 65 63 6b 20 28 6d 61 78 2d (my-check (max-
7730: 63 6f 6d 70 61 72 65 20 63 69 20 30 20 30 29 20 compare ci 0 0)
7740: 3d 3e 20 30 29 0a 20 20 28 6d 79 2d 63 68 65 63 => 0). (my-chec
7750: 6b 20 28 6d 61 78 2d 63 6f 6d 70 61 72 65 20 63 k (max-compare c
7760: 69 20 30 20 31 29 20 3d 3e 20 31 29 0a 20 20 28 i 0 1) => 1). (
7770: 6d 79 2d 63 68 65 63 6b 20 28 6d 61 78 2d 63 6f my-check (max-co
7780: 6d 70 61 72 65 20 63 69 20 31 20 30 29 20 3d 3e mpare ci 1 0) =>
7790: 20 31 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 1). (my-check
77a0: 28 6d 61 78 2d 63 6f 6d 70 61 72 65 20 63 69 20 (max-compare ci
77b0: 30 20 30 20 30 29 20 3d 3e 20 30 29 0a 20 20 28 0 0 0) => 0). (
77c0: 6d 79 2d 63 68 65 63 6b 20 28 6d 61 78 2d 63 6f my-check (max-co
77d0: 6d 70 61 72 65 20 63 69 20 30 20 30 20 31 29 20 mpare ci 0 0 1)
77e0: 3d 3e 20 31 29 0a 20 20 28 6d 79 2d 63 68 65 63 => 1). (my-chec
77f0: 6b 20 28 6d 61 78 2d 63 6f 6d 70 61 72 65 20 63 k (max-compare c
7800: 69 20 30 20 31 20 30 29 20 3d 3e 20 31 29 0a 20 i 0 1 0) => 1).
7810: 20 28 6d 79 2d 63 68 65 63 6b 20 28 6d 61 78 2d (my-check (max-
7820: 63 6f 6d 70 61 72 65 20 63 69 20 31 20 30 20 30 compare ci 1 0 0
7830: 29 20 3d 3e 20 31 29 0a 20 20 28 6d 79 2d 63 68 ) => 1). (my-ch
7840: 65 63 6b 20 28 6d 61 78 2d 63 6f 6d 70 61 72 65 eck (max-compare
7850: 20 63 69 20 31 20 31 20 30 29 20 3d 3e 20 31 29 ci 1 1 0) => 1)
7860: 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 6d 61 . (my-check (ma
7870: 78 2d 63 6f 6d 70 61 72 65 20 63 69 20 31 20 30 x-compare ci 1 0
7880: 20 31 29 20 3d 3e 20 31 29 0a 20 20 28 6d 79 2d 1) => 1). (my-
7890: 63 68 65 63 6b 20 28 6d 61 78 2d 63 6f 6d 70 61 check (max-compa
78a0: 72 65 20 63 69 20 30 20 31 20 31 29 20 3d 3e 20 re ci 0 1 1) =>
78b0: 31 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 1). (my-check (
78c0: 6d 61 78 2d 63 6f 6d 70 61 72 65 20 63 69 20 30 max-compare ci 0
78d0: 20 31 20 32 29 20 3d 3e 20 32 29 0a 20 20 28 6d 1 2) => 2). (m
78e0: 79 2d 63 68 65 63 6b 20 28 6d 61 78 2d 63 6f 6d y-check (max-com
78f0: 70 61 72 65 20 63 69 20 30 20 32 20 31 29 20 3d pare ci 0 2 1) =
7900: 3e 20 32 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b > 2). (my-check
7910: 20 28 6d 61 78 2d 63 6f 6d 70 61 72 65 20 63 69 (max-compare ci
7920: 20 31 20 32 20 30 29 20 3d 3e 20 32 29 0a 20 20 1 2 0) => 2).
7930: 28 6d 79 2d 63 68 65 63 6b 20 28 6d 61 78 2d 63 (my-check (max-c
7940: 6f 6d 70 61 72 65 20 63 69 20 31 20 30 20 32 29 ompare ci 1 0 2)
7950: 20 3d 3e 20 32 29 0a 20 20 28 6d 79 2d 63 68 65 => 2). (my-che
7960: 63 6b 20 28 6d 61 78 2d 63 6f 6d 70 61 72 65 20 ck (max-compare
7970: 63 69 20 32 20 30 20 31 29 20 3d 3e 20 32 29 0a ci 2 0 1) => 2).
7980: 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 6d 61 78 (my-check (max
7990: 2d 63 6f 6d 70 61 72 65 20 63 69 20 32 20 31 20 -compare ci 2 1
79a0: 30 29 20 3d 3e 20 32 29 0a 20 20 0a 20 20 3b 20 0) => 2). . ;
79b0: 63 68 65 63 6b 20 74 68 61 74 20 74 68 65 20 66 check that the f
79c0: 69 72 73 74 20 6d 69 6e 69 6d 61 6c 20 76 61 6c irst minimal val
79d0: 75 65 20 69 73 20 72 65 74 75 72 6e 65 64 0a 20 ue is returned.
79e0: 20 28 6d 79 2d 63 68 65 63 6b 20 28 6d 69 6e 2d (my-check (min-
79f0: 63 6f 6d 70 61 72 65 20 28 70 61 69 72 2d 63 6f compare (pair-co
7a00: 6d 70 61 72 65 2d 63 61 72 20 63 69 29 0a 20 20 mpare-car ci).
7a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7a20: 20 20 20 20 20 20 20 27 28 30 20 31 29 20 27 28 '(0 1) '(
7a30: 30 20 32 29 20 27 28 30 20 33 29 29 0a 20 20 20 0 2) '(0 3)).
7a40: 20 20 20 20 20 20 20 20 20 3d 3e 20 27 28 30 20 => '(0
7a50: 31 29 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 1)). (my-check
7a60: 28 6d 61 78 2d 63 6f 6d 70 61 72 65 20 28 70 61 (max-compare (pa
7a70: 69 72 2d 63 6f 6d 70 61 72 65 2d 63 61 72 20 63 ir-compare-car c
7a80: 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i).
7a90: 20 20 20 20 20 20 20 20 20 20 20 20 27 28 30 20 '(0
7aa0: 31 29 20 27 28 30 20 32 29 20 27 28 30 20 33 29 1) '(0 2) '(0 3)
7ab0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 3d 3e ). =>
7ac0: 20 27 28 30 20 31 29 29 0a 20 20 0a 20 20 3b 20 '(0 1)). . ;
7ad0: 63 68 65 63 6b 20 66 6f 72 20 6d 61 6e 79 20 69 check for many i
7ae0: 6e 70 75 74 73 0a 20 20 28 6d 79 2d 63 68 65 63 nputs. (my-chec
7af0: 6b 2d 65 63 20 0a 20 20 20 28 3a 6c 69 73 74 20 k-ec . (:list
7b00: 69 6e 70 75 74 20 6d 69 6e 2f 6d 61 78 3a 73 65 input min/max:se
7b10: 71 75 65 6e 63 65 73 29 0a 20 20 20 28 3d 20 28 quences). (= (
7b20: 61 70 70 6c 79 20 6d 69 6e 2d 63 6f 6d 70 61 72 apply min-compar
7b30: 65 20 63 69 20 69 6e 70 75 74 29 0a 20 20 20 20 e ci input).
7b40: 20 20 28 61 70 70 6c 79 20 6d 69 6e 20 28 61 70 (apply min (ap
7b50: 70 6c 79 20 6d 61 78 20 69 6e 70 75 74 29 20 69 ply max input) i
7b60: 6e 70 75 74 29 29 0a 20 20 20 69 6e 70 75 74 29 nput)). input)
7b70: 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d 65 63 20 . (my-check-ec
7b80: 0a 20 20 20 28 3a 6c 69 73 74 20 69 6e 70 75 74 . (:list input
7b90: 20 6d 69 6e 2f 6d 61 78 3a 73 65 71 75 65 6e 63 min/max:sequenc
7ba0: 65 73 29 0a 20 20 20 28 3d 20 28 61 70 70 6c 79 es). (= (apply
7bb0: 20 6d 61 78 2d 63 6f 6d 70 61 72 65 20 63 69 20 max-compare ci
7bc0: 69 6e 70 75 74 29 0a 20 20 20 20 20 20 28 61 70 input). (ap
7bd0: 70 6c 79 20 6d 61 78 20 28 61 70 70 6c 79 20 6d ply max (apply m
7be0: 69 6e 20 69 6e 70 75 74 29 20 69 6e 70 75 74 29 in input) input)
7bf0: 29 0a 20 20 20 69 6e 70 75 74 29 0a 20 20 3b 20 ). input). ;
7c00: 4e 6f 74 65 20 74 68 65 20 73 74 75 70 69 64 20 Note the stupid
7c10: 65 78 74 72 61 20 61 72 67 75 6d 65 6e 74 20 69 extra argument i
7c20: 6e 20 74 68 65 20 61 70 70 6c 79 20 66 6f 72 0a n the apply for.
7c30: 20 20 3b 20 74 68 65 20 73 74 61 6e 64 61 72 64 ; the standard
7c40: 20 6d 69 6e 2f 6d 61 78 20 6d 61 6b 65 73 20 73 min/max makes s
7c50: 75 72 65 20 74 68 65 20 65 6c 65 6d 65 6e 74 73 ure the elements
7c60: 20 61 72 65 0a 20 20 3b 20 69 64 65 6e 74 69 63 are. ; identic
7c70: 61 6c 20 77 68 65 6e 20 61 70 70 6c 79 20 74 72 al when apply tr
7c80: 75 6e 63 61 74 65 73 20 74 68 65 20 61 72 67 6c uncates the argl
7c90: 69 73 74 2e 0a 20 20 0a 20 20 29 20 3b 20 63 68 ist.. . ) ; ch
7ca0: 65 63 6b 3a 6d 69 6e 2f 6d 61 78 0a 0a 0a 3b 20 eck:min/max...;
7cb0: 6b 74 68 2d 6c 61 72 67 65 73 74 0a 0a 28 64 65 kth-largest..(de
7cc0: 66 69 6e 65 20 6b 74 68 2d 6c 61 72 67 65 73 74 fine kth-largest
7cd0: 3a 73 65 71 75 65 6e 63 65 73 0a 20 20 70 61 69 :sequences. pai
7ce0: 72 77 69 73 65 2d 6e 6f 74 3d 3f 3a 73 68 6f 72 rwise-not=?:shor
7cf0: 74 2d 73 65 71 75 65 6e 63 65 73 29 0a 0a 28 64 t-sequences)..(d
7d00: 65 66 69 6e 65 20 28 6e 61 69 76 65 2d 6b 74 68 efine (naive-kth
7d10: 2d 6c 61 72 67 65 73 74 20 63 6f 6d 70 61 72 65 -largest compare
7d20: 20 6b 20 2e 20 78 73 29 0a 20 20 28 6c 65 74 20 k . xs). (let
7d30: 28 28 76 65 63 20 28 6c 69 73 74 2d 3e 76 65 63 ((vec (list->vec
7d40: 74 6f 72 20 78 73 29 29 29 0a 20 20 20 20 3b 20 tor xs))). ;
7d50: 62 75 62 62 6c 65 20 73 6f 72 74 3a 20 73 69 6d bubble sort: sim
7d60: 70 6c 65 2c 20 73 74 61 62 6c 65 2c 20 4f 28 7c ple, stable, O(|
7d70: 78 73 7c 5e 32 29 0a 20 20 20 20 28 64 6f 2d 65 xs|^2). (do-e
7d80: 63 20 28 3a 72 61 6e 67 65 20 6e 20 28 2d 20 28 c (:range n (- (
7d90: 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 76 65 vector-length ve
7da0: 63 29 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 c) 1)).
7db0: 20 20 28 3a 72 61 6e 67 65 20 69 20 30 20 28 2d (:range i 0 (-
7dc0: 20 28 2d 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 (- (vector-leng
7dd0: 74 68 20 76 65 63 29 20 31 29 20 6e 29 29 0a 20 th vec) 1) n)).
7de0: 20 20 20 20 20 20 20 20 20 20 28 69 66 3e 3f 20 (if>?
7df0: 28 63 6f 6d 70 61 72 65 20 28 76 65 63 74 6f 72 (compare (vector
7e00: 2d 72 65 66 20 76 65 63 20 69 29 0a 20 20 20 20 -ref vec i).
7e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e20: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 (vector-re
7e30: 66 20 76 65 63 20 28 2b 20 69 20 31 29 29 29 0a f vec (+ i 1))).
7e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e50: 20 28 6c 65 74 20 28 28 76 65 63 2d 69 20 28 76 (let ((vec-i (v
7e60: 65 63 74 6f 72 2d 72 65 66 20 76 65 63 20 69 29 ector-ref vec i)
7e70: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
7e80: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 (vector-se
7e90: 74 21 20 76 65 63 20 69 20 28 76 65 63 74 6f 72 t! vec i (vector
7ea0: 2d 72 65 66 20 76 65 63 20 28 2b 20 69 20 31 29 -ref vec (+ i 1)
7eb0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
7ec0: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 (vector-se
7ed0: 74 21 20 76 65 63 20 28 2b 20 69 20 31 29 20 76 t! vec (+ i 1) v
7ee0: 65 63 2d 69 29 29 29 29 0a 20 20 20 20 28 76 65 ec-i)))). (ve
7ef0: 63 74 6f 72 2d 72 65 66 20 76 65 63 20 28 6d 6f ctor-ref vec (mo
7f00: 64 75 6c 6f 20 6b 20 28 76 65 63 74 6f 72 2d 6c dulo k (vector-l
7f10: 65 6e 67 74 68 20 76 65 63 29 29 29 29 29 0a 0a ength vec)))))..
7f20: 28 64 65 66 69 6e 65 20 28 63 68 65 63 6b 3a 6b (define (check:k
7f30: 74 68 2d 6c 61 72 67 65 73 74 29 0a 20 20 0a 20 th-largest). .
7f40: 20 3b 20 63 68 65 63 6b 20 65 78 74 65 6e 73 69 ; check extensi
7f50: 76 65 6c 79 20 61 67 61 69 6e 73 74 20 6e 61 69 vely against nai
7f60: 76 65 2d 6b 74 68 2d 6c 61 72 67 65 73 74 0a 20 ve-kth-largest.
7f70: 20 28 6d 79 2d 63 68 65 63 6b 2d 65 63 20 0a 20 (my-check-ec .
7f80: 20 20 28 3a 6c 69 73 74 20 69 6e 70 75 74 20 6b (:list input k
7f90: 74 68 2d 6c 61 72 67 65 73 74 3a 73 65 71 75 65 th-largest:seque
7fa0: 6e 63 65 73 29 0a 20 20 20 28 3a 20 6b 20 28 2d nces). (: k (-
7fb0: 20 2d 32 20 28 6c 65 6e 67 74 68 20 69 6e 70 75 -2 (length inpu
7fc0: 74 29 29 20 28 2b 20 28 6c 65 6e 67 74 68 20 69 t)) (+ (length i
7fd0: 6e 70 75 74 29 20 32 29 29 0a 20 20 20 28 3d 20 nput) 2)). (=
7fe0: 28 61 70 70 6c 79 20 6e 61 69 76 65 2d 6b 74 68 (apply naive-kth
7ff0: 2d 6c 61 72 67 65 73 74 20 63 6f 6c 6c 69 64 69 -largest collidi
8000: 6e 67 2d 63 6f 6d 70 61 72 65 20 6b 20 69 6e 70 ng-compare k inp
8010: 75 74 29 0a 20 20 20 20 20 20 28 61 70 70 6c 79 ut). (apply
8020: 20 6b 74 68 2d 6c 61 72 67 65 73 74 20 63 6f 6c kth-largest col
8030: 6c 69 64 69 6e 67 2d 63 6f 6d 70 61 72 65 20 6b liding-compare k
8040: 20 69 6e 70 75 74 29 29 0a 20 20 20 28 6c 69 73 input)). (lis
8050: 74 20 69 6e 70 75 74 20 6b 29 29 0a 20 20 0a 20 t input k)). .
8060: 20 29 20 3b 63 68 65 63 6b 3a 6b 74 68 2d 6c 61 ) ;check:kth-la
8070: 72 67 65 73 74 0a 0a 3b 20 63 6f 6d 70 61 72 65 rgest..; compare
8080: 2d 62 79 3c 20 65 74 63 2e 20 70 72 6f 63 65 64 -by< etc. proced
8090: 75 72 65 73 0a 0a 28 64 65 66 69 6e 65 20 28 63 ures..(define (c
80a0: 68 65 63 6b 3a 63 6f 6d 70 61 72 65 2d 66 72 6f heck:compare-fro
80b0: 6d 2d 70 72 65 64 69 63 61 74 65 73 29 0a 20 20 m-predicates).
80c0: 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d . (my-check-com
80d0: 70 61 72 65 0a 20 20 20 28 63 6f 6d 70 61 72 65 pare. (compare
80e0: 2d 62 79 3c 20 3c 29 0a 20 20 20 6d 79 2d 69 6e -by< <). my-in
80f0: 74 65 67 65 72 73 29 0a 20 20 0a 20 20 28 6d 79 tegers). . (my
8100: 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 72 65 0a 20 -check-compare.
8110: 20 20 28 63 6f 6d 70 61 72 65 2d 62 79 3e 20 3e (compare-by> >
8120: 29 0a 20 20 20 6d 79 2d 69 6e 74 65 67 65 72 73 ). my-integers
8130: 29 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b ). . (my-check
8140: 2d 63 6f 6d 70 61 72 65 0a 20 20 20 28 63 6f 6d -compare. (com
8150: 70 61 72 65 2d 62 79 3c 3d 20 3c 3d 29 0a 20 20 pare-by<= <=).
8160: 20 6d 79 2d 69 6e 74 65 67 65 72 73 29 0a 20 20 my-integers).
8170: 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d . (my-check-com
8180: 70 61 72 65 0a 20 20 20 28 63 6f 6d 70 61 72 65 pare. (compare
8190: 2d 62 79 3e 3d 20 3e 3d 29 0a 20 20 20 6d 79 2d -by>= >=). my-
81a0: 69 6e 74 65 67 65 72 73 29 0a 20 20 0a 20 20 28 integers). . (
81b0: 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 72 65 my-check-compare
81c0: 0a 20 20 20 28 63 6f 6d 70 61 72 65 2d 62 79 3d . (compare-by=
81d0: 2f 3c 20 3d 20 3c 29 0a 20 20 20 6d 79 2d 69 6e /< = <). my-in
81e0: 74 65 67 65 72 73 29 0a 20 20 0a 20 20 28 6d 79 tegers). . (my
81f0: 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 72 65 0a 20 -check-compare.
8200: 20 20 28 63 6f 6d 70 61 72 65 2d 62 79 3d 2f 3e (compare-by=/>
8210: 20 3d 20 3e 29 0a 20 20 20 6d 79 2d 69 6e 74 65 = >). my-inte
8220: 67 65 72 73 29 0a 20 20 0a 20 20 3b 20 77 69 74 gers). . ; wit
8230: 68 20 65 78 70 6c 69 63 69 74 20 61 72 67 75 6d h explicit argum
8240: 65 6e 74 73 0a 0a 20 20 28 6d 79 2d 63 68 65 63 ents.. (my-chec
8250: 6b 2d 63 6f 6d 70 61 72 65 0a 20 20 20 28 6c 61 k-compare. (la
8260: 6d 62 64 61 20 28 78 20 79 29 20 28 63 6f 6d 70 mbda (x y) (comp
8270: 61 72 65 2d 62 79 3c 20 3c 20 78 20 79 29 29 0a are-by< < x y)).
8280: 20 20 20 6d 79 2d 69 6e 74 65 67 65 72 73 29 0a my-integers).
8290: 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 . (my-check-c
82a0: 6f 6d 70 61 72 65 0a 20 20 20 28 6c 61 6d 62 64 ompare. (lambd
82b0: 61 20 28 78 20 79 29 20 28 63 6f 6d 70 61 72 65 a (x y) (compare
82c0: 2d 62 79 3e 20 3e 20 78 20 79 29 29 0a 20 20 20 -by> > x y)).
82d0: 6d 79 2d 69 6e 74 65 67 65 72 73 29 0a 20 20 0a my-integers). .
82e0: 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 (my-check-comp
82f0: 61 72 65 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 are. (lambda (
8300: 78 20 79 29 20 28 63 6f 6d 70 61 72 65 2d 62 79 x y) (compare-by
8310: 3c 3d 20 3c 3d 20 78 20 79 29 29 0a 20 20 20 6d <= <= x y)). m
8320: 79 2d 69 6e 74 65 67 65 72 73 29 0a 20 20 0a 20 y-integers). .
8330: 20 28 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 (my-check-compa
8340: 72 65 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 78 re. (lambda (x
8350: 20 79 29 20 28 63 6f 6d 70 61 72 65 2d 62 79 3e y) (compare-by>
8360: 3d 20 3e 3d 20 78 20 79 29 29 0a 20 20 20 6d 79 = >= x y)). my
8370: 2d 69 6e 74 65 67 65 72 73 29 0a 20 20 0a 20 20 -integers). .
8380: 28 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 72 (my-check-compar
8390: 65 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 78 20 e. (lambda (x
83a0: 79 29 20 28 63 6f 6d 70 61 72 65 2d 62 79 3d 2f y) (compare-by=/
83b0: 3c 20 3d 20 3c 20 78 20 79 29 29 0a 20 20 20 6d < = < x y)). m
83c0: 79 2d 69 6e 74 65 67 65 72 73 29 0a 20 20 0a 20 y-integers). .
83d0: 20 28 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 (my-check-compa
83e0: 72 65 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 78 re. (lambda (x
83f0: 20 79 29 20 28 63 6f 6d 70 61 72 65 2d 62 79 3d y) (compare-by=
8400: 2f 3e 20 3d 20 3e 20 78 20 79 29 29 0a 20 20 20 /> = > x y)).
8410: 6d 79 2d 69 6e 74 65 67 65 72 73 29 0a 20 20 0a my-integers). .
8420: 20 20 29 20 3b 20 63 68 65 63 6b 3a 63 6f 6d 70 ) ; check:comp
8430: 61 72 65 2d 66 72 6f 6d 2d 70 72 65 64 69 63 61 are-from-predica
8440: 74 65 73 0a 0a 0a 28 64 65 66 69 6e 65 20 28 63 tes...(define (c
8450: 68 65 63 6b 3a 61 74 6f 6d 69 63 29 0a 20 20 0a heck:atomic). .
8460: 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 (my-check-comp
8470: 61 72 65 20 62 6f 6f 6c 65 61 6e 2d 63 6f 6d 70 are boolean-comp
8480: 61 72 65 20 20 20 6d 79 2d 62 6f 6f 6c 65 61 6e are my-boolean
8490: 73 29 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 s). . (my-chec
84a0: 6b 2d 63 6f 6d 70 61 72 65 20 63 68 61 72 2d 63 k-compare char-c
84b0: 6f 6d 70 61 72 65 20 20 20 20 20 20 6d 79 2d 63 ompare my-c
84c0: 68 61 72 73 29 0a 20 20 0a 20 20 28 6d 79 2d 63 hars). . (my-c
84d0: 68 65 63 6b 2d 63 6f 6d 70 61 72 65 20 63 68 61 heck-compare cha
84e0: 72 2d 63 6f 6d 70 61 72 65 2d 63 69 20 20 20 6d r-compare-ci m
84f0: 79 2d 63 68 61 72 73 2d 63 69 29 0a 20 20 0a 20 y-chars-ci). .
8500: 20 28 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 (my-check-compa
8510: 72 65 20 73 74 72 69 6e 67 2d 63 6f 6d 70 61 72 re string-compar
8520: 65 20 20 20 20 6d 79 2d 73 74 72 69 6e 67 73 29 e my-strings)
8530: 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d . . (my-check-
8540: 63 6f 6d 70 61 72 65 20 73 74 72 69 6e 67 2d 63 compare string-c
8550: 6f 6d 70 61 72 65 2d 63 69 20 6d 79 2d 73 74 72 ompare-ci my-str
8560: 69 6e 67 73 2d 63 69 29 0a 20 20 0a 20 20 28 6d ings-ci). . (m
8570: 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 72 65 20 y-check-compare
8580: 73 79 6d 62 6f 6c 2d 63 6f 6d 70 61 72 65 20 20 symbol-compare
8590: 20 20 6d 79 2d 73 79 6d 62 6f 6c 73 29 0a 20 20 my-symbols).
85a0: 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d . (my-check-com
85b0: 70 61 72 65 20 69 6e 74 65 67 65 72 2d 63 6f 6d pare integer-com
85c0: 70 61 72 65 20 20 20 6d 79 2d 69 6e 74 65 67 65 pare my-intege
85d0: 72 73 29 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 rs). . (my-che
85e0: 63 6b 2d 63 6f 6d 70 61 72 65 20 72 61 74 69 6f ck-compare ratio
85f0: 6e 61 6c 2d 63 6f 6d 70 61 72 65 20 20 6d 79 2d nal-compare my-
8600: 72 61 74 69 6f 6e 61 6c 73 29 0a 20 20 0a 20 20 rationals). .
8610: 28 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 72 (my-check-compar
8620: 65 20 72 65 61 6c 2d 63 6f 6d 70 61 72 65 20 20 e real-compare
8630: 20 20 20 20 6d 79 2d 72 65 61 6c 73 29 0a 20 20 my-reals).
8640: 0a 20 20 23 3b 28 6d 79 2d 63 68 65 63 6b 2d 63 . #;(my-check-c
8650: 6f 6d 70 61 72 65 20 63 6f 6d 70 6c 65 78 2d 63 ompare complex-c
8660: 6f 6d 70 61 72 65 20 20 20 6d 79 2d 63 6f 6d 70 ompare my-comp
8670: 6c 65 78 65 73 29 0a 20 20 0a 20 20 23 3b 28 6d lexes). . #;(m
8680: 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 72 65 20 y-check-compare
8690: 6e 75 6d 62 65 72 2d 63 6f 6d 70 61 72 65 20 20 number-compare
86a0: 20 20 6d 79 2d 63 6f 6d 70 6c 65 78 65 73 29 0a my-complexes).
86b0: 20 20 0a 20 20 29 20 3b 20 63 68 65 63 6b 3a 61 . ) ; check:a
86c0: 74 6f 6d 69 63 0a 0a 28 64 65 66 69 6e 65 20 28 tomic..(define (
86d0: 63 68 65 63 6b 3a 72 65 66 69 6e 65 2d 73 65 6c check:refine-sel
86e0: 65 63 74 2d 63 6f 6e 64 29 0a 20 20 0a 20 20 3b ect-cond). . ;
86f0: 20 72 65 66 69 6e 65 2d 63 6f 6d 70 61 72 65 0a refine-compare.
8700: 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 . (my-check-c
8710: 6f 6d 70 61 72 65 0a 20 20 20 28 6c 61 6d 62 64 ompare. (lambd
8720: 61 20 28 78 20 79 29 20 28 72 65 66 69 6e 65 2d a (x y) (refine-
8730: 63 6f 6d 70 61 72 65 29 29 0a 20 20 20 27 28 23 compare)). '(#
8740: 66 29 29 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 f)). . (my-che
8750: 63 6b 2d 63 6f 6d 70 61 72 65 0a 20 20 20 28 6c ck-compare. (l
8760: 61 6d 62 64 61 20 28 78 20 79 29 20 28 72 65 66 ambda (x y) (ref
8770: 69 6e 65 2d 63 6f 6d 70 61 72 65 20 28 69 6e 74 ine-compare (int
8780: 65 67 65 72 2d 63 6f 6d 70 61 72 65 20 78 20 79 eger-compare x y
8790: 29 29 29 0a 20 20 20 6d 79 2d 69 6e 74 65 67 65 ))). my-intege
87a0: 72 73 29 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 rs). . (my-che
87b0: 63 6b 2d 63 6f 6d 70 61 72 65 0a 20 20 20 28 6c ck-compare. (l
87c0: 61 6d 62 64 61 20 28 78 20 79 29 0a 20 20 20 20 ambda (x y).
87d0: 20 28 72 65 66 69 6e 65 2d 63 6f 6d 70 61 72 65 (refine-compare
87e0: 20 28 69 6e 74 65 67 65 72 2d 63 6f 6d 70 61 72 (integer-compar
87f0: 65 20 28 63 61 72 20 78 29 20 28 63 61 72 20 79 e (car x) (car y
8800: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
8810: 20 20 20 20 20 20 20 20 28 73 79 6d 62 6f 6c 2d (symbol-
8820: 63 6f 6d 70 61 72 65 20 20 28 63 64 72 20 78 29 compare (cdr x)
8830: 20 28 63 64 72 20 79 29 29 29 29 0a 20 20 20 27 (cdr y)))). '
8840: 28 28 31 20 2e 20 61 29 20 28 31 20 2e 20 62 29 ((1 . a) (1 . b)
8850: 20 28 32 20 2e 20 62 29 20 28 32 20 2e 20 63 29 (2 . b) (2 . c)
8860: 20 28 33 20 2e 20 61 29 20 28 33 20 2e 20 63 29 (3 . a) (3 . c)
8870: 29 29 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 )). . (my-chec
8880: 6b 2d 63 6f 6d 70 61 72 65 0a 20 20 20 28 6c 61 k-compare. (la
8890: 6d 62 64 61 20 28 78 20 79 29 0a 20 20 20 20 20 mbda (x y).
88a0: 28 72 65 66 69 6e 65 2d 63 6f 6d 70 61 72 65 20 (refine-compare
88b0: 28 69 6e 74 65 67 65 72 2d 63 6f 6d 70 61 72 65 (integer-compare
88c0: 20 28 63 61 72 20 20 20 78 29 20 28 63 61 72 20 (car x) (car
88d0: 20 20 79 29 29 0a 20 20 20 20 20 20 20 20 20 20 y)).
88e0: 20 20 20 20 20 20 20 20 20 20 20 28 73 79 6d 62 (symb
88f0: 6f 6c 2d 63 6f 6d 70 61 72 65 20 20 28 63 61 64 ol-compare (cad
8900: 72 20 20 78 29 20 28 63 61 64 72 20 20 79 29 29 r x) (cadr y))
8910: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8920: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 63 6f (string-co
8930: 6d 70 61 72 65 20 20 28 63 61 64 64 72 20 78 29 mpare (caddr x)
8940: 20 28 63 61 64 64 72 20 79 29 29 29 29 0a 20 20 (caddr y)))).
8950: 20 27 28 28 31 20 61 20 22 61 22 29 20 28 31 20 '((1 a "a") (1
8960: 62 20 22 61 22 29 20 28 31 20 62 20 22 62 22 29 b "a") (1 b "b")
8970: 20 28 32 20 62 20 22 63 22 29 20 28 32 20 63 20 (2 b "c") (2 c
8980: 22 61 22 29 20 28 33 20 61 20 22 62 22 29 20 28 "a") (3 a "b") (
8990: 33 20 63 20 22 62 22 29 29 29 0a 20 20 0a 20 20 3 c "b"))). .
89a0: 3b 20 73 65 6c 65 63 74 2d 63 6f 6d 70 61 72 65 ; select-compare
89b0: 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d . . (my-check-
89c0: 63 6f 6d 70 61 72 65 0a 20 20 20 28 6c 61 6d 62 compare. (lamb
89d0: 64 61 20 28 78 20 79 29 20 28 73 65 6c 65 63 74 da (x y) (select
89e0: 2d 63 6f 6d 70 61 72 65 20 78 20 79 29 29 0a 20 -compare x y)).
89f0: 20 20 27 28 23 66 29 29 0a 20 20 0a 20 20 28 6d '(#f)). . (m
8a00: 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 72 65 0a y-check-compare.
8a10: 20 20 20 28 6c 61 6d 62 64 61 20 28 78 20 79 29 (lambda (x y)
8a20: 0a 20 20 20 20 20 28 73 65 6c 65 63 74 2d 63 6f . (select-co
8a30: 6d 70 61 72 65 20 78 20 79 20 0a 20 20 20 20 20 mpare x y .
8a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a50: 28 69 6e 74 65 67 65 72 3f 20 28 63 69 20 78 20 (integer? (ci x
8a60: 79 29 29 29 29 0a 20 20 20 6d 79 2d 69 6e 74 65 y)))). my-inte
8a70: 67 65 72 73 29 0a 20 20 0a 20 20 28 6d 79 2d 63 gers). . (my-c
8a80: 68 65 63 6b 2d 63 6f 6d 70 61 72 65 0a 20 20 20 heck-compare.
8a90: 28 6c 61 6d 62 64 61 20 28 78 20 79 29 0a 20 20 (lambda (x y).
8aa0: 20 20 20 28 73 65 6c 65 63 74 2d 63 6f 6d 70 61 (select-compa
8ab0: 72 65 20 78 20 79 20 0a 20 20 20 20 20 20 20 20 re x y .
8ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70 61 (pa
8ad0: 69 72 3f 20 28 69 6e 74 65 67 65 72 2d 63 6f 6d ir? (integer-com
8ae0: 70 61 72 65 20 28 63 61 72 20 78 29 20 28 63 61 pare (car x) (ca
8af0: 72 20 79 29 29 0a 20 20 20 20 20 20 20 20 20 20 r y)).
8b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8b10: 20 20 28 73 79 6d 62 6f 6c 2d 63 6f 6d 70 61 72 (symbol-compar
8b20: 65 20 20 28 63 64 72 20 78 29 20 28 63 64 72 20 e (cdr x) (cdr
8b30: 79 29 29 29 29 29 0a 20 20 20 27 28 28 31 20 2e y))))). '((1 .
8b40: 20 61 29 20 28 31 20 2e 20 62 29 20 28 32 20 2e a) (1 . b) (2 .
8b50: 20 62 29 20 28 32 20 2e 20 63 29 20 28 33 20 2e b) (2 . c) (3 .
8b60: 20 61 29 20 28 33 20 2e 20 63 29 29 29 0a 20 20 a) (3 . c))).
8b70: 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d . (my-check-com
8b80: 70 61 72 65 0a 20 20 20 28 6c 61 6d 62 64 61 20 pare. (lambda
8b90: 28 78 20 79 29 0a 20 20 20 20 20 28 73 65 6c 65 (x y). (sele
8ba0: 63 74 2d 63 6f 6d 70 61 72 65 20 78 20 79 20 0a ct-compare x y .
8bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8bc0: 20 20 20 20 20 28 65 6c 73 65 20 28 69 6e 74 65 (else (inte
8bd0: 67 65 72 2d 63 6f 6d 70 61 72 65 20 78 20 79 29 ger-compare x y)
8be0: 29 29 29 0a 20 20 20 6d 79 2d 69 6e 74 65 67 65 ))). my-intege
8bf0: 72 73 29 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 rs). . (my-che
8c00: 63 6b 2d 63 6f 6d 70 61 72 65 0a 20 20 20 28 6c ck-compare. (l
8c10: 61 6d 62 64 61 20 28 78 20 79 29 0a 20 20 20 20 ambda (x y).
8c20: 20 28 73 65 6c 65 63 74 2d 63 6f 6d 70 61 72 65 (select-compare
8c30: 20 78 20 79 20 0a 20 20 20 20 20 20 20 20 20 20 x y .
8c40: 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 (else
8c50: 20 28 69 6e 74 65 67 65 72 2d 63 6f 6d 70 61 72 (integer-compar
8c60: 65 20 28 63 61 72 20 78 29 20 28 63 61 72 20 79 e (car x) (car y
8c70: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
8c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
8c90: 79 6d 62 6f 6c 2d 63 6f 6d 70 61 72 65 20 20 28 ymbol-compare (
8ca0: 63 64 72 20 78 29 20 28 63 64 72 20 79 29 29 29 cdr x) (cdr y)))
8cb0: 29 29 0a 20 20 20 27 28 28 31 20 2e 20 61 29 20 )). '((1 . a)
8cc0: 28 31 20 2e 20 62 29 20 28 32 20 2e 20 62 29 20 (1 . b) (2 . b)
8cd0: 28 32 20 2e 20 63 29 20 28 33 20 2e 20 61 29 20 (2 . c) (3 . a)
8ce0: 28 33 20 2e 20 63 29 29 29 0a 20 20 0a 20 20 28 (3 . c))). . (
8cf0: 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 72 65 my-check-compare
8d00: 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 78 20 79 . (lambda (x y
8d10: 29 0a 20 20 20 20 20 28 73 65 6c 65 63 74 2d 63 ). (select-c
8d20: 6f 6d 70 61 72 65 20 78 20 79 0a 20 20 20 20 20 ompare x y.
8d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d40: 28 73 79 6d 62 6f 6c 3f 20 28 73 79 6d 62 6f 6c (symbol? (symbol
8d50: 2d 63 6f 6d 70 61 72 65 20 78 20 79 29 29 0a 20 -compare x y)).
8d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d70: 20 20 20 20 28 73 74 72 69 6e 67 3f 20 28 73 74 (string? (st
8d80: 72 69 6e 67 2d 63 6f 6d 70 61 72 65 20 78 20 79 ring-compare x y
8d90: 29 29 29 29 0a 20 20 20 27 28 61 20 62 20 63 20 )))). '(a b c
8da0: 22 61 22 20 22 62 22 20 22 63 22 20 31 29 29 20 "a" "b" "c" 1))
8db0: 3b 20 69 6d 70 6c 69 63 69 74 20 28 65 6c 73 65 ; implicit (else
8dc0: 20 30 29 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 0). . (my-che
8dd0: 63 6b 2d 63 6f 6d 70 61 72 65 0a 20 20 20 28 6c ck-compare. (l
8de0: 61 6d 62 64 61 20 28 78 20 79 29 0a 20 20 20 20 ambda (x y).
8df0: 20 28 73 65 6c 65 63 74 2d 63 6f 6d 70 61 72 65 (select-compare
8e00: 20 78 20 79 0a 20 20 20 20 20 20 20 20 20 20 20 x y.
8e10: 20 20 20 20 20 20 20 20 20 20 28 73 79 6d 62 6f (symbo
8e20: 6c 3f 20 28 73 79 6d 62 6f 6c 2d 63 6f 6d 70 61 l? (symbol-compa
8e30: 72 65 20 78 20 79 29 29 0a 20 20 20 20 20 20 20 re x y)).
8e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
8e50: 6c 73 65 20 20 20 20 28 73 74 72 69 6e 67 2d 63 lse (string-c
8e60: 6f 6d 70 61 72 65 20 78 20 79 29 29 29 29 0a 20 ompare x y)))).
8e70: 20 20 27 28 61 20 62 20 63 20 22 61 22 20 22 62 '(a b c "a" "b
8e80: 22 20 22 63 22 29 29 0a 20 20 0a 20 20 3b 20 74 " "c")). . ; t
8e90: 65 73 74 20 69 66 20 61 72 67 75 6d 65 6e 74 73 est if arguments
8ea0: 20 61 72 65 20 6f 6e 6c 79 20 65 76 61 6c 75 61 are only evalua
8eb0: 74 65 64 20 6f 6e 63 65 0a 20 20 0a 20 20 28 6d ted once. . (m
8ec0: 79 2d 63 68 65 63 6b 0a 20 20 20 28 6c 65 74 20 y-check. (let
8ed0: 28 28 6e 78 20 30 29 20 28 6e 79 20 30 29 20 28 ((nx 0) (ny 0) (
8ee0: 6e 74 20 30 29 29 0a 20 20 20 20 20 28 73 65 6c nt 0)). (sel
8ef0: 65 63 74 2d 63 6f 6d 70 61 72 65 20 28 62 65 67 ect-compare (beg
8f00: 69 6e 20 28 73 65 74 21 20 6e 78 20 28 2b 20 6e in (set! nx (+ n
8f10: 78 20 31 29 29 20 31 29 0a 20 20 20 20 20 20 20 x 1)) 1).
8f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 (b
8f30: 65 67 69 6e 20 28 73 65 74 21 20 6e 79 20 28 2b egin (set! ny (+
8f40: 20 6e 79 20 31 29 29 20 32 29 0a 20 20 20 20 20 ny 1)) 2).
8f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f60: 28 28 6c 61 6d 62 64 61 20 28 7a 29 20 28 73 65 ((lambda (z) (se
8f70: 74 21 20 6e 74 20 28 2b 20 6e 74 20 20 20 31 29 t! nt (+ nt 1)
8f80: 29 20 23 66 29 20 30 29 0a 20 20 20 20 20 20 20 ) #f) 0).
8f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
8fa0: 6c 61 6d 62 64 61 20 28 7a 29 20 28 73 65 74 21 lambda (z) (set!
8fb0: 20 6e 74 20 28 2b 20 6e 74 20 20 31 30 29 29 20 nt (+ nt 10))
8fc0: 23 66 29 20 30 29 0a 20 20 20 20 20 20 20 20 20 #f) 0).
8fd0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6c 61 ((la
8fe0: 6d 62 64 61 20 28 7a 29 20 28 73 65 74 21 20 6e mbda (z) (set! n
8ff0: 74 20 28 2b 20 6e 74 20 31 30 30 29 29 20 23 66 t (+ nt 100)) #f
9000: 29 20 30 29 0a 20 20 20 20 20 20 20 20 20 20 20 ) 0).
9010: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 (else
9020: 30 29 29 0a 20 20 20 20 20 28 6c 69 73 74 20 6e 0)). (list n
9030: 78 20 6e 79 20 6e 74 29 29 0a 20 20 20 3d 3e 20 x ny nt)). =>
9040: 27 28 31 20 31 20 32 32 32 29 29 0a 20 20 0a 20 '(1 1 222)). .
9050: 20 3b 20 63 6f 6e 64 2d 63 6f 6d 70 61 72 65 0a ; cond-compare.
9060: 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 . (my-check-c
9070: 6f 6d 70 61 72 65 0a 20 20 20 28 6c 61 6d 62 64 ompare. (lambd
9080: 61 20 28 78 20 79 29 20 28 63 6f 6e 64 2d 63 6f a (x y) (cond-co
9090: 6d 70 61 72 65 29 29 0a 20 20 20 27 28 23 66 29 mpare)). '(#f)
90a0: 29 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b ). . (my-check
90b0: 2d 63 6f 6d 70 61 72 65 0a 20 20 20 28 6c 61 6d -compare. (lam
90c0: 62 64 61 20 28 78 20 79 29 20 0a 20 20 20 20 20 bda (x y) .
90d0: 28 63 6f 6e 64 2d 63 6f 6d 70 61 72 65 20 0a 20 (cond-compare .
90e0: 20 20 20 20 20 28 28 28 69 6e 74 65 67 65 72 3f (((integer?
90f0: 20 78 29 20 28 69 6e 74 65 67 65 72 3f 20 79 29 x) (integer? y)
9100: 29 20 28 69 6e 74 65 67 65 72 2d 63 6f 6d 70 61 ) (integer-compa
9110: 72 65 20 78 20 79 29 29 29 29 0a 20 20 20 6d 79 re x y)))). my
9120: 2d 69 6e 74 65 67 65 72 73 29 0a 20 20 0a 20 20 -integers). .
9130: 28 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 72 (my-check-compar
9140: 65 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 78 20 e. (lambda (x
9150: 79 29 20 0a 20 20 20 20 20 28 63 6f 6e 64 2d 63 y) . (cond-c
9160: 6f 6d 70 61 72 65 20 0a 20 20 20 20 20 20 28 28 ompare . ((
9170: 28 70 61 69 72 3f 20 78 29 20 28 70 61 69 72 3f (pair? x) (pair?
9180: 20 79 29 29 20 28 69 6e 74 65 67 65 72 2d 63 6f y)) (integer-co
9190: 6d 70 61 72 65 20 28 63 61 72 20 78 29 20 28 63 mpare (car x) (c
91a0: 61 72 20 79 29 29 0a 20 20 20 20 20 20 20 20 20 ar y)).
91b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
91c0: 20 20 20 20 28 73 79 6d 62 6f 6c 2d 63 6f 6d 70 (symbol-comp
91d0: 61 72 65 20 20 28 63 64 72 20 78 29 20 28 63 64 are (cdr x) (cd
91e0: 72 20 79 29 29 29 29 29 0a 20 20 20 27 28 28 31 r y))))). '((1
91f0: 20 2e 20 61 29 20 28 31 20 2e 20 62 29 20 28 32 . a) (1 . b) (2
9200: 20 2e 20 62 29 20 28 32 20 2e 20 63 29 20 28 33 . b) (2 . c) (3
9210: 20 2e 20 61 29 20 28 33 20 2e 20 63 29 29 29 0a . a) (3 . c))).
9220: 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 . (my-check-c
9230: 6f 6d 70 61 72 65 0a 20 20 20 28 6c 61 6d 62 64 ompare. (lambd
9240: 61 20 28 78 20 79 29 0a 20 20 20 20 20 28 63 6f a (x y). (co
9250: 6e 64 2d 63 6f 6d 70 61 72 65 0a 20 20 20 20 20 nd-compare.
9260: 20 28 65 6c 73 65 20 28 69 6e 74 65 67 65 72 2d (else (integer-
9270: 63 6f 6d 70 61 72 65 20 78 20 79 29 29 29 29 0a compare x y)))).
9280: 20 20 20 6d 79 2d 69 6e 74 65 67 65 72 73 29 0a my-integers).
9290: 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 . (my-check-c
92a0: 6f 6d 70 61 72 65 0a 20 20 20 28 6c 61 6d 62 64 ompare. (lambd
92b0: 61 20 28 78 20 79 29 20 0a 20 20 20 20 20 28 63 a (x y) . (c
92c0: 6f 6e 64 2d 63 6f 6d 70 61 72 65 20 0a 20 20 20 ond-compare .
92d0: 20 20 20 28 65 6c 73 65 20 28 69 6e 74 65 67 65 (else (intege
92e0: 72 2d 63 6f 6d 70 61 72 65 20 28 63 61 72 20 78 r-compare (car x
92f0: 29 20 28 63 61 72 20 79 29 29 0a 20 20 20 20 20 ) (car y)).
9300: 20 20 20 20 20 20 20 28 73 79 6d 62 6f 6c 2d 63 (symbol-c
9310: 6f 6d 70 61 72 65 20 20 28 63 64 72 20 78 29 20 ompare (cdr x)
9320: 28 63 64 72 20 79 29 29 29 29 29 0a 20 20 20 27 (cdr y))))). '
9330: 28 28 31 20 2e 20 61 29 20 28 31 20 2e 20 62 29 ((1 . a) (1 . b)
9340: 20 28 32 20 2e 20 62 29 20 28 32 20 2e 20 63 29 (2 . b) (2 . c)
9350: 20 28 33 20 2e 20 61 29 20 28 33 20 2e 20 63 29 (3 . a) (3 . c)
9360: 29 29 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 )). . (my-chec
9370: 6b 2d 63 6f 6d 70 61 72 65 0a 20 20 20 28 6c 61 k-compare. (la
9380: 6d 62 64 61 20 28 78 20 79 29 0a 20 20 20 20 20 mbda (x y).
9390: 28 63 6f 6e 64 2d 63 6f 6d 70 61 72 65 20 0a 20 (cond-compare .
93a0: 20 20 20 20 20 28 28 28 73 79 6d 62 6f 6c 3f 20 (((symbol?
93b0: 78 29 20 28 73 79 6d 62 6f 6c 3f 20 79 29 29 20 x) (symbol? y))
93c0: 28 73 79 6d 62 6f 6c 2d 63 6f 6d 70 61 72 65 20 (symbol-compare
93d0: 78 20 79 29 29 0a 20 20 20 20 20 20 28 28 28 73 x y)). (((s
93e0: 74 72 69 6e 67 3f 20 78 29 20 28 73 74 72 69 6e tring? x) (strin
93f0: 67 3f 20 79 29 29 20 28 73 74 72 69 6e 67 2d 63 g? y)) (string-c
9400: 6f 6d 70 61 72 65 20 78 20 79 29 29 29 29 0a 20 ompare x y)))).
9410: 20 20 27 28 61 20 62 20 63 20 22 61 22 20 22 62 '(a b c "a" "b
9420: 22 20 22 63 22 20 31 29 29 20 3b 20 69 6d 70 6c " "c" 1)) ; impl
9430: 69 63 69 74 20 28 65 6c 73 65 20 30 29 0a 20 20 icit (else 0).
9440: 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d . (my-check-com
9450: 70 61 72 65 0a 20 20 20 28 6c 61 6d 62 64 61 20 pare. (lambda
9460: 28 78 20 79 29 0a 20 20 20 20 20 28 63 6f 6e 64 (x y). (cond
9470: 2d 63 6f 6d 70 61 72 65 20 0a 20 20 20 20 20 20 -compare .
9480: 28 28 28 73 79 6d 62 6f 6c 3f 20 78 29 20 28 73 (((symbol? x) (s
9490: 79 6d 62 6f 6c 3f 20 79 29 29 20 28 73 79 6d 62 ymbol? y)) (symb
94a0: 6f 6c 2d 63 6f 6d 70 61 72 65 20 78 20 79 29 29 ol-compare x y))
94b0: 0a 20 20 20 20 20 20 28 65 6c 73 65 20 20 20 20 . (else
94c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
94d0: 20 20 28 73 74 72 69 6e 67 2d 63 6f 6d 70 61 72 (string-compar
94e0: 65 20 78 20 79 29 29 29 29 0a 20 20 20 27 28 61 e x y)))). '(a
94f0: 20 62 20 63 20 22 61 22 20 22 62 22 20 22 63 22 b c "a" "b" "c"
9500: 29 29 0a 20 20 0a 20 20 29 20 3b 20 63 68 65 63 )). . ) ; chec
9510: 6b 3a 72 65 66 69 6e 65 2d 73 65 6c 65 63 74 2d k:refine-select-
9520: 63 6f 6e 64 0a 0a 0a 3b 20 57 65 20 64 65 66 69 cond...; We defi
9530: 6e 65 20 6f 75 72 20 6f 77 6e 20 6c 69 73 74 2f ne our own list/
9540: 76 65 63 74 6f 72 20 64 61 74 61 20 73 74 72 75 vector data stru
9550: 63 74 75 72 65 0a 3b 20 61 73 20 27 28 6d 79 2d cture.; as '(my-
9560: 6c 69 73 74 20 78 5b 31 5d 20 2e 2e 20 78 5b 6e list x[1] .. x[n
9570: 5d 29 2c 20 6e 20 3e 3d 20 30 2c 20 69 6e 20 6f ]), n >= 0, in o
9580: 72 64 65 72 0a 3b 20 74 6f 20 6d 61 6b 65 20 73 rder.; to make s
9590: 75 72 65 20 74 68 65 20 64 65 66 61 75 6c 74 20 ure the default
95a0: 6f 70 73 20 64 6f 6e 27 74 20 77 6f 72 6b 20 6f ops don't work o
95b0: 6e 20 69 74 2e 0a 0a 28 64 65 66 69 6e 65 20 28 n it...(define (
95c0: 6d 79 2d 6c 69 73 74 2d 63 68 65 63 6b 65 64 20 my-list-checked
95d0: 6f 62 6a 29 20 0a 20 20 28 69 66 20 28 61 6e 64 obj) . (if (and
95e0: 20 28 6c 69 73 74 3f 20 6f 62 6a 29 20 28 65 71 (list? obj) (eq
95f0: 76 3f 20 28 63 61 72 20 6f 62 6a 29 20 27 6d 79 v? (car obj) 'my
9600: 2d 6c 69 73 74 29 29 0a 20 20 20 20 20 20 6f 62 -list)). ob
9610: 6a 0a 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 j. (error "
9620: 65 78 70 65 63 74 65 64 20 6d 79 2d 6c 69 73 74 expected my-list
9630: 20 62 75 74 20 72 65 63 65 69 76 65 64 22 20 6f but received" o
9640: 62 6a 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 bj)))..(define (
9650: 6c 69 73 74 2d 3e 6d 79 2d 6c 69 73 74 20 6c 69 list->my-list li
9660: 73 74 29 20 28 63 6f 6e 73 20 27 6d 79 2d 6c 69 st) (cons 'my-li
9670: 73 74 20 6c 69 73 74 29 29 0a 28 64 65 66 69 6e st list)).(defin
9680: 65 20 28 6d 79 2d 65 6d 70 74 79 3f 20 78 29 20 e (my-empty? x)
9690: 20 20 20 20 20 20 20 28 6e 75 6c 6c 3f 20 28 63 (null? (c
96a0: 64 72 20 28 6d 79 2d 6c 69 73 74 2d 63 68 65 63 dr (my-list-chec
96b0: 6b 65 64 20 78 29 29 29 29 0a 28 64 65 66 69 6e ked x)))).(defin
96c0: 65 20 28 6d 79 2d 68 65 61 64 20 78 29 20 20 20 e (my-head x)
96d0: 20 20 20 20 20 20 20 28 63 61 64 72 20 28 6d 79 (cadr (my
96e0: 2d 6c 69 73 74 2d 63 68 65 63 6b 65 64 20 78 29 -list-checked x)
96f0: 29 29 0a 28 64 65 66 69 6e 65 20 28 6d 79 2d 74 )).(define (my-t
9700: 61 69 6c 20 78 29 20 20 20 20 20 20 20 20 20 20 ail x)
9710: 28 63 6f 6e 73 20 27 6d 79 2d 6c 69 73 74 20 28 (cons 'my-list (
9720: 63 64 64 72 20 28 6d 79 2d 6c 69 73 74 2d 63 68 cddr (my-list-ch
9730: 65 63 6b 65 64 20 78 29 29 29 29 0a 28 64 65 66 ecked x)))).(def
9740: 69 6e 65 20 28 6d 79 2d 73 69 7a 65 20 78 29 20 ine (my-size x)
9750: 20 20 20 20 20 20 20 20 20 28 2d 20 28 6c 65 6e (- (len
9760: 67 74 68 20 28 6d 79 2d 6c 69 73 74 2d 63 68 65 gth (my-list-che
9770: 63 6b 65 64 20 78 29 29 20 31 29 29 0a 28 64 65 cked x)) 1)).(de
9780: 66 69 6e 65 20 28 6d 79 2d 72 65 66 20 78 20 69 fine (my-ref x i
9790: 29 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 2d ) (list-
97a0: 72 65 66 20 28 6d 79 2d 6c 69 73 74 2d 63 68 65 ref (my-list-che
97b0: 63 6b 65 64 20 78 29 20 28 2b 20 69 20 31 29 29 cked x) (+ i 1))
97c0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 68 65 63 )..(define (chec
97d0: 6b 3a 64 61 74 61 2d 73 74 72 75 63 74 75 72 65 k:data-structure
97e0: 73 29 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 s). . (my-chec
97f0: 6b 2d 63 6f 6d 70 61 72 65 0a 20 20 20 28 70 61 k-compare. (pa
9800: 69 72 2d 63 6f 6d 70 61 72 65 2d 63 61 72 20 63 ir-compare-car c
9810: 69 29 0a 20 20 20 27 28 28 31 20 2e 20 62 29 20 i). '((1 . b)
9820: 28 32 20 2e 20 61 29 20 28 33 20 2e 20 63 29 29 (2 . a) (3 . c))
9830: 29 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b ). . (my-check
9840: 2d 63 6f 6d 70 61 72 65 0a 20 20 20 28 70 61 69 -compare. (pai
9850: 72 2d 63 6f 6d 70 61 72 65 2d 63 64 72 20 63 69 r-compare-cdr ci
9860: 29 0a 20 20 20 27 28 28 62 20 2e 20 31 29 20 28 ). '((b . 1) (
9870: 61 20 2e 20 32 29 20 28 63 20 2e 20 33 29 29 29 a . 2) (c . 3)))
9880: 0a 20 20 0a 20 20 3b 20 70 61 69 72 2d 63 6f 6d . . ; pair-com
9890: 70 61 72 65 0a 20 20 0a 20 20 28 6d 79 2d 63 68 pare. . (my-ch
98a0: 65 63 6b 2d 63 6f 6d 70 61 72 65 20 70 61 69 72 eck-compare pair
98b0: 2d 63 6f 6d 70 61 72 65 20 6d 79 2d 6e 75 6c 6c -compare my-null
98c0: 2d 6f 72 2d 70 61 69 72 73 29 0a 20 20 0a 20 20 -or-pairs). .
98d0: 28 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 72 (my-check-compar
98e0: 65 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 78 20 e. (lambda (x
98f0: 79 29 20 28 70 61 69 72 2d 63 6f 6d 70 61 72 65 y) (pair-compare
9900: 20 63 69 20 78 20 79 29 29 0a 20 20 20 6d 79 2d ci x y)). my-
9910: 6e 75 6c 6c 2d 6f 72 2d 70 61 69 72 73 29 0a 20 null-or-pairs).
9920: 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 6f . (my-check-co
9930: 6d 70 61 72 65 0a 20 20 20 28 6c 61 6d 62 64 61 mpare. (lambda
9940: 20 28 78 20 79 29 20 28 70 61 69 72 2d 63 6f 6d (x y) (pair-com
9950: 70 61 72 65 20 63 69 20 73 79 6d 62 6f 6c 2d 63 pare ci symbol-c
9960: 6f 6d 70 61 72 65 20 78 20 79 29 29 0a 20 20 20 ompare x y)).
9970: 27 28 28 31 20 2e 20 61 29 20 28 31 20 2e 20 62 '((1 . a) (1 . b
9980: 29 20 28 32 20 2e 20 62 29 20 28 32 20 2e 20 63 ) (2 . b) (2 . c
9990: 29 20 28 33 20 2e 20 61 29 29 29 0a 20 20 0a 20 ) (3 . a))). .
99a0: 20 3b 20 6c 69 73 74 2d 63 6f 6d 70 61 72 65 0a ; list-compare.
99b0: 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 . (my-check-c
99c0: 6f 6d 70 61 72 65 20 6c 69 73 74 2d 63 6f 6d 70 ompare list-comp
99d0: 61 72 65 20 6d 79 2d 6c 69 73 74 73 29 0a 20 20 are my-lists).
99e0: 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d . (my-check-com
99f0: 70 61 72 65 0a 20 20 20 28 6c 61 6d 62 64 61 20 pare. (lambda
9a00: 28 78 20 79 29 20 28 6c 69 73 74 2d 63 6f 6d 70 (x y) (list-comp
9a10: 61 72 65 20 63 69 20 78 20 79 29 29 0a 20 20 20 are ci x y)).
9a20: 6d 79 2d 6c 69 73 74 73 29 0a 20 20 0a 20 20 28 my-lists). . (
9a30: 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 72 65 my-check-compare
9a40: 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 78 20 79 . (lambda (x y
9a50: 29 20 28 6c 69 73 74 2d 63 6f 6d 70 61 72 65 20 ) (list-compare
9a60: 78 20 79 20 6d 79 2d 65 6d 70 74 79 3f 20 6d 79 x y my-empty? my
9a70: 2d 68 65 61 64 20 6d 79 2d 74 61 69 6c 29 29 0a -head my-tail)).
9a80: 20 20 20 28 6d 61 70 20 6c 69 73 74 2d 3e 6d 79 (map list->my
9a90: 2d 6c 69 73 74 20 6d 79 2d 6c 69 73 74 73 29 29 -list my-lists))
9aa0: 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d . . (my-check-
9ab0: 63 6f 6d 70 61 72 65 0a 20 20 20 28 6c 61 6d 62 compare. (lamb
9ac0: 64 61 20 28 78 20 79 29 20 28 6c 69 73 74 2d 63 da (x y) (list-c
9ad0: 6f 6d 70 61 72 65 20 63 69 20 78 20 79 20 6d 79 ompare ci x y my
9ae0: 2d 65 6d 70 74 79 3f 20 6d 79 2d 68 65 61 64 20 -empty? my-head
9af0: 6d 79 2d 74 61 69 6c 29 29 0a 20 20 20 28 6d 61 my-tail)). (ma
9b00: 70 20 6c 69 73 74 2d 3e 6d 79 2d 6c 69 73 74 20 p list->my-list
9b10: 6d 79 2d 6c 69 73 74 73 29 29 0a 20 20 0a 20 20 my-lists)). .
9b20: 3b 20 6c 69 73 74 2d 63 6f 6d 70 61 72 65 2d 61 ; list-compare-a
9b30: 73 2d 76 65 63 74 6f 72 0a 20 20 0a 20 20 28 6d s-vector. . (m
9b40: 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 72 65 20 y-check-compare
9b50: 6c 69 73 74 2d 63 6f 6d 70 61 72 65 2d 61 73 2d list-compare-as-
9b60: 76 65 63 74 6f 72 20 6d 79 2d 6c 69 73 74 2d 61 vector my-list-a
9b70: 73 2d 76 65 63 74 6f 72 73 29 0a 20 20 0a 20 20 s-vectors). .
9b80: 28 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 72 (my-check-compar
9b90: 65 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 78 20 e. (lambda (x
9ba0: 79 29 20 28 6c 69 73 74 2d 63 6f 6d 70 61 72 65 y) (list-compare
9bb0: 2d 61 73 2d 76 65 63 74 6f 72 20 63 69 20 78 20 -as-vector ci x
9bc0: 79 29 29 0a 20 20 20 6d 79 2d 6c 69 73 74 2d 61 y)). my-list-a
9bd0: 73 2d 76 65 63 74 6f 72 73 29 0a 20 20 0a 20 20 s-vectors). .
9be0: 28 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 72 (my-check-compar
9bf0: 65 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 78 20 e. (lambda (x
9c00: 79 29 20 28 6c 69 73 74 2d 63 6f 6d 70 61 72 65 y) (list-compare
9c10: 2d 61 73 2d 76 65 63 74 6f 72 20 78 20 79 20 6d -as-vector x y m
9c20: 79 2d 65 6d 70 74 79 3f 20 6d 79 2d 68 65 61 64 y-empty? my-head
9c30: 20 6d 79 2d 74 61 69 6c 29 29 0a 20 20 20 28 6d my-tail)). (m
9c40: 61 70 20 6c 69 73 74 2d 3e 6d 79 2d 6c 69 73 74 ap list->my-list
9c50: 20 6d 79 2d 6c 69 73 74 2d 61 73 2d 76 65 63 74 my-list-as-vect
9c60: 6f 72 73 29 29 0a 20 20 0a 20 20 28 6d 79 2d 63 ors)). . (my-c
9c70: 68 65 63 6b 2d 63 6f 6d 70 61 72 65 0a 20 20 20 heck-compare.
9c80: 28 6c 61 6d 62 64 61 20 28 78 20 79 29 20 28 6c (lambda (x y) (l
9c90: 69 73 74 2d 63 6f 6d 70 61 72 65 2d 61 73 2d 76 ist-compare-as-v
9ca0: 65 63 74 6f 72 20 63 69 20 78 20 79 20 6d 79 2d ector ci x y my-
9cb0: 65 6d 70 74 79 3f 20 6d 79 2d 68 65 61 64 20 6d empty? my-head m
9cc0: 79 2d 74 61 69 6c 29 29 0a 20 20 20 28 6d 61 70 y-tail)). (map
9cd0: 20 6c 69 73 74 2d 3e 6d 79 2d 6c 69 73 74 20 6d list->my-list m
9ce0: 79 2d 6c 69 73 74 2d 61 73 2d 76 65 63 74 6f 72 y-list-as-vector
9cf0: 73 29 29 0a 20 20 0a 20 20 3b 20 76 65 63 74 6f s)). . ; vecto
9d00: 72 2d 63 6f 6d 70 61 72 65 0a 20 20 0a 20 20 28 r-compare. . (
9d10: 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 72 65 my-check-compare
9d20: 20 76 65 63 74 6f 72 2d 63 6f 6d 70 61 72 65 20 vector-compare
9d30: 6d 79 2d 76 65 63 74 6f 72 73 29 0a 20 20 0a 20 my-vectors). .
9d40: 20 28 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 (my-check-compa
9d50: 72 65 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 78 re. (lambda (x
9d60: 20 79 29 20 28 76 65 63 74 6f 72 2d 63 6f 6d 70 y) (vector-comp
9d70: 61 72 65 20 63 69 20 78 20 79 29 29 0a 20 20 20 are ci x y)).
9d80: 6d 79 2d 76 65 63 74 6f 72 73 29 0a 20 20 0a 20 my-vectors). .
9d90: 20 28 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 (my-check-compa
9da0: 72 65 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 78 re. (lambda (x
9db0: 20 79 29 20 28 76 65 63 74 6f 72 2d 63 6f 6d 70 y) (vector-comp
9dc0: 61 72 65 20 78 20 79 20 6d 79 2d 73 69 7a 65 20 are x y my-size
9dd0: 6d 79 2d 72 65 66 29 29 0a 20 20 20 28 6d 61 70 my-ref)). (map
9de0: 20 6c 69 73 74 2d 3e 6d 79 2d 6c 69 73 74 20 6d list->my-list m
9df0: 79 2d 6c 69 73 74 2d 61 73 2d 76 65 63 74 6f 72 y-list-as-vector
9e00: 73 29 29 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 s)). . (my-che
9e10: 63 6b 2d 63 6f 6d 70 61 72 65 0a 20 20 20 28 6c ck-compare. (l
9e20: 61 6d 62 64 61 20 28 78 20 79 29 20 28 76 65 63 ambda (x y) (vec
9e30: 74 6f 72 2d 63 6f 6d 70 61 72 65 20 63 69 20 78 tor-compare ci x
9e40: 20 79 20 6d 79 2d 73 69 7a 65 20 6d 79 2d 72 65 y my-size my-re
9e50: 66 29 29 0a 20 20 20 28 6d 61 70 20 6c 69 73 74 f)). (map list
9e60: 2d 3e 6d 79 2d 6c 69 73 74 20 6d 79 2d 6c 69 73 ->my-list my-lis
9e70: 74 2d 61 73 2d 76 65 63 74 6f 72 73 29 29 0a 20 t-as-vectors)).
9e80: 20 0a 20 20 3b 20 76 65 63 74 6f 72 2d 63 6f 6d . ; vector-com
9e90: 70 61 72 65 2d 61 73 2d 6c 69 73 74 0a 20 20 0a pare-as-list. .
9ea0: 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 (my-check-comp
9eb0: 61 72 65 20 76 65 63 74 6f 72 2d 63 6f 6d 70 61 are vector-compa
9ec0: 72 65 2d 61 73 2d 6c 69 73 74 20 6d 79 2d 76 65 re-as-list my-ve
9ed0: 63 74 6f 72 2d 61 73 2d 6c 69 73 74 73 29 0a 20 ctor-as-lists).
9ee0: 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 6f . (my-check-co
9ef0: 6d 70 61 72 65 0a 20 20 20 28 6c 61 6d 62 64 61 mpare. (lambda
9f00: 20 28 78 20 79 29 20 28 76 65 63 74 6f 72 2d 63 (x y) (vector-c
9f10: 6f 6d 70 61 72 65 2d 61 73 2d 6c 69 73 74 20 63 ompare-as-list c
9f20: 69 20 78 20 79 29 29 0a 20 20 20 6d 79 2d 76 65 i x y)). my-ve
9f30: 63 74 6f 72 2d 61 73 2d 6c 69 73 74 73 29 0a 20 ctor-as-lists).
9f40: 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 6f . (my-check-co
9f50: 6d 70 61 72 65 0a 20 20 20 28 6c 61 6d 62 64 61 mpare. (lambda
9f60: 20 28 78 20 79 29 20 28 76 65 63 74 6f 72 2d 63 (x y) (vector-c
9f70: 6f 6d 70 61 72 65 2d 61 73 2d 6c 69 73 74 20 78 ompare-as-list x
9f80: 20 79 20 6d 79 2d 73 69 7a 65 20 6d 79 2d 72 65 y my-size my-re
9f90: 66 29 29 0a 20 20 20 28 6d 61 70 20 6c 69 73 74 f)). (map list
9fa0: 2d 3e 6d 79 2d 6c 69 73 74 20 6d 79 2d 6c 69 73 ->my-list my-lis
9fb0: 74 73 29 29 0a 20 20 0a 20 20 28 6d 79 2d 63 68 ts)). . (my-ch
9fc0: 65 63 6b 2d 63 6f 6d 70 61 72 65 0a 20 20 20 28 eck-compare. (
9fd0: 6c 61 6d 62 64 61 20 28 78 20 79 29 20 28 76 65 lambda (x y) (ve
9fe0: 63 74 6f 72 2d 63 6f 6d 70 61 72 65 2d 61 73 2d ctor-compare-as-
9ff0: 6c 69 73 74 20 63 69 20 78 20 79 20 6d 79 2d 73 list ci x y my-s
a000: 69 7a 65 20 6d 79 2d 72 65 66 29 29 0a 20 20 20 ize my-ref)).
a010: 28 6d 61 70 20 6c 69 73 74 2d 3e 6d 79 2d 6c 69 (map list->my-li
a020: 73 74 20 6d 79 2d 6c 69 73 74 73 29 29 0a 20 20 st my-lists)).
a030: 0a 20 20 29 20 3b 20 63 68 65 63 6b 3a 64 61 74 . ) ; check:dat
a040: 61 2d 73 74 72 75 63 74 75 72 65 73 0a 0a 0a 28 a-structures...(
a050: 64 65 66 69 6e 65 20 28 63 68 65 63 6b 3a 64 65 define (check:de
a060: 66 61 75 6c 74 2d 63 6f 6d 70 61 72 65 29 0a 20 fault-compare).
a070: 20 0a 20 20 28 6d 79 2d 63 68 65 63 6b 2d 63 6f . (my-check-co
a080: 6d 70 61 72 65 20 64 65 66 61 75 6c 74 2d 63 6f mpare default-co
a090: 6d 70 61 72 65 20 6d 79 2d 6f 62 6a 65 63 74 73 mpare my-objects
a0a0: 29 0a 20 20 0a 20 20 3b 20 63 68 65 63 6b 20 69 ). . ; check i
a0b0: 66 20 64 65 66 61 75 6c 74 2d 63 6f 6d 70 61 72 f default-compar
a0c0: 65 20 72 65 66 69 6e 65 73 20 70 61 69 72 2d 63 e refines pair-c
a0d0: 6f 6d 70 61 72 65 0a 20 20 0a 20 20 28 6d 79 2d ompare. . (my-
a0e0: 63 68 65 63 6b 2d 65 63 0a 20 20 20 28 3a 6c 69 check-ec. (:li
a0f0: 73 74 20 78 20 28 69 6e 64 65 78 20 69 78 29 20 st x (index ix)
a100: 6d 79 2d 6f 62 6a 65 63 74 73 29 0a 20 20 20 28 my-objects). (
a110: 3a 6c 69 73 74 20 79 20 28 69 6e 64 65 78 20 69 :list y (index i
a120: 79 29 20 6d 79 2d 6f 62 6a 65 63 74 73 29 0a 20 y) my-objects).
a130: 20 20 28 3a 6c 65 74 20 63 2d 63 6f 61 72 73 65 (:let c-coarse
a140: 20 28 70 61 69 72 2d 63 6f 6d 70 61 72 65 20 78 (pair-compare x
a150: 20 79 29 29 0a 20 20 20 28 3a 6c 65 74 20 63 2d y)). (:let c-
a160: 66 69 6e 65 20 28 64 65 66 61 75 6c 74 2d 63 6f fine (default-co
a170: 6d 70 61 72 65 20 78 20 79 29 29 0a 20 20 20 28 mpare x y)). (
a180: 6f 72 20 28 65 71 76 3f 20 63 2d 63 6f 61 72 73 or (eqv? c-coars
a190: 65 20 30 29 20 28 65 71 76 3f 20 63 2d 66 69 6e e 0) (eqv? c-fin
a1a0: 65 20 63 2d 63 6f 61 72 73 65 29 29 0a 20 20 20 e c-coarse)).
a1b0: 28 6c 69 73 74 20 78 20 79 29 29 0a 20 20 0a 20 (list x y)). .
a1c0: 20 3b 20 63 68 65 63 6b 20 69 66 20 64 65 66 61 ; check if defa
a1d0: 75 6c 74 2d 63 6f 6d 70 61 72 65 20 70 61 73 73 ult-compare pass
a1e0: 65 73 20 6f 6e 20 64 65 62 75 67 2d 63 6f 6d 70 es on debug-comp
a1f0: 61 72 65 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 are. . (my-che
a200: 63 6b 2d 63 6f 6d 70 61 72 65 20 28 64 65 62 75 ck-compare (debu
a210: 67 2d 63 6f 6d 70 61 72 65 20 64 65 66 61 75 6c g-compare defaul
a220: 74 2d 63 6f 6d 70 61 72 65 29 20 6d 79 2d 6f 62 t-compare) my-ob
a230: 6a 65 63 74 73 29 0a 20 20 0a 20 20 29 20 3b 20 jects). . ) ;
a240: 63 68 65 63 6b 3a 64 65 66 61 75 6c 74 2d 63 6f check:default-co
a250: 6d 70 61 72 65 0a 0a 0a 28 64 65 66 69 6e 65 20 mpare...(define
a260: 28 73 6f 72 74 2d 62 79 2d 6c 65 73 73 20 78 73 (sort-by-less xs
a270: 20 70 72 65 64 29 20 3b 20 74 72 69 76 69 61 6c pred) ; trivial
a280: 20 71 75 69 63 6b 73 6f 72 74 0a 20 20 28 69 66 quicksort. (if
a290: 20 28 6f 72 20 28 6e 75 6c 6c 3f 20 78 73 29 20 (or (null? xs)
a2a0: 28 6e 75 6c 6c 3f 20 28 63 64 72 20 78 73 29 29 (null? (cdr xs))
a2b0: 29 0a 20 20 20 20 20 20 78 73 0a 20 20 20 20 20 ). xs.
a2c0: 20 28 61 70 70 65 6e 64 20 0a 20 20 20 20 20 20 (append .
a2d0: 20 28 73 6f 72 74 2d 62 79 2d 6c 65 73 73 20 28 (sort-by-less (
a2e0: 6c 69 73 74 2d 65 63 20 28 3a 6c 69 73 74 20 78 list-ec (:list x
a2f0: 20 28 63 64 72 20 78 73 29 29 0a 09 09 09 20 20 (cdr xs))....
a300: 20 20 20 20 28 69 66 20 28 70 72 65 64 20 78 20 (if (pred x
a310: 28 63 61 72 20 78 73 29 29 29 20 0a 09 09 09 20 (car xs))) ....
a320: 20 20 20 20 20 78 29 20 0a 09 09 20 20 20 20 20 x) ...
a330: 70 72 65 64 29 0a 20 20 20 20 20 20 20 28 6c 69 pred). (li
a340: 73 74 20 28 63 61 72 20 78 73 29 29 0a 20 20 20 st (car xs)).
a350: 20 20 20 20 28 73 6f 72 74 2d 62 79 2d 6c 65 73 (sort-by-les
a360: 73 20 28 6c 69 73 74 2d 65 63 20 28 3a 6c 69 73 s (list-ec (:lis
a370: 74 20 78 20 28 63 64 72 20 78 73 29 29 0a 09 09 t x (cdr xs))...
a380: 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
a390: 28 70 72 65 64 20 78 20 28 63 61 72 20 78 73 29 (pred x (car xs)
a3a0: 29 29 29 0a 09 09 09 20 20 20 20 20 20 78 29 20 ))).... x)
a3b0: 0a 09 09 20 20 20 20 20 70 72 65 64 29 29 29 29 ... pred))))
a3c0: 0a 0a 28 64 65 66 69 6e 65 20 28 63 68 65 63 6b ..(define (check
a3d0: 3a 6d 6f 72 65 2d 65 78 61 6d 70 6c 65 73 29 0a :more-examples).
a3e0: 20 20 0a 20 20 3b 20 64 65 66 69 6e 65 20 72 65 . ; define re
a3f0: 63 75 72 73 69 76 65 20 6f 72 64 65 72 20 6f 6e cursive order on
a400: 20 74 72 65 65 20 74 79 70 65 20 28 6e 6f 64 65 tree type (node
a410: 73 20 61 72 65 20 64 6f 74 74 65 64 20 70 61 69 s are dotted pai
a420: 72 73 29 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 rs). . (my-che
a430: 63 6b 2d 63 6f 6d 70 61 72 65 0a 20 20 20 28 6c ck-compare. (l
a440: 65 74 72 65 63 20 28 28 63 20 28 6c 61 6d 62 64 etrec ((c (lambd
a450: 61 20 28 78 20 79 29 0a 20 20 20 20 20 20 20 20 a (x y).
a460: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 2d 63 (cond-c
a470: 6f 6d 70 61 72 65 20 28 28 28 6e 75 6c 6c 3f 20 ompare (((null?
a480: 78 29 20 28 6e 75 6c 6c 3f 20 79 29 29 20 30 29 x) (null? y)) 0)
a490: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
a4a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a4b0: 28 65 6c 73 65 20 28 70 61 69 72 2d 63 6f 6d 70 (else (pair-comp
a4c0: 61 72 65 20 63 20 63 20 78 20 79 29 29 29 29 29 are c c x y)))))
a4d0: 29 0a 20 20 20 20 20 63 29 0a 20 20 20 28 6c 69 ). c). (li
a4e0: 73 74 20 27 28 29 20 28 6c 69 73 74 20 27 28 29 st '() (list '()
a4f0: 29 20 28 6c 69 73 74 20 27 28 29 20 27 28 29 29 ) (list '() '())
a500: 20 28 6c 69 73 74 20 28 6c 69 73 74 20 27 28 29 (list (list '()
a510: 29 29 29 0a 20 20 20 3b 27 28 28 29 20 28 28 29 ))). ;'(() (()
a520: 20 2e 20 28 29 29 20 28 28 29 20 2e 20 28 28 29 . ()) (() . (()
a530: 20 2e 20 28 29 29 29 20 28 28 28 29 20 2e 20 28 . ())) ((() . (
a540: 29 29 20 2e 20 28 29 29 29 20 20 20 3b 20 43 68 )) . ())) ; Ch
a550: 69 63 6b 65 6e 20 63 61 6e 27 74 20 70 61 72 73 icken can't pars
a560: 65 20 74 68 69 73 20 3f 0a 20 20 20 29 0a 20 20 e this ?. ).
a570: 0a 20 20 3b 20 72 65 64 65 66 69 6e 65 20 64 65 . ; redefine de
a580: 66 61 75 6c 74 2d 63 6f 6d 70 61 72 65 20 75 73 fault-compare us
a590: 69 6e 67 20 73 65 6c 65 63 74 2d 63 6f 6d 70 61 ing select-compa
a5a0: 72 65 0a 20 20 0a 20 20 28 6d 79 2d 63 68 65 63 re. . (my-chec
a5b0: 6b 2d 63 6f 6d 70 61 72 65 0a 20 20 20 28 6c 65 k-compare. (le
a5c0: 74 72 65 63 20 28 28 63 20 28 6c 61 6d 62 64 61 trec ((c (lambda
a5d0: 20 28 78 20 79 29 0a 20 20 20 20 20 20 20 20 20 (x y).
a5e0: 20 20 20 20 20 20 20 20 28 73 65 6c 65 63 74 2d (select-
a5f0: 63 6f 6d 70 61 72 65 20 78 20 79 0a 20 20 20 20 compare x y.
a600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a610: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 75 (nu
a620: 6c 6c 3f 20 30 29 0a 20 20 20 20 20 20 20 20 20 ll? 0).
a630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a640: 20 20 20 20 20 20 20 20 28 70 61 69 72 3f 20 20 (pair?
a650: 20 20 28 70 61 69 72 2d 63 6f 6d 70 61 72 65 20 (pair-compare
a660: 20 20 20 63 20 63 20 78 20 79 29 29 0a 20 20 20 c c x y)).
a670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 (b
a690: 6f 6f 6c 65 61 6e 3f 20 28 62 6f 6f 6c 65 61 6e oolean? (boolean
a6a0: 2d 63 6f 6d 70 61 72 65 20 78 20 79 29 29 0a 20 -compare x y)).
a6b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a6c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a6d0: 28 63 68 61 72 3f 20 20 20 20 28 63 68 61 72 2d (char? (char-
a6e0: 63 6f 6d 70 61 72 65 20 20 20 20 78 20 79 29 29 compare x y))
a6f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
a700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a710: 20 20 28 73 74 72 69 6e 67 3f 20 20 28 73 74 72 (string? (str
a720: 69 6e 67 2d 63 6f 6d 70 61 72 65 20 20 78 20 79 ing-compare x y
a730: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
a740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a750: 20 20 20 20 28 73 79 6d 62 6f 6c 3f 20 20 28 73 (symbol? (s
a760: 79 6d 62 6f 6c 2d 63 6f 6d 70 61 72 65 20 20 78 ymbol-compare x
a770: 20 79 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 y)).
a780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a790: 20 20 20 20 20 20 28 6e 75 6d 62 65 72 3f 20 20 (number?
a7a0: 28 6e 75 6d 62 65 72 2d 63 6f 6d 70 61 72 65 20 (number-compare
a7b0: 20 78 20 79 29 29 0a 20 20 20 20 20 20 20 20 20 x y)).
a7c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a7d0: 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 3f (vector?
a7e0: 20 20 28 76 65 63 74 6f 72 2d 63 6f 6d 70 61 72 (vector-compar
a7f0: 65 20 20 63 20 78 20 79 29 29 0a 20 20 20 20 20 e c x y)).
a800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a810: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
a820: 65 20 28 65 72 72 6f 72 20 22 75 6e 72 65 63 6f e (error "unreco
a830: 67 6e 69 7a 65 64 20 74 79 70 65 20 69 6e 20 63 gnized type in c
a840: 22 20 78 20 79 29 29 29 29 29 29 0a 20 20 20 20 " x y)))))).
a850: 20 63 29 0a 20 20 20 6d 79 2d 6f 62 6a 65 63 74 c). my-object
a860: 73 29 0a 20 20 0a 20 20 3b 20 72 65 64 65 66 69 s). . ; redefi
a870: 6e 65 20 64 65 66 61 75 6c 74 2d 63 6f 6d 70 61 ne default-compa
a880: 72 65 20 75 73 69 6e 67 20 63 6f 6e 64 2d 63 6f re using cond-co
a890: 6d 70 61 72 65 0a 20 20 0a 20 20 28 6d 79 2d 63 mpare. . (my-c
a8a0: 68 65 63 6b 2d 63 6f 6d 70 61 72 65 0a 20 20 20 heck-compare.
a8b0: 28 6c 65 74 72 65 63 20 28 28 63 20 28 6c 61 6d (letrec ((c (lam
a8c0: 62 64 61 20 28 78 20 79 29 0a 20 20 20 20 20 20 bda (x y).
a8d0: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 (cond
a8e0: 2d 63 6f 6d 70 61 72 65 0a 20 20 20 20 20 20 20 -compare.
a8f0: 20 20 20 20 20 20 20 20 20 20 20 28 28 28 6e 75 (((nu
a900: 6c 6c 3f 20 20 20 20 78 29 20 28 6e 75 6c 6c 3f ll? x) (null?
a910: 20 20 20 20 79 29 29 20 30 29 0a 20 20 20 20 20 y)) 0).
a920: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 28 (((
a930: 70 61 69 72 3f 20 20 20 20 78 29 20 28 70 61 69 pair? x) (pai
a940: 72 3f 20 20 20 20 79 29 29 20 28 70 61 69 72 2d r? y)) (pair-
a950: 63 6f 6d 70 61 72 65 20 20 20 20 63 20 63 20 78 compare c c x
a960: 20 79 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 y)).
a970: 20 20 20 20 20 20 20 28 28 28 62 6f 6f 6c 65 61 (((boolea
a980: 6e 3f 20 78 29 20 28 62 6f 6f 6c 65 61 6e 3f 20 n? x) (boolean?
a990: 79 29 29 20 28 62 6f 6f 6c 65 61 6e 2d 63 6f 6d y)) (boolean-com
a9a0: 70 61 72 65 20 78 20 79 29 29 0a 20 20 20 20 20 pare x y)).
a9b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 28 (((
a9c0: 63 68 61 72 3f 20 20 20 20 78 29 20 28 63 68 61 char? x) (cha
a9d0: 72 3f 20 20 20 20 79 29 29 20 28 63 68 61 72 2d r? y)) (char-
a9e0: 63 6f 6d 70 61 72 65 20 20 20 20 78 20 79 29 29 compare x y))
a9f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
aa00: 20 20 20 28 28 28 73 74 72 69 6e 67 3f 20 20 78 (((string? x
aa10: 29 20 28 73 74 72 69 6e 67 3f 20 20 79 29 29 20 ) (string? y))
aa20: 28 73 74 72 69 6e 67 2d 63 6f 6d 70 61 72 65 20 (string-compare
aa30: 20 78 20 79 29 29 0a 20 20 20 20 20 20 20 20 20 x y)).
aa40: 20 20 20 20 20 20 20 20 20 28 28 28 73 79 6d 62 (((symb
aa50: 6f 6c 3f 20 20 78 29 20 28 73 79 6d 62 6f 6c 3f ol? x) (symbol?
aa60: 20 20 79 29 29 20 28 73 79 6d 62 6f 6c 2d 63 6f y)) (symbol-co
aa70: 6d 70 61 72 65 20 20 78 20 79 29 29 0a 20 20 20 mpare x y)).
aa80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
aa90: 28 28 6e 75 6d 62 65 72 3f 20 20 78 29 20 28 6e ((number? x) (n
aaa0: 75 6d 62 65 72 3f 20 20 79 29 29 20 28 6e 75 6d umber? y)) (num
aab0: 62 65 72 2d 63 6f 6d 70 61 72 65 20 20 78 20 79 ber-compare x y
aac0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
aad0: 20 20 20 20 20 28 28 28 76 65 63 74 6f 72 3f 20 (((vector?
aae0: 20 78 29 20 28 76 65 63 74 6f 72 3f 20 20 79 29 x) (vector? y)
aaf0: 29 20 28 76 65 63 74 6f 72 2d 63 6f 6d 70 61 72 ) (vector-compar
ab00: 65 20 20 63 20 78 20 79 29 29 0a 20 20 20 20 20 e c x y)).
ab10: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c (el
ab20: 73 65 20 28 65 72 72 6f 72 20 22 75 6e 72 65 63 se (error "unrec
ab30: 6f 67 6e 69 7a 65 64 20 74 79 70 65 20 69 6e 20 ognized type in
ab40: 63 22 20 78 20 79 29 29 29 29 29 29 0a 20 20 20 c" x y)))))).
ab50: 20 20 63 29 0a 20 20 20 6d 79 2d 6f 62 6a 65 63 c). my-objec
ab60: 74 73 29 0a 20 20 0a 20 20 3b 20 63 6f 6d 70 61 ts). . ; compa
ab70: 72 65 20 73 74 72 69 6e 67 73 20 77 69 74 68 20 re strings with
ab80: 63 68 61 72 61 63 74 65 72 20 6f 72 64 65 72 20 character order
ab90: 72 65 76 65 72 73 65 64 0a 20 20 0a 20 20 28 6d reversed. . (m
aba0: 79 2d 63 68 65 63 6b 2d 63 6f 6d 70 61 72 65 0a y-check-compare.
abb0: 20 20 20 28 6c 61 6d 62 64 61 20 28 78 20 79 29 (lambda (x y)
abc0: 0a 20 20 20 20 20 28 76 65 63 74 6f 72 2d 63 6f . (vector-co
abd0: 6d 70 61 72 65 2d 61 73 2d 6c 69 73 74 0a 20 20 mpare-as-list.
abe0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 78 20 79 (lambda (x y
abf0: 29 20 28 63 68 61 72 2d 63 6f 6d 70 61 72 65 20 ) (char-compare
ac00: 79 20 78 29 29 0a 20 20 20 20 20 20 78 20 79 20 y x)). x y
ac10: 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 73 74 string-length st
ac20: 72 69 6e 67 2d 72 65 66 29 29 0a 20 20 20 27 28 ring-ref)). '(
ac30: 22 22 20 22 62 22 20 22 62 62 22 20 22 62 61 22 "" "b" "bb" "ba"
ac40: 20 22 61 22 20 22 61 62 22 20 22 61 61 22 29 29 "a" "ab" "aa"))
ac50: 0a 0a 20 20 3b 20 65 78 61 6d 70 6c 65 73 20 66 .. ; examples f
ac60: 72 6f 6d 20 53 52 46 49 20 74 65 78 74 20 66 6f rom SRFI text fo
ac70: 72 20 3c 3f 20 65 74 63 2e 0a 0a 20 20 28 6d 79 r <? etc... (my
ac80: 2d 63 68 65 63 6b 20 28 3e 3f 20 22 6c 61 75 67 -check (>? "laug
ac90: 68 22 20 22 4c 4f 55 44 22 29 20 3d 3e 20 23 74 h" "LOUD") => #t
aca0: 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b 20 28 3c ). (my-check (<
acb0: 3f 20 73 74 72 69 6e 67 2d 63 6f 6d 70 61 72 65 ? string-compare
acc0: 2d 63 69 20 22 6c 61 75 67 68 22 20 22 4c 4f 55 -ci "laugh" "LOU
acd0: 44 22 29 20 3d 3e 20 23 74 29 0a 20 20 28 6d 79 D") => #t). (my
ace0: 2d 63 68 65 63 6b 20 28 73 6f 72 74 2d 62 79 2d -check (sort-by-
acf0: 6c 65 73 73 20 27 28 31 20 61 20 22 62 22 29 20 less '(1 a "b")
ad00: 28 3c 3f 29 29 20 3d 3e 20 27 28 22 62 22 20 61 (<?)) => '("b" a
ad10: 20 31 29 29 0a 20 20 28 6d 79 2d 63 68 65 63 6b 1)). (my-check
ad20: 20 28 73 6f 72 74 2d 62 79 2d 6c 65 73 73 20 27 (sort-by-less '
ad30: 28 31 20 61 20 22 62 22 29 20 28 3e 3f 29 29 20 (1 a "b") (>?))
ad40: 3d 3e 20 27 28 31 20 61 20 22 62 22 29 29 0a 20 => '(1 a "b")).
ad50: 20 0a 20 20 29 20 3b 20 63 68 65 63 6b 3a 6d 6f . ) ; check:mo
ad60: 72 65 2d 65 78 61 6d 70 6c 65 73 0a 0a 0a 3b 20 re-examples...;
ad70: 52 65 61 6c 20 6c 69 66 65 20 65 78 61 6d 70 6c Real life exampl
ad80: 65 73 0a 3b 20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d es.; ===========
ad90: 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 20 28 75 70 64 61 =======..; (upda
ada0: 74 65 2f 69 6e 73 65 72 74 20 63 6f 6d 70 61 72 te/insert compar
adb0: 65 20 78 20 73 29 0a 3b 20 20 20 20 69 6e 73 65 e x s).; inse
adc0: 72 74 73 20 78 20 69 6e 74 6f 20 6c 69 73 74 20 rts x into list
add0: 73 2c 20 6f 72 20 75 70 64 61 74 65 73 20 61 6e s, or updates an
ade0: 20 65 71 75 69 76 61 6c 65 6e 74 20 65 6c 65 6d equivalent elem
adf0: 65 6e 74 20 62 79 20 78 2e 0a 3b 20 20 20 20 20 ent by x..;
ae00: 20 49 74 20 69 73 20 61 73 73 75 6d 65 64 20 74 It is assumed t
ae10: 68 61 74 20 73 20 69 73 20 73 6f 72 74 65 64 20 hat s is sorted
ae20: 77 69 74 68 20 72 65 73 70 65 63 74 20 74 6f 20 with respect to
ae30: 63 6f 6d 70 61 72 65 2c 0a 3b 20 20 20 20 69 2e compare,.; i.
ae40: 65 2e 20 28 61 70 70 6c 79 20 63 68 61 69 6e 3c e. (apply chain<
ae50: 3d 3f 20 63 6f 6d 70 61 72 65 20 73 29 2e 20 54 =? compare s). T
ae60: 68 65 20 72 65 73 75 6c 74 20 69 73 20 61 20 6c he result is a l
ae70: 69 73 74 20 77 69 74 68 20 78 0a 3b 20 20 20 20 ist with x.;
ae80: 72 65 70 6c 61 63 69 6e 67 20 74 68 65 20 66 69 replacing the fi
ae90: 72 73 74 20 65 6c 65 6d 65 6e 74 20 73 5b 69 5d rst element s[i]
aea0: 20 66 6f 72 20 77 68 69 63 68 20 28 3d 3f 20 63 for which (=? c
aeb0: 6f 6d 70 61 72 65 20 73 5b 69 5d 20 78 29 2c 0a ompare s[i] x),.
aec0: 3b 20 20 20 20 6f 72 20 77 69 74 68 20 78 20 69 ; or with x i
aed0: 6e 73 65 72 74 65 64 20 69 6e 20 74 68 65 20 70 nserted in the p
aee0: 72 6f 70 65 72 20 70 6c 61 63 65 2e 0a 3b 20 20 roper place..;
aef0: 20 20 20 20 54 68 65 20 61 6c 67 6f 72 69 74 68 The algorith
af00: 6d 20 75 73 65 73 20 6c 69 6e 65 61 72 20 69 6e m uses linear in
af10: 73 65 72 74 69 6f 6e 20 66 72 6f 6d 20 74 68 65 sertion from the
af20: 20 66 72 6f 6e 74 2e 0a 0a 28 64 65 66 69 6e 65 front...(define
af30: 20 28 69 6e 73 65 72 74 2f 75 70 64 61 74 65 20 (insert/update
af40: 63 6f 6d 70 61 72 65 20 78 20 73 29 20 3b 20 69 compare x s) ; i
af50: 6e 73 65 72 74 20 78 20 69 6e 74 6f 20 6c 69 73 nsert x into lis
af60: 74 20 73 2c 20 6f 72 20 75 70 64 61 74 65 0a 20 t s, or update.
af70: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 29 0a 20 (if (null? s).
af80: 20 20 20 20 20 28 6c 69 73 74 20 78 29 0a 20 20 (list x).
af90: 20 20 20 20 28 69 66 33 20 28 63 6f 6d 70 61 72 (if3 (compar
afa0: 65 20 78 20 28 63 61 72 20 73 29 29 0a 20 20 20 e x (car s)).
afb0: 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 78 20 (cons x
afc0: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 63 s). (c
afd0: 6f 6e 73 20 78 20 28 63 64 72 20 73 29 29 0a 20 ons x (cdr s)).
afe0: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 (cons
aff0: 28 63 61 72 20 73 29 20 28 69 6e 73 65 72 74 2f (car s) (insert/
b000: 75 70 64 61 74 65 20 63 6f 6d 70 61 72 65 20 78 update compare x
b010: 20 28 63 64 72 20 73 29 29 29 29 29 29 0a 0a 3b (cdr s))))))..;
b020: 20 28 69 6e 64 65 78 2d 69 6e 2d 76 65 63 74 6f (index-in-vecto
b030: 72 20 63 6f 6d 70 61 72 65 20 76 65 63 20 78 29 r compare vec x)
b040: 0a 3b 20 20 20 20 61 6e 20 69 6e 64 65 78 20 69 .; an index i
b050: 20 73 75 63 68 20 74 68 61 74 20 28 3d 3f 20 63 such that (=? c
b060: 6f 6d 70 61 72 65 20 76 65 63 5b 69 5d 20 78 29 ompare vec[i] x)
b070: 2c 20 6f 72 20 23 66 20 69 66 20 74 68 65 72 65 , or #f if there
b080: 20 69 73 20 6e 6f 6e 65 2e 0a 3b 20 20 20 20 20 is none..;
b090: 20 49 74 20 69 73 20 61 73 73 75 6d 65 64 20 74 It is assumed t
b0a0: 68 61 74 20 73 20 69 73 20 73 6f 72 74 65 64 20 hat s is sorted
b0b0: 77 69 74 68 20 72 65 73 70 65 63 74 20 74 6f 20 with respect to
b0c0: 63 6f 6d 70 61 72 65 2c 0a 3b 20 20 20 20 69 2e compare,.; i.
b0d0: 65 2e 20 28 61 70 70 6c 79 20 63 68 61 69 6e 3c e. (apply chain<
b0e0: 3d 3f 20 63 6f 6d 70 61 72 65 20 28 76 65 63 74 =? compare (vect
b0f0: 6f 72 2d 3e 6c 69 73 74 20 73 29 29 2e 20 49 66 or->list s)). If
b100: 20 74 68 65 72 65 20 61 72 65 20 0a 3b 20 20 20 there are .;
b110: 20 73 65 76 65 72 61 6c 20 65 6c 65 6d 65 6e 74 several element
b120: 73 20 65 71 75 69 76 61 6c 65 6e 74 20 74 6f 20 s equivalent to
b130: 78 20 74 68 65 6e 20 69 74 20 69 73 20 75 6e 73 x then it is uns
b140: 70 65 63 69 66 69 65 64 20 77 68 69 63 68 0a 3b pecified which.;
b150: 20 20 20 20 74 68 65 73 65 20 69 73 20 63 68 6f these is cho
b160: 73 65 6e 2e 0a 3b 20 20 20 20 20 20 54 68 65 20 sen..; The
b170: 61 6c 67 6f 72 69 74 68 6d 20 75 73 65 73 20 62 algorithm uses b
b180: 69 6e 61 72 79 20 73 65 61 72 63 68 2e 0a 0a 28 inary search...(
b190: 64 65 66 69 6e 65 20 28 69 6e 64 65 78 2d 69 6e define (index-in
b1a0: 2d 76 65 63 74 6f 72 20 63 6f 6d 70 61 72 65 20 -vector compare
b1b0: 76 65 63 20 78 29 0a 20 20 28 6c 65 74 20 62 69 vec x). (let bi
b1c0: 6e 61 72 79 2d 73 65 61 72 63 68 20 28 28 6c 6f nary-search ((lo
b1d0: 20 2d 31 29 20 28 68 69 20 28 76 65 63 74 6f 72 -1) (hi (vector
b1e0: 2d 6c 65 6e 67 74 68 20 76 65 63 29 29 29 0a 20 -length vec))).
b1f0: 20 20 20 3b 20 69 6e 76 61 72 69 61 6e 74 3a 20 ; invariant:
b200: 76 65 63 5b 6c 6f 5d 20 3c 20 78 20 3c 20 76 65 vec[lo] < x < ve
b210: 63 5b 68 69 5d 0a 20 20 20 20 28 69 66 20 28 3d c[hi]. (if (=
b220: 3f 20 28 2d 20 68 69 20 6c 6f 29 20 31 29 0a 20 ? (- hi lo) 1).
b230: 20 20 20 20 20 20 20 23 66 0a 20 20 20 20 20 20 #f.
b240: 20 20 28 6c 65 74 20 28 28 6d 69 20 28 71 75 6f (let ((mi (quo
b250: 74 69 65 6e 74 20 28 2b 20 6c 6f 20 68 69 29 20 tient (+ lo hi)
b260: 32 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 2))). (
b270: 69 66 33 20 28 63 6f 6d 70 61 72 65 20 78 20 28 if3 (compare x (
b280: 76 65 63 74 6f 72 2d 72 65 66 20 76 65 63 20 6d vector-ref vec m
b290: 69 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 i)).
b2a0: 20 20 20 28 62 69 6e 61 72 79 2d 73 65 61 72 63 (binary-searc
b2b0: 68 20 6c 6f 20 6d 69 29 0a 20 20 20 20 20 20 20 h lo mi).
b2c0: 20 20 20 20 20 20 20 20 6d 69 0a 20 20 20 20 20 mi.
b2d0: 20 20 20 20 20 20 20 20 20 20 28 62 69 6e 61 72 (binar
b2e0: 79 2d 73 65 61 72 63 68 20 6d 69 20 68 69 29 29 y-search mi hi))
b2f0: 29 29 29 29 20 20 0a 0a 0a 3b 20 52 75 6e 20 74 )))) ...; Run t
b300: 68 65 20 63 68 65 63 6b 73 20 0a 3b 20 3d 3d 3d he checks .; ===
b310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 6d 79 ===========..(my
b320: 2d 63 68 65 63 6b 2d 72 65 73 65 74 29 0a 0a 3b -check-reset)..;
b330: 20 63 6f 6d 6d 65 6e 74 20 69 6e 2f 6f 75 74 20 comment in/out
b340: 61 73 20 6e 65 65 64 65 64 0a 28 63 68 65 63 6b as needed.(check
b350: 3a 61 74 6f 6d 69 63 29 0a 28 63 68 65 63 6b 3a :atomic).(check:
b360: 69 66 33 29 0a 28 63 68 65 63 6b 3a 69 66 73 29 if3).(check:ifs)
b370: 0a 28 63 68 65 63 6b 3a 70 72 65 64 69 63 61 74 .(check:predicat
b380: 65 73 2d 66 72 6f 6d 2d 63 6f 6d 70 61 72 65 29 es-from-compare)
b390: 0a 28 63 68 65 63 6b 3a 70 61 69 72 77 69 73 65 .(check:pairwise
b3a0: 2d 6e 6f 74 3d 3f 29 0a 28 63 68 65 63 6b 3a 6d -not=?).(check:m
b3b0: 69 6e 2f 6d 61 78 29 0a 3b 20 28 63 68 65 63 6b in/max).; (check
b3c0: 3a 6b 74 68 2d 6c 61 72 67 65 73 74 29 0a 28 63 :kth-largest).(c
b3d0: 68 65 63 6b 3a 63 6f 6d 70 61 72 65 2d 66 72 6f heck:compare-fro
b3e0: 6d 2d 70 72 65 64 69 63 61 74 65 73 29 0a 28 63 m-predicates).(c
b3f0: 68 65 63 6b 3a 72 65 66 69 6e 65 2d 73 65 6c 65 heck:refine-sele
b400: 63 74 2d 63 6f 6e 64 29 0a 28 63 68 65 63 6b 3a ct-cond).(check:
b410: 64 61 74 61 2d 73 74 72 75 63 74 75 72 65 73 29 data-structures)
b420: 0a 28 63 68 65 63 6b 3a 64 65 66 61 75 6c 74 2d .(check:default-
b430: 63 6f 6d 70 61 72 65 29 0a 28 63 68 65 63 6b 3a compare).(check:
b440: 6d 6f 72 65 2d 65 78 61 6d 70 6c 65 73 29 0a 0a more-examples)..
b450: 28 6d 79 2d 63 68 65 63 6b 2d 73 75 6d 6d 61 72 (my-check-summar
b460: 79 29 20 3b 20 61 6c 6c 20 65 78 61 6d 70 6c 65 y) ; all example
b470: 73 20 28 39 39 34 38 36 29 20 63 6f 72 72 65 63 s (99486) correc
b480: 74 3f 0a t?.