1; XEmacs: This file contains -*-Scheme-*- source code. 2 3;;; srfi-1-tests: a test suite for procedures in the SRFI-1 4;;; library 5 6;;; John David Stone 7;;; Department of Mathematics and Computer Science 8;;; Grinnell College 9;;; stone@math.grin.edu 10 11;;; created January 8, 1999 12;;; last revised January 13, 1999 13 14 15;; ChangeLog 16;; 17;; 2007-06-30 yamaken - Imported from 18;; http://www.math.grin.edu/~stone/srfi/srfi-1-tests.ss 19;; and adapted to SigScheme and final SRFI-1 20;; 2007-07-18 yamaken - Disable (make-list 5) ==> (#f #f #f #f #f) 21 22(require-extension (srfi 1)) 23(require-extension (unittest)) 24 25(define *test-track-progress* #f) 26 27;;; The DISPLAY-LINE procedure transmits a human-readable 28;;; representation of each of its arguments to the standard 29;;; output port and then terminates the output line. 30 31(define display-line 32 (lambda scribenda 33 (for-each display scribenda) 34 (newline))) 35 36;;; The TEST syntax takes three subexpressions. The value of 37;;; the first should identify or describe the nature of the test 38;;; to be conducted; it is typically a symbol or a serial 39;;; number. The second should be an expression embodying the 40;;; test: the values of the expression are the results of the test. 41;;; The value of the third subexpression of TEST should be a 42;;; predicate that can be applied to the results of the 43;;; test to determine whether it passes or fails. 44 45;;(define-syntax test 46;; (syntax-rules () 47;; ((test name trial criterion) 48;; (begin 49;; (display-line "----------------------------------------") 50;; (display-line "Test " name ":") 51;; (newline) 52;; (display-line 'trial) 53;; (newline) 54;; (display-line "-->") 55;; (newline) 56;; (call-with-values 57;; (lambda () trial) 58;; (lambda results 59;; (for-each display-line results) 60;; (newline) 61;; (if (apply criterion results) 62;; (display-line "Test " name " passed.") 63;; (display-line "*** Test " name " failed.")))) 64;; (display-line "----------------------------------------") 65;; (newline))))) 66 67;; Cannot receive multiple values as result. 68(define test 69 (lambda (name result criterion) 70 (assert-true (symbol->string name) (criterion result)))) 71 72(define test/values 73 (lambda (name trial criterion) 74 (assert-true (symbol->string name) 75 (call-with-values 76 (lambda () (eval trial (interaction-environment))) 77 criterion)))) 78 79;;; Some procedures are defined for their side effects only. 80;;; The EFFECT-ONLY-TEST syntax invokes such procedures, with 81;;; the appropriate decorations in the style of TEST. It takes 82;;; three subexpressions. The value of the first should 83;;; identify or describe the nature of the test to be conducted. 84;;; The second should be an expression embodying the test and 85;;; performing the desired side effect. It is up to the 86;;; programmer to determine whether the test succeeded or 87;;; failed; to assist her in this effort, the third 88;;; subexpression of EFFECT-ONLY-TEST is also evaluated and its 89;;; results displayed. 90 91;;(define-syntax effect-only-test 92;; (syntax-rules () 93;; ((effect-only-test name trial check) 94;; (begin 95;; (display-line "----------------------------------------") 96;; (display-line "Test " name ":") 97;; (newline) 98;; (display-line 'trial) 99;; (newline) 100;; trial 101;; (display-line "Test " name " completed.") 102;; (newline) 103;; (display-line "Value(s) of check expression:") 104;; (newline) 105;; (display-line 'check) 106;; (newline) 107;; (display-line "-->") 108;; (newline) 109;; (call-with-values 110;; (lambda () check) 111;; (lambda results 112;; (for-each display-line results))) 113;; (display-line "----------------------------------------") 114;; (newline))))) 115 116;;; The tests of CIRCULAR-LIST should not attempt to display the 117;;; result of the test expression, since some Scheme 118;;; implementations cannot print cyclic data structures. The 119;;; NON-PRINTING-TEST syntax is used for such tests. 120 121;;(define-syntax non-printing-test 122;; (syntax-rules () 123;; ((non-printing-test name trial criterion) 124;; (begin 125;; (display-line "----------------------------------------") 126;; (display-line "Test " name ":") 127;; (newline) 128;; (display-line 'trial) 129;; (newline) 130;; (call-with-values 131;; (lambda () trial) 132;; (lambda results 133;; (if (apply criterion results) 134;; (display-line "Test " name " passed.") 135;; (display-line "*** Test " name " failed.")))) 136;; (display-line "----------------------------------------") 137;; (newline))))) 138 139(define non-printing-test test) 140 141;;; XCONS 142 143(test 'xcons:null-cdr 144 (xcons '() 'Andromeda) 145 (lambda (result) (equal? result '(Andromeda)))) 146 147(let ((base '(Antlia))) 148 (test 'xcons:pair-cdr 149 (xcons base 'Apus) 150 (lambda (result) 151 (and (equal? result '(Apus Antlia)) 152 (eq? (cdr result) base))))) 153 154(test 'xcons:datum-cdr 155 (xcons 'Aquarius 'Aquila) 156 (lambda (result) (equal? result '(Aquila . Aquarius)))) 157 158;;; TREE-COPY 159 160;;(test 'tree-copy:null-tree 161;; (tree-copy '()) 162;; null?) 163;; 164;;(let ((original 43/17)) 165;; (test 'tree-copy:non-pair 166;; (tree-copy original) 167;; (lambda (result) (equal? result original)))) 168;; 169;;(let ((original '(Ara Argo Aries Auriga Bootes))) 170;; (test 'tree-copy:flat-list 171;; (tree-copy original) 172;; (lambda (result) 173;; (and (equal? result original) 174;; (not (eq? result original)) 175;; (not (eq? (cdr result) (cdr original))) 176;; (not (eq? (cddr result) (cddr original))) 177;; (not (eq? (cdddr result) (cdddr original))) 178;; (not (eq? (cddddr result) (cddddr original))))))) 179;; 180;;(let ((original '((Caelum) 181;; (Camelopardis Cancer Capricorn 182;; (Carina Cassiopeia) 183;; ((Centaurus Cepheus Cetus))) 184;; Chamaeleon))) 185;; (test 'tree-copy:bush 186;; (tree-copy original) 187;; (lambda (result) 188;; (and (equal? result original) 189;; (not (eq? result original)) 190;; (not (eq? (car result) (car original))) 191;; (not (eq? (cdr result) (cdr original))) 192;; (not (eq? (cadr result) (cadr original))) 193;; (not (eq? (cddr result) (cddr original))) 194;; (not (eq? (cdadr result) (cdadr original))) 195;; (not (eq? (cddadr result) (cddadr original))) 196;; (not (eq? (cdr (cddadr result)) 197;; (cdr (cddadr original)))) 198;; (not (eq? (cddr (cddadr result)) 199;; (cddr (cddadr original)))) 200;; (not (eq? (cadr (cddadr result)) 201;; (cadr (cddadr original)))) 202;; (not (eq? (cddr (cddadr result)) 203;; (cddr (cddadr original)))) 204;; (not (eq? (caddr (cddadr result)) 205;; (caddr (cddadr original)))) 206;; (not (eq? (caaddr (cddadr result)) 207;; (caaddr (cddadr original)))) 208;; (not (eq? (cdr (caaddr (cddadr result))) 209;; (cdr (caaddr (cddadr original))))) 210;; (not (eq? (cddr (caaddr (cddadr result))) 211;; (cddr (caaddr (cddadr original))))))))) 212;; 213;;(let ((original '(Arcturus Canopus Sirius . Vega))) 214;; (test 'tree-copy:improper-list 215;; (tree-copy original) 216;; (lambda (result) 217;; (and (equal? result original) 218;; (not (eq? result original)) 219;; (not (eq? (cdr result) (cdr original))) 220;; (not (eq? (cddr result) (cddr original))))))) 221 222;;; MAKE-LIST 223 224(test 'make-list:zero-length 225 (make-list 0) 226 null?) 227 228;; Disabled by YamaKen 2007-07-18 229;; SRFI-1: If the fill argument is not given, the elements of the list may be 230;; arbitrary values. 231;; 232;;(test 'make-list:default-element 233;; (make-list 5) 234;; (lambda (result) (equal? result '(#f #f #f #f #f)))) 235 236(test 'make-list:fill-element 237 (make-list 7 'Circinus) 238 (lambda (result) 239 (equal? result '(Circinus Circinus Circinus Circinus 240 Circinus Circinus Circinus)))) 241 242;;; LIST-TABULATE 243 244(test 'list-tabulate:zero-length 245 (list-tabulate 0 (lambda (position) #f)) 246 null?) 247 248(test 'list-tabulate:identity 249 (list-tabulate 5 (lambda (position) position)) 250 (lambda (result) 251 (equal? result '(0 1 2 3 4)))) 252 253(test 'list-tabulate:factorial 254 (list-tabulate 7 (lambda (position) 255 (do ((multiplier 1 (+ multiplier 1)) 256 (product 1 (* product multiplier))) 257 ((< position multiplier) product)))) 258 (lambda (result) (equal? result '(1 1 2 6 24 120 720)))) 259 260;;; CONS* 261 262(test 'cons*:one-argument 263 (cons* 'Columba) 264 (lambda (result) (eq? result 'Columba))) 265 266(test 'cons*:two-arguments 267 (cons* 'Corvus 'Crater) 268 (lambda (result) (equal? result '(Corvus . Crater)))) 269 270(test 'cons*:many-arguments 271 (cons* 'Crux 'Cygnus 'Delphinus 'Dorado 'Draco) 272 (lambda (result) 273 (equal? result '(Crux Cygnus Delphinus Dorado . Draco)))) 274 275(test 'cons*:last-argument-null 276 (cons* 'Equuleus 'Fornax '()) 277 (lambda (result) (equal? result '(Equuleus Fornax)))) 278 279(let ((base '(Gemini Grus))) 280 (test 'cons*:last-argument-non-empty-list 281 (cons* 'Hercules 'Horologium 'Hydra 'Hydrus base) 282 (lambda (result) 283 (and (equal? result '(Hercules Horologium Hydra Hydrus 284 Gemini Grus)) 285 (eq? (cddddr result) base))))) 286 287;;; LIST-COPY 288 289(test 'list-copy:null-list 290 (list-copy '()) 291 null?) 292 293(let ((original '(Indus Lacerta Leo Lepus Libra))) 294 (test 'list-copy:flat-list 295 (list-copy original) 296 (lambda (result) 297 (and (equal? result original) 298 (not (eq? result original)) 299 (not (eq? (cdr result) (cdr original))) 300 (not (eq? (cddr result) (cddr original))) 301 (not (eq? (cdddr result) (cdddr original))) 302 (not (eq? (cddddr result) (cddddr original))))))) 303 304(let ((first '(Lupus)) 305 (second '(Lynx Malus Mensa (Microscopium Monoceros) 306 ((Musca Norma Octans)))) 307 (third 'Ophiuchus)) 308 (let ((original (list first second third))) 309 (test 'list-copy:bush 310 (list-copy original) 311 (lambda (result) 312 (and (equal? result original) 313 (not (eq? result original)) 314 (eq? (car result) first) 315 (not (eq? (cdr result) (cdr original))) 316 (eq? (cadr result) second) 317 (not (eq? (cddr result) (cddr original))) 318 (eq? (caddr result) third)))))) 319 320;;;;; .IOTA 321;; 322;;(test '.iota:zero-count 323;; (.iota 0) 324;; null?) 325;; 326;;(test '.iota:upper-limit-only 327;; (.iota 5) 328;; (lambda (result) (equal? result '(0 1 2 3 4)))) 329;; 330;;(test '.iota:non-integer-upper-limit 331;; (.iota 43/7) 332;; (lambda (result) (equal? result '(0 1 2 3 4 5 6)))) 333;; 334;;(test '.iota:lower-and-upper-limits 335;; (.iota 1997 2004) 336;; (lambda (result) 337;; (equal? result '(1997 1998 1999 2000 2001 2002 2003)))) 338;; 339;;(test '.iota:non-integer-lower-and-upper-limits 340;; (.iota -13/7 41/7) 341;; (lambda (result) 342;; (equal? result '(-13/7 -6/7 1/7 8/7 15/7 22/7 29/7 36/7)))) 343;; 344;;(test '.iota:positive-step 345;; (.iota 1988 2008 4) 346;; (lambda (result) (equal? result '(1988 1992 1996 2000 2004)))) 347;; 348;;(test '.iota:negative-step 349;; (.iota 3 -13 -3) 350;; (lambda (result) (equal? result '(3 0 -3 -6 -9 -12)))) 351;; 352;;(test '.iota:non-integer-arguments 353;; (.iota 71/3 2297/100 -1/10) 354;; (lambda (result) 355;; (equal? result 356;; '(71/3 707/30 352/15 701/30 349/15 139/6 346/15)))) 357;; 358;;;;; IOTA. 359;; 360;;(test 'iota.:zero-count 361;; (iota. 0) 362;; null?) 363;; 364;;(test 'iota.:upper-limit-only 365;; (iota. 5) 366;; (lambda (result) (equal? result '(1 2 3 4 5)))) 367;; 368;;(test 'iota.:non-integer-upper-limit 369;; (iota. 43/7) 370;; (lambda (result) (equal? result '(1 2 3 4 5 6)))) 371;; 372;;(test 'iota.:lower-and-upper-limits 373;; (iota. 1997 2004) 374;; (lambda (result) 375;; (equal? result '(1998 1999 2000 2001 2002 2003 2004)))) 376;; 377;;(test 'iota.:non-integer-lower-and-upper-limits 378;; (iota. -13/7 41/7) 379;; (lambda (result) 380;; (equal? result '(-6/7 1/7 8/7 15/7 22/7 29/7 36/7)))) 381;; 382;;(test 'iota.:positive-step 383;; (iota. 1988 2008 4) 384;; (lambda (result) (equal? result '(1992 1996 2000 2004 2008)))) 385;; 386;;(test 'iota.:negative-step 387;; (iota. 3 -13 -3) 388;; (lambda (result) (equal? result '(0 -3 -6 -9 -12)))) 389;; 390;;(test 'iota.:non-integer-arguments 391;; (iota. 71/3 2297/100 -1/10) 392;; (lambda (result) 393;; (equal? result 394;; '(707/30 352/15 701/30 349/15 139/6 346/15)))) 395 396;;; CIRCULAR-LIST 397 398(non-printing-test 'circular-list:one-element 399 (circular-list 'Orion) 400 (lambda (result) 401 (and (pair? result) 402 (eq? (car result) 'Orion) 403 (eq? (cdr result) result)))) 404 405(non-printing-test 'circular-list:many-elements 406 (circular-list 'Pavo 'Pegasus 'Perseus 'Phoenix 'Pictor) 407 (lambda (result) 408 (and (pair? result) 409 (eq? (car result) 'Pavo) 410 (pair? (cdr result)) 411 (eq? (cadr result) 'Pegasus) 412 (pair? (cddr result)) 413 (eq? (caddr result) 'Perseus) 414 (pair? (cdddr result)) 415 (eq? (cadddr result) 'Phoenix) 416 (pair? (cddddr result)) 417 (eq? (car (cddddr result)) 'Pictor) 418 (eq? (cdr (cddddr result)) result)))) 419 420;;; ZIP 421 422(test 'zip:all-lists-empty 423 (zip '() '() '() '() '()) 424 null?) 425 426(test 'zip:one-list 427 (zip '(Pisces Puppis Reticulum)) 428 (lambda (result) 429 (equal? result '((Pisces) (Puppis) (Reticulum))))) 430 431(test 'zip:two-lists 432 (zip '(Sagitta Sagittarius Scorpio Scutum Serpens) 433 '(Sextans Taurus Telescopium Triangulum Tucana)) 434 (lambda (result) 435 (equal? result '((Sagitta Sextans) 436 (Sagittarius Taurus) 437 (Scorpio Telescopium) 438 (Scutum Triangulum) 439 (Serpens Tucana))))) 440 441(test 'zip:short-lists 442 (zip '(Vela) '(Virgo) '(Volens) '(Vulpecula)) 443 (lambda (result) 444 (equal? result '((Vela Virgo Volens Vulpecula))))) 445 446(test 'zip:several-lists 447 (zip '(actinium aluminum americium antimony argon) 448 '(arsenic astatine barium berkeleium beryllium) 449 '(bismuth boron bromine cadmium calcium) 450 '(californium carbon cerium cesium chlorine) 451 '(chromium cobalt copper curium dysprosium) 452 '(einsteinium erbium europium fermium fluorine) 453 '(francium gadolinium gallium germanium gold)) 454 (lambda (result) 455 (equal? result '((actinium arsenic bismuth californium 456 chromium einsteinium francium) 457 (aluminum astatine boron carbon cobalt 458 erbium gadolinium) 459 (americium barium bromine cerium copper 460 europium gallium) 461 (antimony berkeleium cadmium cesium curium 462 fermium germanium) 463 (argon beryllium calcium chlorine 464 dysprosium fluorine gold))))) 465 466;;; FIRST 467 468(test 'first:of-one 469 (first '(hafnium)) 470 (lambda (result) (eq? result 'hafnium))) 471 472(test 'first:of-many 473 (first '(hahnium helium holmium hydrogen indium)) 474 (lambda (result) (eq? result 'hahnium))) 475 476;;; SECOND 477 478(test 'second:of-two 479 (second '(iodine iridium)) 480 (lambda (result) (eq? result 'iridium))) 481 482(test 'second:of-many 483 (second '(iron krypton lanthanum lawrencium lead lithium)) 484 (lambda (result) (eq? result 'krypton))) 485 486;;; THIRD 487 488(test 'third:of-three 489 (third '(lutetium magnesium manganese)) 490 (lambda (result) (eq? result 'manganese))) 491 492(test 'third:of-many 493 (third '(mendelevium mercury molybdenum neodymium neon 494 neptunium nickel)) 495 (lambda (result) (eq? result 'molybdenum))) 496 497;;; FOURTH 498 499(test 'fourth:of-four 500 (fourth '(niobium nitrogen nobelium osmium)) 501 (lambda (result) (eq? result 'osmium))) 502 503(test 'fourth:of-many 504 (fourth '(oxygen palladium phosphorus platinum plutonium 505 polonium potassium praseodymium)) 506 (lambda (result) (eq? result 'platinum))) 507 508;;; FIFTH 509 510(test 'fifth:of-five 511 (fifth '(promethium protatctinium radium radon rhenium)) 512 (lambda (result) (eq? result 'rhenium))) 513 514(test 'fifth:of-many 515 (fifth '(rhodium rubidium ruthenium rutherfordium samarium 516 scandium selenium silicon silver)) 517 (lambda (result) (eq? result 'samarium))) 518 519;;; SIXTH 520 521(test 'sixth:of-six 522 (sixth '(sodium strontium sulfur tantalum technetium 523 tellurium)) 524 (lambda (result) (eq? result 'tellurium))) 525 526(test 'sixth:of-many 527 (sixth '(terbium thallium thorium thulium tin titanium 528 tungsten uranium vanadium xenon)) 529 (lambda (result) (eq? result 'titanium))) 530 531;;; SEVENTH 532 533(test 'seventh:of-seven 534 (seventh '(ytterbium yttrium zinc zirconium acacia abele 535 ailanthus)) 536 (lambda (result) (eq? result 'ailanthus))) 537 538(test 'seventh:of-many 539 (seventh '(alder allspice almond apple apricot ash aspen 540 avocado balsa balsam banyan)) 541 (lambda (result) (eq? result 'aspen))) 542 543;;; EIGHTH 544 545(test 'eighth:of-eight 546 (eighth '(basswood bay bayberry beech birch boxwood breadfruit 547 buckeye)) 548 (lambda (result) (eq? result 'buckeye))) 549 550(test 'eighth:of-many 551 (eighth '(butternut buttonwood cacao candleberry cashew cassia 552 catalpa cedar cherry chestnut chinaberry 553 chinquapin)) 554 (lambda (result) (eq? result 'cedar))) 555 556;;; NINTH 557 558(test 'ninth:of-nine 559 (ninth '(cinnamon citron clove coconut cork cottonwood cypress 560 date dogwood)) 561 (lambda (result) (eq? result 'dogwood))) 562 563(test 'ninth:of-many 564 (ninth '(ebony elder elm eucalyptus ficus fig fir frankincense 565 ginkgo grapefruit guava gum hawthorn)) 566 (lambda (result) (eq? result 'ginkgo))) 567 568;;; TENTH 569 570(test 'tenth:of-ten 571 (tenth '(hazel hemlock henna hickory holly hornbeam ironwood 572 juniper kumquat laburnum)) 573 (lambda (result) (eq? result 'laburnum))) 574 575(test 'tenth:of-many 576 (tenth '(lancewood larch laurel lemon lime linden litchi 577 locust logwood magnolia mahogany mango 578 mangrove maple)) 579 (lambda (result) (eq? result 'magnolia))) 580 581;;; TAKE 582 583(test 'take:all-of-list 584 (take '(medlar mimosa mulberry nutmeg oak) 5) 585 (lambda (result) 586 (equal? result '(medlar mimosa mulberry nutmeg oak)))) 587 588(test 'take:front-of-list 589 (take '(olive orange osier palm papaw peach pear) 5) 590 (lambda (result) 591 (equal? result '(olive orange osier palm papaw)))) 592 593(test 'take-right:rear-of-list 594 (take-right '(pecan persimmon pine pistachio plane plum pomegranite) 595 5) 596 (lambda (result) 597 (equal? result '(pine pistachio plane plum pomegranite)))) 598 599(test 'take:none-of-list 600 (take '(poplar quince redwood) 0) 601 null?) 602 603(test 'take:empty-list 604 (take '() 0) 605 null?) 606 607;;; DROP 608 609(test 'drop:all-of-list 610 (drop '(rosewood sandalwood sassfras satinwood senna) 5) 611 null?) 612 613(test 'drop:front-of-list 614 (drop '(sequoia serviceberry spruce sycamore tamarack tamarind 615 tamarugo) 616 5) 617 (lambda (result) (equal? result '(tamarind tamarugo)))) 618 619(test 'drop-right:rear-of-list 620 (drop-right '(tangerine teak thuja torchwood upas walnut wandoo) 5) 621 (lambda (result) (equal? result '(tangerine teak)))) 622 623(test 'drop:none-of-list 624 (drop '(whitebeam whitethorn wicopy) 0) 625 (lambda (result) 626 (equal? result '(whitebeam whitethorn wicopy)))) 627 628(test 'drop:empty-list 629 (drop '() 0) 630 null?) 631 632;;; TAKE! 633 634;;; List arguments to linear-update procedures are constructed 635;;; with the LIST procedure rather than as quoted data, since in 636;;; some implementations quoted data are not mutable. 637 638(test 'take!:all-of-list 639 (take! (list 'willow 'woollybutt 'wychelm 'yellowwood 'yew) 5) 640 (lambda (result) 641 (equal? result '(willow woollybutt wychelm yellowwood yew)))) 642 643(test 'take!:front-of-list 644 (take! (list 'ylang-ylang 'zebrawood 'affenpinscher 'afghan 645 'airedale 'alsatian 'barbet) 646 5) 647 (lambda (result) 648 (equal? result '(ylang-ylang zebrawood affenpinscher afghan 649 airedale)))) 650 651;;(test 'take!:rear-of-list 652;; (take! (list 'basenji 'basset 'beagle 'bloodhound 'boarhound 653;; 'borzoi 'boxer) 654;; -5) 655;; (lambda (result) 656;; (equal? result '(beagle bloodhound boarhound borzoi 657;; boxer)))) 658 659(test 'take!:none-of-list 660 (take! (list 'briard 'bulldog 'chihuahua) 0) 661 null?) 662 663(test 'take!:empty-list 664 (take! '() 0) 665 null?) 666 667;;; DROP! 668 669;;(test 'drop!:all-of-list 670;; (drop! (list 'chow 'collie 'coonhound 'clydesdale 'dachshund) 671;; 5) 672;; null?) 673;; 674;;(test 'drop!:front-of-list 675;; (drop! (list 'dalmatian 'deerhound 'doberman 'elkhound 676;; 'foxhound 'greyhound 'griffon) 677;; 5) 678;; (lambda (result) (equal? result '(greyhound griffon)))) 679;; 680;;(test 'drop!:rear-of-list 681;; (drop! (list 'groenendael 'harrier 'hound 'husky 'keeshond 682;; 'komondor 'kuvasz) 683;; -5) 684;; (lambda (result) (equal? result '(groenendael harrier)))) 685;; 686;;(test 'drop!:none-of-list 687;; (drop! (list 'labrador 'malamute 'malinois) 0) 688;; (lambda (result) 689;; (equal? result '(labrador malamute malinois)))) 690;; 691;;(test 'drop!:empty-list 692;; (drop! '() 0) 693;; null?) 694 695;;; LAST 696 697(test 'last:of-singleton 698 (last '(maltese)) 699 (lambda (result) (eq? result 'maltese))) 700 701(test 'last:of-longer-list 702 (last '(mastiff newfoundland nizinny otterhound papillon)) 703 (lambda (result) (eq? result 'papillon))) 704 705;;; LAST-PAIR 706 707(let ((pair '(pekingese))) 708 (test 'last-pair:of-singleton 709 (last-pair pair) 710 (lambda (result) (eq? result pair)))) 711 712(let ((pair '(pointer))) 713 (test 'last-pair:of-longer-list 714 (last-pair (cons 'pomeranian 715 (cons 'poodle 716 (cons 'pug (cons 'puli pair))))) 717 (lambda (result) (eq? result pair)))) 718 719(let ((pair '(manx . siamese))) 720 (test 'last-pair:of-improper-list 721 (last-pair (cons 'abyssinian (cons 'calico pair))) 722 (lambda (result) (eq? result pair)))) 723 724;;; UNZIP2 725 726(test/values 'unzip2:empty-list-of-lists 727 '(unzip2 '()) 728 (lambda (firsts seconds) 729 (and (null? firsts) (null? seconds)))) 730 731(test/values 'unzip2:singleton-list-of-lists 732 '(unzip2 '((retriever rottweiler))) 733 (lambda (firsts seconds) 734 (and (equal? firsts '(retriever)) 735 (equal? seconds '(rottweiler))))) 736 737(test/values 'unzip2:longer-list-of-lists 738 '(unzip2 '((saluki samoyed) 739 (shipperke schnauzer) 740 (setter shepherd) 741 (skye spaniel) 742 (spitz staghound))) 743 (lambda (firsts seconds) 744 (and (equal? firsts '(saluki shipperke setter skye spitz)) 745 (equal? seconds '(samoyed schnauzer shepherd spaniel 746 staghound))))) 747 748(test/values 'unzip2:lists-with-extra-elements 749 '(unzip2 '((terrier turnspit vizsla wiemaraner) 750 (whippet wolfhound) 751 (bells bones bongo carillon celesta) 752 (chimes clappers conga))) 753 (lambda (firsts seconds) 754 (and (equal? firsts '(terrier whippet bells chimes)) 755 (equal? seconds 756 '(turnspit wolfhound bones clappers))))) 757 758;;; UNZIP3 759 760(test/values 'unzip3:empty-list-of-lists 761 '(unzip3 '()) 762 (lambda (firsts seconds thirds) 763 (and (null? firsts) (null? seconds) (null? thirds)))) 764 765(test/values 'unzip3:singleton-list-of-lists 766 '(unzip3 '((cymbals gamelan glockenspiel))) 767 (lambda (firsts seconds thirds) 768 (and (equal? firsts '(cymbals)) 769 (equal? seconds '(gamelan)) 770 (equal? thirds '(glockenspiel))))) 771 772(test/values 'unzip3:longer-list-of-lists 773 '(unzip3 '((gong handbells kettledrum) 774 (lyra maraca marimba) 775 (mbira membranophone metallophone) 776 (nagara naker rattle) 777 (sizzler snappers tabor))) 778 (lambda (firsts seconds thirds) 779 (and (equal? firsts '(gong lyra mbira nagara sizzler)) 780 (equal? seconds '(handbells maraca membranophone naker 781 snappers)) 782 (equal? thirds '(kettledrum marimba metallophone rattle 783 tabor))))) 784 785(test/values 'unzip3:lists-with-extra-elements 786 '(unzip3 '((tambourine timbrel timpani tintinnabula tonitruone) 787 (triangle vibraphone xylophone) 788 (baccarat banker bezique bingo bridge canasta) 789 (casino craps cribbage euchre))) 790 (lambda (firsts seconds thirds) 791 (and (equal? firsts '(tambourine triangle baccarat casino)) 792 (equal? seconds '(timbrel vibraphone banker craps)) 793 (equal? thirds 794 '(timpani xylophone bezique cribbage))))) 795 796;;; UNZIP4 797 798(test/values 'unzip4:empty-list-of-lists 799 '(unzip4 '()) 800 (lambda (firsts seconds thirds fourths) 801 (and (null? firsts) 802 (null? seconds) 803 (null? thirds) 804 (null? fourths)))) 805 806(test/values 'unzip4:singleton-list-of-lists 807 '(unzip4 '((fantan faro gin hazard))) 808 (lambda (firsts seconds thirds fourths) 809 (and (equal? firsts '(fantan)) 810 (equal? seconds '(faro)) 811 (equal? thirds '(gin)) 812 (equal? fourths '(hazard))))) 813 814(test/values 'unzip4:longer-list-of-lists 815 '(unzip4 '((hearts keno loo lottery) 816 (lotto lowball monte numbers) 817 (ombre picquet pinball pinochle) 818 (poker policy quinze romesteq) 819 (roulette rum rummy skat))) 820 (lambda (firsts seconds thirds fourths) 821 (and (equal? firsts '(hearts lotto ombre poker roulette)) 822 (equal? seconds '(keno lowball picquet policy rum)) 823 (equal? thirds '(loo monte pinball quinze rummy)) 824 (equal? fourths 825 '(lottery numbers pinochle romesteq skat))))) 826 827(test/values 'unzip4:lists-with-extra-elements 828 '(unzip4 '((adamant agate alexandrite amethyst aquamarine 829 beryl) 830 (bloodstone brilliant carbuncle carnelian) 831 (chalcedony chrysoberyl chrysolite chrysoprase 832 citrine coral demantoid) 833 (diamond emerald garnet girasol heliotrope))) 834 (lambda (firsts seconds thirds fourths) 835 (and (equal? firsts '(adamant bloodstone chalcedony diamond)) 836 (equal? seconds '(agate brilliant chrysoberyl emerald)) 837 (equal? thirds 838 '(alexandrite carbuncle chrysolite garnet)) 839 (equal? fourths 840 '(amethyst carnelian chrysoprase girasol))))) 841 842;;; UNZIP5 843 844(test/values 'unzip5:empty-list-of-lists 845 '(unzip5 '()) 846 (lambda (firsts seconds thirds fourths fifths) 847 (and (null? firsts) 848 (null? seconds) 849 (null? thirds) 850 (null? fourths) 851 (null? fifths)))) 852 853(test/values 'unzip5:singleton-list-of-lists 854 '(unzip5 '((hyacinth jacinth jade jargoon jasper))) 855 (lambda (firsts seconds thirds fourths fifths) 856 (and (equal? firsts '(hyacinth)) 857 (equal? seconds '(jacinth)) 858 (equal? thirds '(jade)) 859 (equal? fourths '(jargoon)) 860 (equal? fifths '(jasper))))) 861 862(test/values 'unzip5:longer-list-of-lists 863 '(unzip5 '((kunzite moonstone morganite onyx opal) 864 (peridot plasma ruby sapphire sard) 865 (sardonyx spinel star sunstone topaz) 866 (tourmaline turquoise zircon Argus basilisk) 867 (Bigfoot Briareus bucentur Cacus Caliban))) 868 (lambda (firsts seconds thirds fourths fifths) 869 (and (equal? firsts 870 '(kunzite peridot sardonyx tourmaline Bigfoot)) 871 (equal? seconds 872 '(moonstone plasma spinel turquoise Briareus)) 873 (equal? thirds '(morganite ruby star zircon bucentur)) 874 (equal? fourths '(onyx sapphire sunstone Argus Cacus)) 875 (equal? fifths '(opal sard topaz basilisk Caliban))))) 876 877(test/values 'unzip5:lists-with-extra-elements 878 '(unzip5 '((centaur Cerberus Ceto Charybdis chimera cockatrice 879 Cyclops) 880 (dipsas dragon drake Echidna Geryon) 881 (Gigantes Gorgon Grendel griffin Harpy hippocampus 882 hippocentaur hippocerf) 883 (hirocervus Hydra Kraken Ladon manticore Medusa))) 884 (lambda (firsts seconds thirds fourths fifths) 885 (and (equal? firsts '(centaur dipsas Gigantes hirocervus)) 886 (equal? seconds '(Cerberus dragon Gorgon Hydra)) 887 (equal? thirds '(Ceto drake Grendel Kraken)) 888 (equal? fourths '(Charybdis Echidna griffin Ladon)) 889 (equal? fifths '(chimera Geryon Harpy manticore))))) 890 891;;; APPEND! 892 893(test 'append!:no-arguments 894 (append!) 895 null?) 896 897(test 'append!:one-argument 898 (append! (list 'mermaid 'merman 'Minotaur)) 899 (lambda (result) 900 (equal? result '(mermaid merman Minotaur)))) 901 902(test 'append!:several-arguments 903 (append! (list 'nixie 'ogre 'ogress 'opinicus) 904 (list 'Orthos) 905 (list 'Pegasus 'Python) 906 (list 'roc 'Sagittary 'salamander 'Sasquatch 'satyr) 907 (list 'Scylla 'simurgh 'siren)) 908 (lambda (result) 909 (equal? result '(nixie ogre ogress opinicus Orthos Pegasus 910 Python roc Sagittary salamander Sasquatch 911 satyr Scylla simurgh siren)))) 912 913(test 'append!:some-null-arguments 914 (append! (list) (list) (list 'Sphinx 'Talos 'troll) (list) 915 (list 'Typhoeus) (list) (list) (list)) 916 (lambda (result) 917 (equal? result '(Sphinx Talos troll Typhoeus)))) 918 919(test 'append!:all-null-arguments 920 (append! (list) (list) (list) (list) (list)) 921 null?) 922 923;;; APPEND-REVERSE 924 925(test 'append-reverse:first-argument-null 926 (append-reverse '() '(Typhon unicorn vampire werewolf)) 927 (lambda (result) 928 (equal? result '(Typhon unicorn vampire werewolf)))) 929 930(test 'append-reverse:second-argument-null 931 (append-reverse '(windigo wivern xiphopagus yeti zombie) '()) 932 (lambda (result) 933 (equal? result '(zombie yeti xiphopagus wivern windigo)))) 934 935(test 'append-reverse:both-arguments-null 936 (append-reverse '() '()) 937 null?) 938 939(test 'append-reverse:neither-argument-null 940 (append-reverse '(Afghanistan Albania Algeria Andorra) 941 '(Angola Argentina Armenia)) 942 (lambda (result) 943 (equal? result '(Andorra Algeria Albania Afghanistan Angola 944 Argentina Armenia)))) 945 946;;; APPEND-REVERSE! 947 948(test 'append-reverse!:first-argument-null 949 (append-reverse! (list) 950 (list 'Australia 'Austria 'Azerbaijan)) 951 (lambda (result) 952 (equal? result '(Australia Austria Azerbaijan)))) 953 954(test 'append-reverse!:second-argument-null 955 (append-reverse! (list 'Bahrain 'Bangladesh 'Barbados 956 'Belarus 'Belgium) 957 (list)) 958 (lambda (result) 959 (equal? result 960 '(Belgium Belarus Barbados Bangladesh Bahrain)))) 961 962(test 'append-reverse!:both-arguments-null 963 (append-reverse! (list) (list)) 964 null?) 965 966(test 'append-reverse!:neither-argument-null 967 (append-reverse! (list 'Belize 'Benin 'Bhutan 'Bolivia) 968 (list 'Bosnia 'Botswana 'Brazil)) 969 (lambda (result) 970 (equal? result '(Bolivia Bhutan Benin Belize Bosnia Botswana 971 Brazil)))) 972 973;;; REVERSE! 974 975(test 'reverse!:empty-list 976 (reverse! (list)) 977 null?) 978 979(test 'reverse!:singleton-list 980 (reverse! (list 'Brunei)) 981 (lambda (result) 982 (equal? result '(Brunei)))) 983 984(test 'reverse!:longer-list 985 (reverse! (list 'Bulgaria 'Burundi 'Cambodia 'Cameroon 986 'Canada)) 987 (lambda (result) 988 (equal? result 989 '(Canada Cameroon Cambodia Burundi Bulgaria)))) 990 991;;; UNFOLD 992 993(test 'unfold:predicate-always-satisfied 994 (unfold (lambda (seed) #t) 995 (lambda (seed) (* seed 2)) 996 (lambda (seed) (* seed 3)) 997 1) 998 null?) 999 1000(test 'unfold:normal-case 1001 (unfold (lambda (seed) (= seed 729)) 1002 (lambda (seed) (* seed 2)) 1003 (lambda (seed) (* seed 3)) 1004 1) 1005 (lambda (result) (equal? result '(2 6 18 54 162 486)))) 1006 1007;;; UNFOLD/TAIL 1008 1009;;(test 'unfold/tail:predicate-always-satisfied 1010;; (unfold/tail (lambda (seed) #t) 1011;; (lambda (seed) (* seed 2)) 1012;; (lambda (seed) (* seed 3)) 1013;; (lambda (seed) (* seed 5)) 1014;; 1) 1015;; (lambda (result) (equal? result 5))) 1016;; 1017;;(test 'unfold/tail:normal-case 1018;; (unfold/tail (lambda (seed) (= seed 729)) 1019;; (lambda (seed) (* seed 2)) 1020;; (lambda (seed) (* seed 3)) 1021;; (lambda (seed) (* seed 5)) 1022;; 1) 1023;; (lambda (result) (equal? result '(2 6 18 54 162 486 . 3645)))) 1024 1025;;; FOLD 1026 1027(test 'fold:one-null-list 1028 (fold (lambda (alpha beta) (* alpha (+ beta 1))) 13 '()) 1029 (lambda (result) (= result 13))) 1030 1031(test 'fold:one-singleton-list 1032 (fold (lambda (alpha beta) (* alpha (+ beta 1))) 13 '(15)) 1033 (lambda (result) (= result 210))) 1034 1035(test 'fold:one-longer-list 1036 (fold (lambda (alpha beta) (* alpha (+ beta 1))) 1037 13 1038 '(15 17 19 21 23)) 1039 (lambda (result) (= result 32927582))) 1040 1041(test 'fold:several-null-lists 1042 (fold vector 'Chad '() '() '() '() '()) 1043 (lambda (result) (eq? result 'Chad))) 1044 1045(test 'fold:several-singleton-lists 1046 (fold vector 'Chile '(China) '(Colombia) '(Comoros) '(Congo) 1047 '(Croatia)) 1048 (lambda (result) 1049 (equal? result 1050 '#(China Colombia Comoros Congo Croatia Chile)))) 1051 1052(test 'fold:several-longer-lists 1053 (fold (lambda (alpha beta gamma delta epsilon zeta) 1054 (cons (vector alpha beta gamma delta epsilon) zeta)) 1055 '() 1056 '(Cuba Cyprus Denmark Djibouti Dominica Ecuador Egypt) 1057 '(Eritrea Estonia Ethiopia Fiji Finland France Gabon) 1058 '(Gambia Georgia Germany Ghana Greece Grenada 1059 Guatemala) 1060 '(Guinea Guyana Haiti Honduras Hungary Iceland India) 1061 '(Indonesia Iran Iraq Ireland Israel Italy Jamaica)) 1062 (lambda (result) 1063 (equal? result 1064 '(#(Egypt Gabon Guatemala India Jamaica) 1065 #(Ecuador France Grenada Iceland Italy) 1066 #(Dominica Finland Greece Hungary Israel) 1067 #(Djibouti Fiji Ghana Honduras Ireland) 1068 #(Denmark Ethiopia Germany Haiti Iraq) 1069 #(Cyprus Estonia Georgia Guyana Iran) 1070 #(Cuba Eritrea Gambia Guinea Indonesia))))) 1071 1072(test 'fold:lists-of-different-lengths 1073 (fold (lambda (alpha beta gamma delta) 1074 (cons (vector alpha beta gamma) delta)) 1075 '() 1076 '(Japan Jordan Kazakhstan Kenya) 1077 '(Kiribati Kuwait) 1078 '(Kyrgyzstan Laos Latvia)) 1079 (lambda (result) 1080 (equal? result '(#(Jordan Kuwait Laos) 1081 #(Japan Kiribati Kyrgyzstan))))) 1082 1083;;; FOLD-RIGHT 1084 1085(test 'fold-right:one-null-list 1086 (fold-right (lambda (alpha beta) (* alpha (+ beta 1))) 13 '()) 1087 (lambda (result) (= result 13))) 1088 1089(test 'fold-right:one-singleton-list 1090 (fold-right (lambda (alpha beta) (* alpha (+ beta 1))) 13 '(15)) 1091 (lambda (result) (= result 210))) 1092 1093(test 'fold-right:one-longer-list 1094 (fold-right (lambda (alpha beta) (* alpha (+ beta 1))) 1095 13 1096 '(15 17 19 21 23)) 1097 (lambda (result) (= result 32868750))) 1098 1099(test 'fold-right:several-null-lists 1100 (fold-right vector 'Lebanon '() '() '() '() '()) 1101 (lambda (result) (eq? result 'Lebanon))) 1102 1103(test 'fold-right:several-singleton-lists 1104 (fold-right vector 'Lesotho '(Liberia) '(Libya) '(Liechtenstein) 1105 '(Lithuania) '(Luxembourg)) 1106 (lambda (result) 1107 (equal? result '#(Liberia Libya Liechtenstein Lithuania 1108 Luxembourg Lesotho)))) 1109 1110(test 'fold-right:several-longer-lists 1111 (fold-right (lambda (alpha beta gamma delta epsilon zeta) 1112 (cons (vector alpha beta gamma delta epsilon) zeta)) 1113 '() 1114 '(Macedonia Madagascar Malawi Malaysia Maldives Mali 1115 Malta) 1116 '(Mauritania Mauritius Mexico Micronesia Moldova Monaco 1117 Mongolia) 1118 '(Morocco Mozambique Myanmar Namibia Nauru Nepal 1119 Netherlands) 1120 '(Nicaragua Niger Nigeria Norway Oman Pakistan Palau) 1121 '(Panama Paraguay Peru Philippines Poland Portugal 1122 Qatar)) 1123 (lambda (result) 1124 (equal? result 1125 '(#(Macedonia Mauritania Morocco Nicaragua Panama) 1126 #(Madagascar Mauritius Mozambique Niger Paraguay) 1127 #(Malawi Mexico Myanmar Nigeria Peru) 1128 #(Malaysia Micronesia Namibia Norway Philippines) 1129 #(Maldives Moldova Nauru Oman Poland) 1130 #(Mali Monaco Nepal Pakistan Portugal) 1131 #(Malta Mongolia Netherlands Palau Qatar))))) 1132 1133(test 'fold-right:lists-of-different-lengths 1134 (fold-right (lambda (alpha beta gamma delta) 1135 (cons (vector alpha beta gamma) delta)) 1136 '() 1137 '(Romania Russia Rwanda Senegal) 1138 '(Seychelles Singapore) 1139 '(Slovakia Slovenia Somalia)) 1140 (lambda (result) 1141 (equal? result '(#(Romania Seychelles Slovakia) 1142 #(Russia Singapore Slovenia))))) 1143 1144;;; PAIR-FOLD 1145 1146(let* ((revappend (lambda (reversend base) 1147 (do ((rest reversend (cdr rest)) 1148 (result base (cons (car rest) result))) 1149 ((null? rest) result)))) 1150 (revappall (lambda (first . rest) 1151 (let loop ((first first) (rest rest)) 1152 (if (null? rest) 1153 first 1154 (revappend first 1155 (loop (car rest) 1156 (cdr rest)))))))) 1157 1158 (test 'pair-fold:one-null-list 1159 (pair-fold revappend '(Spain Sudan) '()) 1160 (lambda (result) (equal? result '(Spain Sudan)))) 1161 1162 (test 'pair-fold:one-singleton-list 1163 (pair-fold revappend '(Suriname Swaziland) '(Sweden)) 1164 (lambda (result) 1165 (equal? result '(Sweden Suriname Swaziland)))) 1166 1167 (test 'pair-fold:one-longer-list 1168 (pair-fold revappend 1169 '(Switzerland Syria) 1170 '(Taiwan Tajikistan Tanzania Thailand Togo)) 1171 (lambda (result) 1172 (equal? result 1173 '(Togo Togo Thailand Togo Thailand Tanzania Togo 1174 Thailand Tanzania Tajikistan Togo Thailand 1175 Tanzania Tajikistan Taiwan Switzerland Syria)))) 1176 1177 (test 'pair-fold:several-null-lists 1178 (pair-fold revappall '(Tonga Tunisia) '() '() '() '() '()) 1179 (lambda (result) (equal? result '(Tonga Tunisia)))) 1180 1181 (test 'pair-fold:several-singleton-lists 1182 (pair-fold revappall 1183 '(Turkey Turkmenistan) 1184 '(Tuvalu) 1185 '(Uganda) 1186 '(Ukraine) 1187 '(Uruguay) 1188 '(Uzbekistan)) 1189 (lambda (result) 1190 (equal? result 1191 '(Tuvalu Uganda Ukraine Uruguay Uzbekistan Turkey 1192 Turkmenistan)))) 1193 1194 (test 'pair-fold:several-longer-lists 1195 (pair-fold revappall 1196 '(Vanuatu Venezuela) 1197 '(Vietnam Yemen Yugoslavia Zaire Zambia Zimbabwe 1198 Agnon) 1199 '(Aleixandre Andric Asturias Beckett Bellow 1200 Benavente Bergson) 1201 '(Bjornson Brodsky Buck Bunin Camus Canetti 1202 Carducci) 1203 '(Cela Churchill Deledda Echegary Eliot Elytis 1204 Eucken) 1205 '(Faulkner Galsworthy Gide Gjellerup Golding 1206 Gordimer Hamsun)) 1207 (lambda (result) 1208 (equal? result 1209 '(Agnon Bergson Carducci Eucken Hamsun Agnon 1210 Zimbabwe Bergson Benavente Carducci Canetti 1211 Eucken Elytis Hamsun Gordimer Agnon Zimbabwe 1212 Zambia Bergson Benavente Bellow Carducci Canetti 1213 Camus Eucken Elytis Eliot Hamsun Gordimer 1214 Golding Agnon Zimbabwe Zambia Zaire Bergson 1215 Benavente Bellow Beckett Carducci Canetti Camus 1216 Bunin Eucken Elytis Eliot Echegary Hamsun 1217 Gordimer Golding Gjellerup Agnon Zimbabwe Zambia 1218 Zaire Yugoslavia Bergson Benavente Bellow 1219 Beckett Asturias Carducci Canetti Camus Bunin 1220 Buck Eucken Elytis Eliot Echegary Deledda Hamsun 1221 Gordimer Golding Gjellerup Gide Agnon Zimbabwe 1222 Zambia Zaire Yugoslavia Yemen Bergson Benavente 1223 Bellow Beckett Asturias Andric Carducci Canetti 1224 Camus Bunin Buck Brodsky Eucken Elytis Eliot 1225 Echegary Deledda Churchill Hamsun Gordimer 1226 Golding Gjellerup Gide Galsworthy Agnon Zimbabwe 1227 Zambia Zaire Yugoslavia Yemen Vietnam Bergson 1228 Benavente Bellow Beckett Asturias Andric 1229 Aleixandre Carducci Canetti Camus Bunin Buck 1230 Brodsky Bjornson Eucken Elytis Eliot Echegary 1231 Deledda Churchill Cela Hamsun Gordimer Golding 1232 Gjellerup Gide Galsworthy Faulkner Vanuatu 1233 Venezuela)))) 1234 1235 (test 'pair-fold:lists-of-different-lengths 1236 (pair-fold revappall 1237 '(Hauptmann Hemingway Hesse) 1238 '(Heyse Jensen Jimenez Johnson) 1239 '(Karlfeldt Kawabata) 1240 '(Kipling Lagerkvist Lagerlof Laxness Lewis)) 1241 (lambda (result) 1242 (equal? result 1243 '(Johnson Jimenez Jensen Kawabata Lewis Laxness 1244 Lagerlof Lagerkvist Johnson Jimenez Jensen Heyse 1245 Kawabata Karlfeldt Lewis Laxness Lagerlof 1246 Lagerkvist Kipling Hauptmann Hemingway 1247 Hesse))))) 1248 1249;;; PAIR-FOLD-RIGHT 1250 1251(let* ((revappend (lambda (reversend base) 1252 (do ((rest reversend (cdr rest)) 1253 (result base (cons (car rest) result))) 1254 ((null? rest) result)))) 1255 (revappall (lambda (first . rest) 1256 (let loop ((first first) (rest rest)) 1257 (if (null? rest) 1258 first 1259 (revappend first 1260 (loop (car rest) 1261 (cdr rest)))))))) 1262 1263 (test 'pair-fold-right:one-null-list 1264 (pair-fold-right revappend '(Maeterlinck Mahfouz) '()) 1265 (lambda (result) (equal? result '(Maeterlinck Mahfouz)))) 1266 1267 (test 'pair-fold-right:one-singleton-list 1268 (pair-fold-right revappend '(Mann Martinson) '(Mauriac)) 1269 (lambda (result) 1270 (equal? result '(Mauriac Mann Martinson)))) 1271 1272 (test 'pair-fold-right:one-longer-list 1273 (pair-fold-right revappend 1274 '(Milosz Mistral) 1275 '(Mommsen Montale Morrison Neruda Oe)) 1276 (lambda (result) 1277 (equal? result 1278 '(Oe Neruda Morrison Montale Mommsen Oe Neruda 1279 Morrison Montale Oe Neruda Morrison Oe Neruda Oe 1280 Milosz Mistral)))) 1281 1282 (test 'pair-fold-right:several-null-lists 1283 (pair-fold-right revappall '(Pasternak Paz) '() '() '() '() '()) 1284 (lambda (result) (equal? result '(Pasternak Paz)))) 1285 1286 (test 'pair-fold-right:several-singleton-lists 1287 (pair-fold-right revappall 1288 '(Perse Pirandello) 1289 '(Pontoppidan) 1290 '(Quasimodo) 1291 '(Reymont) 1292 '(Rolland) 1293 '(Russell)) 1294 (lambda (result) 1295 (equal? result 1296 '(Pontoppidan Quasimodo Reymont Rolland Russell 1297 Perse Pirandello)))) 1298 1299 (test 'pair-fold-right:several-longer-lists 1300 (pair-fold-right revappall 1301 '(Sachs Sartre) 1302 '(Seferis Shaw Sholokov Siefert Sienkiewicz 1303 Sillanpaa Simon) 1304 '(Singer Solzhenitsyn Soyinka Spitteler 1305 Steinbeck Tagore Undset) 1306 '(Walcott White Yeats Anderson Andrews Angelina 1307 Aransas) 1308 '(Archer Armstrong Alascosa Austin Bailey 1309 Bandera Bastrop) 1310 '(Baylor Bee Bell Bexar Blanco Borden Bosque 1311 Bowie)) 1312 (lambda (result) 1313 (equal? result 1314 '(Simon Sillanpaa Sienkiewicz Siefert Sholokov 1315 Shaw Seferis Undset Tagore Steinbeck Spitteler 1316 Soyinka Solzhenitsyn Singer Aransas Angelina 1317 Andrews Anderson Yeats White Walcott Bastrop 1318 Bandera Bailey Austin Alascosa Armstrong Archer 1319 Bowie Bosque Borden Blanco Bexar Bell Bee Baylor 1320 Simon Sillanpaa Sienkiewicz Siefert Sholokov 1321 Shaw Undset Tagore Steinbeck Spitteler Soyinka 1322 Solzhenitsyn Aransas Angelina Andrews Anderson 1323 Yeats White Bastrop Bandera Bailey Austin 1324 Alascosa Armstrong Bowie Bosque Borden Blanco 1325 Bexar Bell Bee Simon Sillanpaa Sienkiewicz 1326 Siefert Sholokov Undset Tagore Steinbeck 1327 Spitteler Soyinka Aransas Angelina Andrews 1328 Anderson Yeats Bastrop Bandera Bailey Austin 1329 Alascosa Bowie Bosque Borden Blanco Bexar Bell 1330 Simon Sillanpaa Sienkiewicz Siefert Undset 1331 Tagore Steinbeck Spitteler Aransas Angelina 1332 Andrews Anderson Bastrop Bandera Bailey Austin 1333 Bowie Bosque Borden Blanco Bexar Simon Sillanpaa 1334 Sienkiewicz Undset Tagore Steinbeck Aransas 1335 Angelina Andrews Bastrop Bandera Bailey Bowie 1336 Bosque Borden Blanco Simon Sillanpaa Undset 1337 Tagore Aransas Angelina Bastrop Bandera Bowie 1338 Bosque Borden Simon Undset Aransas Bastrop Bowie 1339 Bosque Sachs Sartre)))) 1340 1341 (test 'pair-fold-right:lists-of-different-lengths 1342 (pair-fold-right revappall 1343 '(Brazoria Brazos Brewster) 1344 '(Briscoe Brooks Brown Burleson) 1345 '(Burnet Caldwell) 1346 '(Calhoun Callahan Cameron Camp Carson)) 1347 (lambda (result) 1348 (equal? result 1349 '(Burleson Brown Brooks Briscoe Caldwell Burnet 1350 Carson Camp Cameron Callahan Calhoun Burleson 1351 Brown Brooks Caldwell Carson Camp Cameron 1352 Callahan Brazoria Brazos Brewster))))) 1353 1354;;; REDUCE 1355 1356(test 'reduce:null-list 1357 (reduce (lambda (alpha beta) (* alpha (+ beta 1))) 0 '()) 1358 zero?) 1359 1360(test 'reduce:singleton-list 1361 (reduce (lambda (alpha beta) (* alpha (+ beta 1))) 0 '(25)) 1362 (lambda (result) (= result 25))) 1363 1364(test 'reduce:doubleton-list 1365 (reduce (lambda (alpha beta) (* alpha (+ beta 1))) 1366 0 1367 '(27 29)) 1368 (lambda (result) (= result 812))) 1369 1370;;; Fixnum overflow on SigScheme storage-compact 1371;;(test 'reduce:longer-list 1372;; (reduce (lambda (alpha beta) (* alpha (+ beta 1))) 1373;; 0 1374;; '(31 33 35 37 39 41 43)) 1375;; (lambda (result) (= result 94118227527))) 1376 1377;;; REDUCE-RIGHT 1378 1379(test 'reduce-right:null-list 1380 (reduce-right (lambda (alpha beta) (* alpha (+ beta 1))) 0 '()) 1381 zero?) 1382 1383(test 'reduce-right:singleton-list 1384 (reduce-right (lambda (alpha beta) (* alpha (+ beta 1))) 0 '(25)) 1385 (lambda (result) (= result 25))) 1386 1387(test 'reduce-right:doubleton-list 1388 (reduce-right (lambda (alpha beta) (* alpha (+ beta 1))) 1389 0 1390 '(27 29)) 1391 (lambda (result) (= result 810))) 1392 1393;;; Fixnum overflow on SigScheme storage-compact 1394;;(test 'reduce-right:longer-list 1395;; (reduce-right (lambda (alpha beta) (* alpha (+ beta 1))) 1396;; 0 1397;; '(31 33 35 37 39 41 43)) 1398;; (lambda (result) (= result 93259601719))) 1399 1400;;; APPEND-MAP 1401 1402(test 'append-map:one-null-list 1403 (append-map (lambda (element) (list element element)) '()) 1404 null?) 1405 1406(test 'append-map:one-singleton-list 1407 (append-map (lambda (element) (list element element)) '(Cass)) 1408 (lambda (result) (equal? result '(Cass Cass)))) 1409 1410(test 'append-map:one-longer-list 1411 (append-map (lambda (element) (list element element)) 1412 '(Castro Chambers Cherokee Childress Clay)) 1413 (lambda (result) 1414 (equal? result 1415 '(Castro Castro Chambers Chambers Cherokee Cherokee 1416 Childress Childress Clay Clay)))) 1417 1418(test 'append-map:several-null-lists 1419 (append-map (lambda elements (reverse elements)) 1420 '() '() '() '() '()) 1421 null?) 1422 1423(test 'append-map:several-singleton-lists 1424 (append-map (lambda elements (reverse elements)) 1425 '(Cochran) 1426 '(Coke) 1427 '(Coleman) 1428 '(Collin) 1429 '(Collingsworth)) 1430 (lambda (result) 1431 (equal? result 1432 '(Collingsworth Collin Coleman Coke Cochran)))) 1433 1434(test 'append-map:several-longer-lists 1435 (append-map (lambda elements (reverse elements)) 1436 '(Colorado Comal Comanche Concho Cooke Coryell 1437 Cottle) 1438 '(Crane Crockett Crosby Culberson Dallam Dallas 1439 Dawson) 1440 '(Delta Denton Dewitt Dickens Dimmit Donley Duval) 1441 '(Eastland Ector Edwards Ellis Erath Falls Fannin) 1442 '(Fayette Fisher Floyd Foard Franklin Freestone 1443 Frio)) 1444 (lambda (result) 1445 (equal? result 1446 '(Fayette Eastland Delta Crane Colorado Fisher Ector 1447 Denton Crockett Comal Floyd Edwards Dewitt Crosby 1448 Comanche Foard Ellis Dickens Culberson Concho 1449 Franklin Erath Dimmit Dallam Cooke Freestone Falls 1450 Donley Dallas Coryell Frio Fannin Duval Dawson 1451 Cottle)))) 1452 1453;;; APPEND-MAP! 1454 1455(test 'append-map!:one-null-list 1456 (append-map! (lambda (element) (list element element)) 1457 (list)) 1458 null?) 1459 1460(test 'append-map!:one-singleton-list 1461 (append-map! (lambda (element) (list element element)) 1462 (list 'Gaines)) 1463 (lambda (result) (equal? result '(Gaines Gaines)))) 1464 1465(test 'append-map!:one-longer-list 1466 (append-map! (lambda (element) (list element element)) 1467 (list 'Galveston 'Garza 'Gillespie 'Glasscock 1468 'Goliad)) 1469 (lambda (result) 1470 (equal? result 1471 '(Galveston Galveston Garza Garza Gillespie 1472 Gillespie Glasscock Glasscock Goliad Goliad)))) 1473 1474(test 'append-map!:several-null-lists 1475 (append-map! (lambda elements (reverse elements)) 1476 (list) 1477 (list) 1478 (list) 1479 (list) 1480 (list)) 1481 null?) 1482 1483(test 'append-map!:several-singleton-lists 1484 (append-map! (lambda elements (reverse elements)) 1485 (list 'Gonzales) 1486 (list 'Gray) 1487 (list 'Grayson) 1488 (list 'Gregg) 1489 (list 'Grimes)) 1490 (lambda (result) 1491 (equal? result 1492 '(Grimes Gregg Grayson Gray Gonzales)))) 1493 1494(test 'append-map!:several-longer-lists 1495 (append-map! (lambda elements (reverse elements)) 1496 (list 'Guadalupe 'Hale 'Hall 'Hamilton 'Hansford 1497 'Hardeman 'Hardin) 1498 (list 'Harris 'Harrison 'Hartley 'Haskell 'Hays 1499 'Hemphill 'Henderson) 1500 (list 'Hidalgo 'Hill 'Hockley 'Hood 'Hopkins 1501 'Houston 'Howard) 1502 (list 'Hudspeth 'Hunt 'Hutchinson 'Irion 'Jack 1503 'Jackson 'Jasper) 1504 (list 'Jefferson 'Johnson 'Jones 'Karnes 'Kaufman 1505 'Kendall 'Kenedy)) 1506 (lambda (result) 1507 (equal? result 1508 '(Jefferson Hudspeth Hidalgo Harris Guadalupe 1509 Johnson Hunt Hill Harrison Hale Jones Hutchinson 1510 Hockley Hartley Hall Karnes Irion Hood Haskell 1511 Hamilton Kaufman Jack Hopkins Hays Hansford 1512 Kendall Jackson Houston Hemphill Hardeman Kenedy 1513 Jasper Howard Henderson Hardin)))) 1514 1515;;; MAP! 1516 1517(test 'map!:one-null-list 1518 (map! vector (list)) 1519 null?) 1520 1521(test 'map!:one-singleton-list 1522 (map! vector (list 'Kent)) 1523 (lambda (result) (equal? result '(#(Kent))))) 1524 1525(test 'map!:one-longer-list 1526 (map vector (list 'Kerr 'Kimble 'King 'Kinney 'Kleberg)) 1527 (lambda (result) 1528 (equal? result 1529 '(#(Kerr) #(Kimble) #(King) #(Kinney) #(Kleberg))))) 1530 1531(test 'map!:several-null-lists 1532 (map! vector (list) (list) (list) (list) (list)) 1533 null?) 1534 1535(test 'map!:several-singleton-lists 1536 (map! vector 1537 (list 'Knox) 1538 (list 'Lamar) 1539 (list 'Lamb) 1540 (list 'Lampasas) 1541 (list 'Lavaca)) 1542 (lambda (result) 1543 (equal? result '(#(Knox Lamar Lamb Lampasas Lavaca))))) 1544 1545(test 'map!:several-longer-lists 1546 (map! vector 1547 (list 'Lee 'Leon 'Liberty 'Limestone 'Lipscomb 'Llano 1548 'Loving) 1549 (list 'Lubbock 'Lynn 'McCulloch 'McLennan 'McMullen 1550 'Madison 'Marion) 1551 (list 'Martin 'Mason 'Matagorda 'Maverick 'Medina 1552 'Menard 'Midland) 1553 (list 'Milam 'Mills 'Mitchell 'Montague 'Montgomery 1554 'Moore 'Morris) 1555 (list 'Motley 'Nacogdoches 'Navarro 'Newton 'Nolan 1556 'Nueces 'Ochiltree)) 1557 (lambda (result) 1558 (equal? result 1559 '(#(Lee Lubbock Martin Milam Motley) 1560 #(Leon Lynn Mason Mills Nacogdoches) 1561 #(Liberty McCulloch Matagorda Mitchell Navarro) 1562 #(Limestone McLennan Maverick Montague Newton) 1563 #(Lipscomb McMullen Medina Montgomery Nolan) 1564 #(Llano Madison Menard Moore Nueces) 1565 #(Loving Marion Midland Morris Ochiltree))))) 1566 1567;;; MAP-IN-ORDER 1568 1569(test 'map-in-order:one-null-list 1570 (let ((counter 0)) 1571 (map-in-order (lambda (element) 1572 (set! counter (+ counter 1)) 1573 (cons counter element)) 1574 '())) 1575 null?) 1576 1577(test 'map-in-order:one-singleton-list 1578 (let ((counter 0)) 1579 (map-in-order (lambda (element) 1580 (set! counter (+ counter 1)) 1581 (cons counter element)) 1582 '(Oldham))) 1583 (lambda (result) (equal? result '((1 . Oldham))))) 1584 1585(test 'map-in-order:one-longer-list 1586 (let ((counter 0)) 1587 (map-in-order (lambda (element) 1588 (set! counter (+ counter 1)) 1589 (cons counter element)) 1590 '(Orange Panola Parker Parmer Pecos))) 1591 (lambda (result) 1592 (equal? result '((1 . Orange) 1593 (2 . Panola) 1594 (3 . Parker) 1595 (4 . Parmer) 1596 (5 . Pecos))))) 1597 1598(test 'map-in-order:several-null-lists 1599 (let ((counter 0)) 1600 (map-in-order (lambda elements 1601 (set! counter (+ counter 1)) 1602 (apply vector counter elements)) 1603 '() '() '() '() '())) 1604 null?) 1605 1606(test 'map-in-order:several-singleton-lists 1607 (let ((counter 0)) 1608 (map-in-order (lambda elements 1609 (set! counter (+ counter 1)) 1610 (apply vector counter elements)) 1611 '(Polk) 1612 '(Potter) 1613 '(Presidio) 1614 '(Rains) 1615 '(Randall))) 1616 (lambda (result) 1617 (equal? result '(#(1 Polk Potter Presidio Rains Randall))))) 1618 1619(test 'map-in-order:several-longer-lists 1620 (let ((counter 0)) 1621 (map-in-order (lambda elements 1622 (set! counter (+ counter 1)) 1623 (apply vector counter elements)) 1624 '(Reagan Real Reeves Refugio Roberts Robertson 1625 Rockwall) 1626 '(Runnels Rusk Sabine Schleicher Scurry 1627 Shackelford Shelby) 1628 '(Sherman Smith Somervell Starr Stephens 1629 Sterling Stonewall) 1630 '(Sutton Swisher Tarrant Taylor Terrell Terry 1631 Throckmorton) 1632 '(Titus Travis Trinity Tyler Upshur Upton 1633 Uvalde))) 1634 (lambda (result) 1635 (equal? result 1636 '(#(1 Reagan Runnels Sherman Sutton Titus) 1637 #(2 Real Rusk Smith Swisher Travis) 1638 #(3 Reeves Sabine Somervell Tarrant Trinity) 1639 #(4 Refugio Schleicher Starr Taylor Tyler) 1640 #(5 Roberts Scurry Stephens Terrell Upshur) 1641 #(6 Robertson Shackelford Sterling Terry Upton) 1642 #(7 Rockwall Shelby Stonewall Throckmorton 1643 Uvalde))))) 1644 1645;;; PAIR-FOR-EACH 1646 1647(test 'pair-for-each:one-null-list 1648 (let ((base '())) 1649 (pair-for-each (lambda (tail) 1650 (set! base (append tail base))) 1651 '()) 1652 base) 1653 null?) 1654 1655(test 'pair-for-each:one-singleton-list 1656 (let ((base '())) 1657 (pair-for-each (lambda (tail) 1658 (set! base (append tail base))) 1659 '(Victoria)) 1660 base) 1661 (lambda (result) (equal? result '(Victoria)))) 1662 1663(test 'pair-for-each:one-longer-list 1664 (let ((base '())) 1665 (pair-for-each (lambda (tail) 1666 (set! base (append tail base))) 1667 '(Walker Waller Ward Washington Webb)) 1668 base) 1669 (lambda (result) 1670 (equal? result 1671 '(Webb Washington Webb Ward Washington Webb Waller 1672 Ward Washington Webb Walker Waller Ward 1673 Washington Webb)))) 1674 1675(test 'pair-for-each:several-null-lists 1676 (let ((base '())) 1677 (pair-for-each (lambda tails 1678 (set! base 1679 (cons (apply vector tails) base))) 1680 '() '() '() '() '()) 1681 base) 1682 null?) 1683 1684(test 'pair-for-each:several-singleton-lists 1685 (let ((base '())) 1686 (pair-for-each (lambda tails 1687 (set! base 1688 (cons (apply vector tails) base))) 1689 '(Wharton) 1690 '(Wheeler) 1691 '(Wichita) 1692 '(Wilbarger) 1693 '(Willacy)) 1694 base) 1695 (lambda (result) 1696 (equal? result 1697 '(#((Wharton) (Wheeler) (Wichita) (Wilbarger) 1698 (Willacy)))))) 1699 1700(test 'pair-for-each:several-longer-lists 1701 (let ((base '())) 1702 (pair-for-each (lambda tails 1703 (set! base 1704 (cons (apply vector tails) base))) 1705 '(Williamson Wilson Winkler Wise Wood Yoakum 1706 Young) 1707 '(Zapata Zavala Admiral Advil Ajax Anacin 1708 Arrid) 1709 '(Arnold Ban Barbie Beech Blockbuster Bounce 1710 Breck) 1711 '(Budweiser Bufferin BVD Carrier Celeste 1712 Charmin Cheer) 1713 '(Cheerios Cinemax Clairol Clorets Combat 1714 Comet Coppertone)) 1715 base) 1716 (lambda (result) 1717 (equal? result 1718 '(#((Young) (Arrid) (Breck) (Cheer) (Coppertone)) 1719 #((Yoakum Young) (Anacin Arrid) (Bounce Breck) 1720 (Charmin Cheer) (Comet Coppertone)) 1721 #((Wood Yoakum Young) 1722 (Ajax Anacin Arrid) 1723 (Blockbuster Bounce Breck) 1724 (Celeste Charmin Cheer) 1725 (Combat Comet Coppertone)) 1726 #((Wise Wood Yoakum Young) 1727 (Advil Ajax Anacin Arrid) 1728 (Beech Blockbuster Bounce Breck) 1729 (Carrier Celeste Charmin Cheer) 1730 (Clorets Combat Comet Coppertone)) 1731 #((Winkler Wise Wood Yoakum Young) 1732 (Admiral Advil Ajax Anacin Arrid) 1733 (Barbie Beech Blockbuster Bounce Breck) 1734 (BVD Carrier Celeste Charmin Cheer) 1735 (Clairol Clorets Combat Comet Coppertone)) 1736 #((Wilson Winkler Wise Wood Yoakum Young) 1737 (Zavala Admiral Advil Ajax Anacin Arrid) 1738 (Ban Barbie Beech Blockbuster Bounce Breck) 1739 (Bufferin BVD Carrier Celeste Charmin Cheer) 1740 (Cinemax Clairol Clorets Combat Comet 1741 Coppertone)) 1742 #((Williamson Wilson Winkler Wise Wood Yoakum 1743 Young) 1744 (Zapata Zavala Admiral Advil Ajax Anacin Arrid) 1745 (Arnold Ban Barbie Beech Blockbuster Bounce 1746 Breck) 1747 (Budweiser Bufferin BVD Carrier Celeste Charmin 1748 Cheer) 1749 (Cheerios Cinemax Clairol Clorets Combat Comet 1750 Coppertone)))))) 1751 1752;;; FILTER-MAP 1753 1754(test 'filter-map:one-null-list 1755 (filter-map values '()) 1756 null?) 1757 1758(test 'filter-map:one-singleton-list 1759 (filter-map values '(Crest)) 1760 (lambda (result) (equal? result '(Crest)))) 1761 1762(test 'filter-map:one-list-all-elements-removed 1763 (filter-map (lambda (x) #f) 1764 '(Crisco Degree Doritos Dristan Efferdent)) 1765 null?) 1766 1767(test 'filter-map:one-list-some-elements-removed 1768 (filter-map (lambda (n) (and (even? n) n)) 1769 '(44 45 46 47 48 49 50)) 1770 (lambda (result) (equal? result '(44 46 48 50)))) 1771 1772(test 'filter-map:one-list-no-elements-removed 1773 (filter-map values '(ESPN Everready Excedrin Fab Fantastik)) 1774 (lambda (result) 1775 (equal? result '(ESPN Everready Excedrin Fab Fantastik)))) 1776 1777(test 'filter-map:several-null-lists 1778 (filter-map vector '() '() '() '() '()) 1779 null?) 1780 1781(test 'filter-map:several-singleton-lists 1782 (filter-map vector 1783 '(Foamy) 1784 '(Gatorade) 1785 '(Glad) 1786 '(Gleem) 1787 '(Halcion)) 1788 (lambda (result) 1789 (equal? result '(#(Foamy Gatorade Glad Gleem Halcion))))) 1790 1791(test 'filter-map:several-lists-all-elements-removed 1792 (filter-map (lambda arguments #f) 1793 '(Hanes HBO Hostess Huggies Ivory Kent Kinney) 1794 '(Kleenex Knorr Lee Lenox Lerner Listerine 1795 Marlboro) 1796 '(Mazola Michelob Midas Miller NBC Newsweek 1797 Noxema) 1798 '(NutraSweet Oreo Pampers People Planters 1799 Playskool Playtex) 1800 '(Prego Prell Prozac Purex Ritz Robitussin 1801 Rolaids)) 1802 null?) 1803 1804(test 'filter-map:several-lists-some-elements-removed 1805 (filter-map (lambda arguments 1806 (let ((sum (apply + arguments))) 1807 (and (odd? sum) sum))) 1808 '(51 52 53 54 55 56 57) 1809 '(58 59 60 61 62 63 64) 1810 '(65 66 67 68 69 70 71) 1811 '(72 73 74 75 76 77 78) 1812 '(79 80 81 82 83 84 85)) 1813 (lambda (result) (equal? result '(325 335 345 355)))) 1814 1815(test 'filter-map:several-lists-no-elements-removed 1816 (filter-map vector 1817 '(Ronzoni Ruffles Scotch Skippy SnackWell Snapple 1818 Spam) 1819 '(Sprite Swanson Thomas Tide Tonka Trojan 1820 Tupperware) 1821 '(Tylenol Velveeta Vicks Victory Visine Wheaties 1822 Wise) 1823 '(Wonder Ziploc Abbott Abingdon Ackley Ackworth 1824 Adair) 1825 '(Adams Adaville Adaza Adel Adelphi Adena Afton)) 1826 (lambda (result) 1827 (equal? result 1828 '(#(Ronzoni Sprite Tylenol Wonder Adams) 1829 #(Ruffles Swanson Velveeta Ziploc Adaville) 1830 #(Scotch Thomas Vicks Abbott Adaza) 1831 #(Skippy Tide Victory Abingdon Adel) 1832 #(SnackWell Tonka Visine Ackley Adelphi) 1833 #(Snapple Trojan Wheaties Ackworth Adena) 1834 #(Spam Tupperware Wise Adair Afton))))) 1835 1836;;; FILTER 1837 1838(test 'filter:null-list 1839 (filter (lambda (x) #t) '()) 1840 null?) 1841 1842(test 'filter:singleton-list 1843 (filter (lambda (x) #t) '(Agency)) 1844 (lambda (result) (equal? result '(Agency)))) 1845 1846(test 'filter:all-elements-removed 1847 (filter (lambda (x) #f) 1848 '(Ainsworth Akron Albany Albaton Albia)) 1849 null?) 1850 1851(test 'filter:some-elements-removed 1852 (filter even? '(86 87 88 89 90)) 1853 (lambda (result) (equal? result '(86 88 90)))) 1854 1855(test 'filter:no-elements-removed 1856 (filter (lambda (x) #t) 1857 '(Albion Alburnett Alden Alexander Algona)) 1858 (lambda (result) 1859 (equal? result '(Albion Alburnett Alden Alexander Algona)))) 1860 1861;;; FILTER! 1862 1863(test 'filter!:null-list 1864 (filter! (lambda (x) #t) (list)) 1865 null?) 1866 1867(test 'filter!:singleton-list 1868 (filter! (lambda (x) #t) (list 'Alice)) 1869 (lambda (result) (equal? result '(Alice)))) 1870 1871(test 'filter!:all-elements-removed 1872 (filter! (lambda (x) #f) 1873 (list 'Alleman 'Allendorf 'Allerton 'Allison 'Almont)) 1874 null?) 1875 1876(test 'filter!:some-elements-removed 1877 (filter! even? (list 91 92 93 94 95)) 1878 (lambda (result) (equal? result '(92 94)))) 1879 1880(test 'filter!:no-elements-removed 1881 (filter! (lambda (x) #t) 1882 (list 'Almoral 'Alpha 'Alta 'Alton 'Altoona)) 1883 (lambda (result) 1884 (equal? result '(Almoral Alpha Alta Alton Altoona)))) 1885 1886;;; REMOVE 1887 1888(test 'remove:null-list 1889 (remove (lambda (x) #t) '()) 1890 null?) 1891 1892(test 'remove:singleton-list 1893 (remove (lambda (x) #f) '(Alvord)) 1894 (lambda (result) (equal? result '(Alvord)))) 1895 1896(test 'remove:all-elements-removed 1897 (remove (lambda (x) #t) '(Amana Amber Ames Amish Anamosa)) 1898 null?) 1899 1900(test 'remove:some-elements-removed 1901 (remove even? '(96 97 98 99 100)) 1902 (lambda (result) (equal? result '(97 99)))) 1903 1904(test 'remove:no-elements-removed 1905 (remove (lambda (x) #f) 1906 '(Anderson Andover Andrew Andrews Angus)) 1907 (lambda (result) 1908 (equal? result '(Anderson Andover Andrew Andrews Angus)))) 1909 1910;;; REMOVE! 1911 1912(test 'remove!:null-list 1913 (remove! (lambda (x) #t) (list)) 1914 null?) 1915 1916(test 'remove!:singleton-list 1917 (remove! (lambda (x) #f) (list 'Anita)) 1918 (lambda (result) (equal? result '(Anita)))) 1919 1920(test 'remove!:all-elements-removed 1921 (remove! (lambda (x) #t) 1922 (list 'Ankeny 'Anthon 'Aplington 'Arcadia 'Archer)) 1923 null?) 1924 1925(test 'remove!:some-elements-removed 1926 (remove! even? (list 101 102 103 104 105)) 1927 (lambda (result) (equal? result '(101 103 105)))) 1928 1929(test 'remove!:no-elements-removed 1930 (remove! (lambda (x) #f) 1931 (list 'Ardon 'Aredale 'Argo 'Argyle 'Arion)) 1932 (lambda (result) 1933 (equal? result '(Ardon Aredale Argo Argyle Arion)))) 1934 1935;;; PARTITION 1936 1937(test/values 'partition:null-list 1938 '(partition (lambda (x) #f) '()) 1939 (lambda (in out) (and (null? in) (null? out)))) 1940 1941(test/values 'partition:singleton-list 1942 '(partition (lambda (x) #f) '(Arispe)) 1943 (lambda (in out) (and (null? in) (equal? out '(Arispe))))) 1944 1945(test/values 'partition:all-satisfying 1946 '(partition (lambda (x) #t) 1947 '(Arlington Armstrong Arnold Artesian Arthur)) 1948 (lambda (in out) 1949 (and (equal? in 1950 '(Arlington Armstrong Arnold Artesian Arthur)) 1951 (null? out)))) 1952 1953(test/values 'partition:mixed-starting-in 1954 '(partition even? '(106 108 109 111 113 114 115 117 118 120)) 1955 (lambda (in out) 1956 (and (equal? in '(106 108 114 118 120)) 1957 (equal? out '(109 111 113 115 117))))) 1958 1959(test/values 'partition:mixed-starting-out 1960 '(partition even? '(121 122 124 126)) 1961 (lambda (in out) 1962 (and (equal? in '(122 124 126)) 1963 (equal? out '(121))))) 1964 1965(test/values 'partition:none-satisfying 1966 '(partition (lambda (x) #f) 1967 '(Asbury Ashawa Ashland Ashton Aspinwall)) 1968 (lambda (in out) 1969 (and (null? in) 1970 (equal? out 1971 '(Asbury Ashawa Ashland Ashton Aspinwall))))) 1972 1973;;; PARTITION! 1974 1975(test/values 'partition!:null-list 1976 '(partition! (lambda (x) #f) (list)) 1977 (lambda (in out) (and (null? in) (null? out)))) 1978 1979(test/values 'partition!:singleton-list 1980 '(partition! (lambda (x) #f) (list 'Astor)) 1981 (lambda (in out) (and (null? in) (equal? out '(Astor))))) 1982 1983(test/values 'partition!:all-satisfying 1984 '(partition! (lambda (x) #t) 1985 (list 'Atalissa 'Athelstan 'Atkins 'Atlantic 1986 'Attica)) 1987 (lambda (in out) 1988 (and (equal? in 1989 '(Atalissa Athelstan Atkins Atlantic Attica)) 1990 (null? out)))) 1991 1992(test/values 'partition!:mixed-starting-in 1993 '(partition! odd? 1994 (list 127 129 130 132 134 135 136 138 139 141)) 1995 (lambda (in out) 1996 (and (equal? in '(127 129 135 139 141)) 1997 (equal? out '(130 132 134 136 138))))) 1998 1999(test/values 'partition!:mixed-starting-out 2000 '(partition! odd? (list 142 143 145 147)) 2001 (lambda (in out) 2002 (and (equal? in '(143 145 147)) 2003 (equal? out '(142))))) 2004 2005(test/values 'partition!:none-satisfying 2006 '(partition! (lambda (x) #f) 2007 (list 'Auburn 'Audubon 'Augusta 'Aurelia 2008 'Aureola)) 2009 (lambda (in out) 2010 (and (null? in) 2011 (equal? out 2012 '(Auburn Audubon Augusta Aurelia Aureola))))) 2013 2014;;; FIND 2015 2016(test 'find:in-null-list 2017 (find (lambda (x) #t) '()) 2018 not) 2019 2020(test 'find:in-singleton-list 2021 (find (lambda (x) #t) '(Aurora)) 2022 (lambda (result) (eq? result 'Aurora))) 2023 2024(test 'find:not-in-singleton-list 2025 (find (lambda (x) #f) '(Austinville)) 2026 not) 2027 2028(test 'find:at-front-of-longer-list 2029 (find (lambda (x) #t) '(Avery Avoca Avon Ayrshire Badger)) 2030 (lambda (result) (eq? result 'Avery))) 2031 2032(test 'find:in-middle-of-longer-list 2033 (find even? '(149 151 153 155 156 157 159)) 2034 (lambda (result) (= result 156))) 2035 2036(test 'find:at-end-of-longer-list 2037 (find even? '(161 163 165 167 168)) 2038 (lambda (result) (= result 168))) 2039 2040(test 'find:not-in-longer-list 2041 (find (lambda (x) #f) 2042 '(Bagley Bailey Badwin Balfour Balltown)) 2043 not) 2044 2045;;; FIND-TAIL 2046 2047(test 'find-tail:in-null-list 2048 (find-tail (lambda (x) #t) '()) 2049 not) 2050 2051(let ((source '(Ballyclough))) 2052 (test 'find-tail:in-singleton-list 2053 (find-tail (lambda (x) #t) source) 2054 (lambda (result) (eq? result source)))) 2055 2056(test 'find-tail:not-in-singleton-list 2057 (find-tail (lambda (x) #f) '(Bancroft)) 2058 not) 2059 2060(let ((source '(Bangor Bankston Barney Barnum Bartlett))) 2061 (test 'find-tail:at-front-of-longer-list 2062 (find-tail (lambda (x) #t) source) 2063 (lambda (result) (eq? result source)))) 2064 2065(let ((source '(169 171 173 175 176 177 179))) 2066 (test 'find-tail:in-middle-of-longer-list 2067 (find-tail even? source) 2068 (lambda (result) (eq? result (cddddr source))))) 2069 2070(let ((source '(181 183 185 187 188))) 2071 (test 'find-tail:at-end-of-longer-list 2072 (find-tail even? source) 2073 (lambda (result) (eq? result (cddddr source))))) 2074 2075(test 'find-tail:not-in-longer-list 2076 (find-tail (lambda (x) #f) 2077 '(Batavia Bauer Baxter Bayard Beacon)) 2078 not) 2079 2080;;; ANY 2081 2082(test 'any:in-one-null-list 2083 (any values '()) 2084 not) 2085 2086(test 'any:in-one-singleton-list 2087 (any vector '(Beaconsfield)) 2088 (lambda (result) (equal? result '#(Beaconsfield)))) 2089 2090(test 'any:not-in-one-singleton-list 2091 (any (lambda (x) #f) '(Beaman)) 2092 not) 2093 2094(test 'any:at-beginning-of-one-longer-list 2095 (any vector '(Beaver Beaverdale Beckwith Bedford Beebeetown)) 2096 (lambda (result) (equal? result '#(Beaver)))) 2097 2098(test 'any:in-middle-of-one-longer-list 2099 (any (lambda (x) (and (odd? x) (+ x 189))) 2100 '(190 192 194 196 197 198 200)) 2101 (lambda (result) (= result 386))) 2102 2103(test 'any:at-end-of-one-longer-list 2104 (any (lambda (x) (and (odd? x) (+ x 201))) 2105 '(202 204 206 208 209)) 2106 (lambda (result) (= result 410))) 2107 2108(test 'any:not-in-one-longer-list 2109 (any (lambda (x) #f) 2110 '(Beech Belinda Belknap Bellefountain Bellevue)) 2111 not) 2112 2113(test 'any:in-several-null-lists 2114 (any vector '() '() '() '() '()) 2115 not) 2116 2117(test 'any:in-several-singleton-lists 2118 (any vector 2119 '(Belmond) 2120 '(Beloit) 2121 '(Bennett) 2122 '(Benson) 2123 '(Bentley)) 2124 (lambda (result) 2125 (equal? result '#(Belmond Beloit Bennett Benson Bentley)))) 2126 2127(test 'any:not-in-several-singleton-lists 2128 (any (lambda arguments #f) 2129 '(Benton) 2130 '(Bentonsport) 2131 '(Berea) 2132 '(Berkley) 2133 '(Bernard)) 2134 not) 2135 2136(test 'any:at-beginning-of-several-longer-lists 2137 (any vector 2138 '(Berne Bertram Berwick Bethesda Bethlehem Bettendorf 2139 Beulah) 2140 '(Bevington Bidwell Bingham Birmingham Bladensburg 2141 Blairsburg Blairstown) 2142 '(Blakesburg Blanchard Blencoe Bliedorn Blockton 2143 Bloomfield Bloomington) 2144 '(Bluffton Bode Bolan Bonair Bonaparte Bondurant Boone) 2145 '(Booneville Botany Botna Bouton Bowsher Boxholm Boyd)) 2146 (lambda (result) 2147 (equal? result 2148 '#(Berne Bevington Blakesburg Bluffton Booneville)))) 2149 2150(test 'any:in-middle-of-several-longer-lists 2151 (any (lambda arguments 2152 (let ((sum (apply + arguments))) 2153 (and (odd? sum) (+ sum 210)))) 2154 '(211 212 213 214 215 216 217) 2155 '(218 219 220 221 222 223 224) 2156 '(225 226 227 228 229 230 231) 2157 '(232 233 234 235 236 237 238) 2158 '(240 242 244 246 247 248 250)) 2159 (lambda (result) (= result 1359))) 2160 2161(test 'any:at-end-of-several-longer-lists 2162 (any (lambda arguments 2163 (let ((sum (apply + arguments))) 2164 (and (even? sum) (+ sum 210)))) 2165 '(252 253 254 255 256 257 258) 2166 '(259 260 261 262 263 264 265) 2167 '(266 267 268 269 270 271 272) 2168 '(273 274 275 276 277 278 279) 2169 '(281 283 285 287 289 291 292)) 2170 (lambda (result) (= result 1576))) 2171 2172(test 'any:not-in-several-longer-lists 2173 (any (lambda arguments #f) 2174 '(Boyden Boyer Braddyville Bradford Bradgate Brainard 2175 Brandon) 2176 '(Brayton Brazil Breda Bridgewater Brighton Bristol 2177 Bristow) 2178 '(Britt Bromley Brompton Bronson Brooklyn Brooks 2179 Brookville) 2180 '(Browns Brownville Brunsville Brushy Bryant Bryantsburg 2181 Buchanan) 2182 '(Buckeye Buckhorn Buckingham Bucknell Budd Buffalo 2183 Burchinal)) 2184 not) 2185 2186(test 'any:not-in-lists-of-unequal-length 2187 (any (lambda arguments #f) 2188 '(Burdette Burlington Burnside Burt) 2189 '(Bushville Bussey) 2190 '(Buxton Cairo Calamus) 2191 '(Caledonia Clahoun Callender Calmar Caloma Calumet)) 2192 not) 2193 2194;;; EVERY 2195 2196(test 'every:in-one-null-list 2197 (every values '()) 2198 (lambda (result) (eq? result #t))) 2199 2200(test 'every:in-one-singleton-list 2201 (every vector '(Camanche)) 2202 (lambda (result) (equal? result '#(Camanche)))) 2203 2204(test 'every:not-in-one-singleton-list 2205 (every (lambda (x) #f) '(Cambria)) 2206 not) 2207 2208(test 'every:failing-at-beginning-of-one-longer-list 2209 (every (lambda (x) #f) 2210 '(Cambridge Cameron Canby Canton Cantril)) 2211 not) 2212 2213(test 'every:failing-in-middle-of-one-longer-list 2214 (every (lambda (x) (and (even? x) (+ x 293))) 2215 '(294 296 298 300 301 302 304)) 2216 not) 2217 2218(test 'every:failing-at-end-of-one-longer-list 2219 (every (lambda (x) (and (even? x) (+ x 305))) 2220 '(306 308 310 312 313)) 2221 not) 2222 2223(test 'every:in-one-longer-list 2224 (every vector 2225 '(Carbon Carbondale Carl Carlisle Carmel)) 2226 (lambda (result) (equal? result '#(Carmel)))) 2227 2228(test 'every:in-several-null-lists 2229 (every vector '() '() '() '() '()) 2230 (lambda (result) (eq? result #t))) 2231 2232(test 'every:in-several-singleton-lists 2233 (every vector 2234 '(Carnarvon) 2235 '(Carnes) 2236 '(Carney) 2237 '(Carnforth) 2238 '(Carpenter)) 2239 (lambda (result) 2240 (equal? result 2241 '#(Carnarvon Carnes Carney Carnforth Carpenter)))) 2242 2243(test 'every:not-in-several-singleton-lists 2244 (every (lambda arguments #f) 2245 '(Carroll) 2246 '(Carrollton) 2247 '(Carrville) 2248 '(Carson) 2249 '(Cartersville)) 2250 not) 2251 2252(test 'every:failing-at-beginning-of-several-longer-lists 2253 (every (lambda arguments #f) 2254 '(Cascade Casey Castalia Castana Cattese Cedar 2255 Centerdale) 2256 '(Centerville Centralia Ceres Chapin Chariton 2257 Charleston Charlotte) 2258 '(Chatsworth Chautauqua Chelsea Cheney Cherokee Chester 2259 Chickasaw) 2260 '(Chillicothe Churchtown Churchville Churdan Cincinnati 2261 Clare Clarence) 2262 '(Clarinda Clarion Clark Clarkdale Clarksville Clayton 2263 Clearfield)) 2264 not) 2265 2266(test 'every:failing-in-middle-of-several-longer-lists 2267 (every (lambda arguments 2268 (let ((sum (apply + arguments))) 2269 (and (odd? sum) (+ sum 314)))) 2270 '(315 316 317 318 319 320 321) 2271 '(322 323 324 325 326 327 328) 2272 '(329 330 331 332 333 334 335) 2273 '(336 337 338 339 340 341 342) 2274 '(343 345 347 349 350 351 353)) 2275 not) 2276 2277(test 'every:failing-at-end-of-several-longer-lists 2278 (every (lambda arguments 2279 (let ((sum (apply + arguments))) 2280 (and (odd? sum) (+ sum 354)))) 2281 '(355 356 357 358 359 360 361) 2282 '(362 363 364 365 366 367 368) 2283 '(369 370 371 372 373 374 375) 2284 '(376 377 378 379 380 381 382) 2285 '(383 385 387 389 391 393 394)) 2286 not) 2287 2288(test 'every:in-several-longer-lists 2289 (every vector 2290 '(Cleghorn Clemons Clermont Cleves Cliffland Climax 2291 Clinton) 2292 '(Clio Clive Cloverdale Clucas Clutier Clyde Coalville) 2293 '(Coburg Coggon Coin Colesburg Colfax Collett Collins) 2294 '(Colo Columbia Colwell Commerce Communia Competine 2295 Concord) 2296 '(Conesville Confidence Cono Conover Conrad Conroy 2297 Consol)) 2298 (lambda (result) 2299 (equal? result 2300 '#(Clinton Coalville Collins Concord Consol)))) 2301 2302(test 'every:in-lists-of-unequal-length 2303 (every vector 2304 '(Conway Cool Cooper Coppock) 2305 '(Coralville Corley) 2306 '(Cornelia Cornell Corning) 2307 '(Correctionville Corwith Corydon Cosgrove Coster 2308 Cotter)) 2309 (lambda (result) 2310 (equal? result '#(Cool Corley Cornell Corwith)))) 2311 2312;;; LIST-INDEX 2313 2314(test 'list-index:in-one-null-list 2315 (list-index (lambda (x) #t) '()) 2316 not) 2317 2318(test 'list-index:in-one-singleton-list 2319 (list-index (lambda (x) #t) '(Cottonville)) 2320 zero?) 2321 2322(test 'list-index:not-in-one-singleton-list 2323 (list-index (lambda (x) #f) '(Coulter)) 2324 not) 2325 2326(test 'list-index:at-front-of-one-longer-list 2327 (list-index (lambda (x) #t) 2328 '(Covington Craig Cranston Crathorne 2329 Crawfordsville)) 2330 zero?) 2331 2332(test 'list-index:in-middle-of-one-longer-list 2333 (list-index even? '(395 397 399 401 402 403 405)) 2334 (lambda (result) (= result 4))) 2335 2336(test 'list-index:at-end-of-one-longer-list 2337 (list-index odd? '(406 408 410 412 414 415)) 2338 (lambda (result) (= result 5))) 2339 2340(test 'list-index:not-in-one-longer-list 2341 (list-index (lambda (x) #f) 2342 '(Crescent Cresco Creston Crocker Crombie)) 2343 not) 2344 2345(test 'list-index:in-several-null-lists 2346 (list-index (lambda arguments #t) '() '() '() '() '()) 2347 not) 2348 2349(test 'list-index:in-several-singleton-lists 2350 (list-index (lambda arguments #t) 2351 '(Cromwell) 2352 '(Croton) 2353 '(Cumberland) 2354 '(Cumming) 2355 '(Curlew)) 2356 zero?) 2357 2358(test 'list-index:not-in-several-singleton-lists 2359 (list-index (lambda arguments #f) 2360 '(Cushing) 2361 '(Cylinder) 2362 '(Dahlonega) 2363 '(Dalby) 2364 '(Dale)) 2365 not) 2366 2367(test 'list-index:at-front-of-several-longer-lists 2368 (list-index (lambda arguments #t) 2369 '(Dallas Dana Danbury Danville Darbyville 2370 Davenport Dawson) 2371 '(Dayton Daytonville Dean Decorah Dedham Deerfield 2372 Defiance) 2373 '(Delaware Delhi Delmar Deloit Delphos Delta 2374 Denhart) 2375 '(Denison Denmark Denova Denver Depew Derby Devon) 2376 '(Dewar Dexter Diagonal Dickens Dickieville Dike 2377 Dillon)) 2378 zero?) 2379 2380(test 'list-index:in-middle-of-several-longer-lists 2381 (list-index (lambda arguments (odd? (apply + arguments))) 2382 '(416 417 418 419 420 421 422) 2383 '(423 424 425 426 427 428 429) 2384 '(430 431 432 433 434 435 436) 2385 '(437 438 439 440 441 442 443) 2386 '(444 446 448 450 451 452 454)) 2387 (lambda (result) (= result 4))) 2388 2389(test 'list-index:at-end-of-several-longer-lists 2390 (list-index (lambda arguments (even? (apply + arguments))) 2391 '(455 456 457 458 459 460) 2392 '(461 462 463 464 465 466) 2393 '(467 468 469 470 471 472) 2394 '(473 474 475 476 477 478) 2395 '(479 481 483 485 487 488)) 2396 (lambda (result) (= result 5))) 2397 2398(test 'list-index:not-in-several-longer-lists 2399 (list-index (lambda arguments #f) 2400 '(Dinsdale Dixon Dodgeville Dolliver Donahue 2401 Donnan Donnelley) 2402 '(Donnellson Doon Dorchester Doris Douds Dougherty 2403 Douglas) 2404 '(Doney Dows Drakesville Dresden Dubuque Dudley 2405 Dumfries) 2406 '(Dumont Dunbar Duncan Duncombe Dundee Dunkerton 2407 Dunlap) 2408 '(Durango Durant Durham Dutchtown Dyersville 2409 Dysart Earlham)) 2410 not) 2411 2412;;; DELETE 2413 2414(test 'delete:null-list 2415 (delete 'Earling '() (lambda (x y) #t)) 2416 null?) 2417 2418(test 'delete:singleton-list 2419 (delete 'Earlville '(Early) (lambda (x y) #f)) 2420 (lambda (result) (equal? result '(Early)))) 2421 2422(test 'delete:all-elements-removed 2423 (delete 2424 'Eckards 2425 '(Eddyville Edgewood Edinburg Edmore Edna) 2426 (lambda (x y) #t)) 2427 null?) 2428 2429(test 'delete:some-elements-removed 2430 (delete 2431 489 2432 '(490 491 492 493 494) 2433 (lambda (x y) (even? (+ x y)))) 2434 (lambda (result) (equal? result '(490 492 494)))) 2435 2436(test 'delete:no-elements-removed 2437 (delete 2438 'Egan 2439 '(Egralharve Ehler Elberon Eldergrove Eldon) 2440 (lambda (x y) #f)) 2441 (lambda (result) 2442 (equal? result '(Egralharve Ehler Elberon Eldergrove Eldon)))) 2443 2444;;; DELETE! 2445 2446(test 'delete!:null-list 2447 (delete! 'Eldora (list) (lambda (x y) #t)) 2448 null?) 2449 2450(test 'delete!:singleton-list 2451 (delete! 'Eldorado (list 'Eldridge) (lambda (x y) #f)) 2452 (lambda (result) (equal? result '(Eldridge)))) 2453 2454(test 'delete!:all-elements-removed 2455 (delete! 2456 'Eleanor 2457 (list 'Elgin 'Elkader 'Elkhart 'Elkport 'Elliott) 2458 (lambda (x y) #t)) 2459 null?) 2460 2461(test 'delete!:some-elements-removed 2462 (delete! 2463 495 2464 (list 496 497 498 499 500) 2465 (lambda (x y) (odd? (+ x y)))) 2466 (lambda (result) (equal? result '(497 499)))) 2467 2468(test 'delete!:no-elements-removed 2469 (delete! 2470 'Ellston 2471 (list 'Ellsworth 'Elma 'Elmira 'Elon 'Elvira) 2472 (lambda (x y) #f)) 2473 (lambda (result) 2474 (equal? result '(Ellsworth Elma Elmira Elon Elvira)))) 2475 2476;;; DELQ 2477 2478(define delq 2479 (lambda (x lst) 2480 (delete x lst eq?))) 2481 2482(test 'delq:null-list 2483 (delq 'Elwood '()) 2484 null?) 2485 2486(test 'delq:in-singleton-list 2487 (delq 'Ely '(Ely)) 2488 null?) 2489 2490(test 'delq:not-in-singleton-list 2491 (delq 'Emeline '(Emerson)) 2492 (lambda (result) (equal? result '(Emerson)))) 2493 2494(test 'delq:at-beginning-of-longer-list 2495 (delq 'Emery '(Emery Emmetsburg Enterprise Epworth Ericson)) 2496 (lambda (result) 2497 (equal? result '(Emmetsburg Enterprise Epworth Ericson)))) 2498 2499(test 'delq:in-middle-of-longer-list 2500 (delq 'Essex '(Estherville Euclid Evans Evansdale Essex 2501 Evanston Everly)) 2502 (lambda (result) 2503 (equal? result '(Estherville Euclid Evans Evansdale Evanston 2504 Everly)))) 2505 2506(test 'delq:at-end-of-longer-list 2507 (delq 'Ewart '(Exira Exline Fairbank Fairfax Ewart)) 2508 (lambda (result) 2509 (equal? result '(Exira Exline Fairbank Fairfax)))) 2510 2511(test 'delq:not-in-longer-list 2512 (delq 'Fairfield 2513 '(Fairport Fairview Fairville Fanslers Farley)) 2514 (lambda (result) 2515 (equal? result 2516 '(Fairport Fairview Fairville Fanslers Farley)))) 2517 2518(test 'delq:several-matches-in-longer-list 2519 (delq 'Farlin '(Farmersburg Farmington Farlin Farnhamville 2520 Farlin Farragut Farlin)) 2521 (lambda (result) 2522 (equal? result 2523 '(Farmersburg Farmington Farnhamville Farragut)))) 2524 2525;;; DELV 2526 2527(define delv 2528 (lambda (x lst) 2529 (delete x lst eqv?))) 2530 2531(test 'delv:null-list 2532 (delv 'Farrar '()) 2533 null?) 2534 2535(test 'delv:in-singleton-list 2536 (delv 'Farson '(Farson)) 2537 null?) 2538 2539(test 'delv:not-in-singleton-list 2540 (delv 'Faulkner '(Fayette)) 2541 (lambda (result) (equal? result '(Fayette)))) 2542 2543(test 'delv:at-beginning-of-longer-list 2544 (delv 'Fenton '(Fenton Fern Fernald Fertile Festina)) 2545 (lambda (result) 2546 (equal? result '(Fern Fernald Fertile Festina)))) 2547 2548(test 'delv:in-middle-of-longer-list 2549 (delv 'Fielding 2550 '(Fillmore Finchford Findley Fiscus Fielding Fisk Flagler)) 2551 (lambda (result) 2552 (equal? result 2553 '(Fillmore Finchford Findley Fiscus Fisk Flagler)))) 2554 2555(test 'delv:at-end-of-longer-list 2556 (delv 'Florence '(Florenceville Floris Floyd Flugstad Florence)) 2557 (lambda (result) 2558 (equal? result '(Florenceville Floris Floyd Flugstad)))) 2559 2560(test 'delv:not-in-longer-list 2561 (delv 'Folletts 2562 '(Folson Fonda Fontanelle Forbush Forestville)) 2563 (lambda (result) 2564 (equal? result 2565 '(Folson Fonda Fontanelle Forbush Forestville)))) 2566 2567(test 'delv:several-matches-in-longer-list 2568 (delv 'Foster '(Fostoria Frankfort Foster Franklin Foster 2569 Frankville Foster)) 2570 (lambda (result) 2571 (equal? result 2572 '(Fostoria Frankfort Franklin Frankville)))) 2573 2574;;; DELETE 2575 2576(test 'delete:null-list 2577 (delete '(Fraser . Frederic) '()) 2578 null?) 2579 2580(test 'delete:in-singleton-list 2581 (delete '(Fredericksburg . Frederika) 2582 '((Fredericksburg . Frederika))) 2583 null?) 2584 2585(test 'delete:not-in-singleton-list 2586 (delete '(Fredonia . Fredsville) '((Freeman . Freeport))) 2587 (lambda (result) (equal? result '((Freeman . Freeport))))) 2588 2589(test 'delete:at-beginning-of-longer-list 2590 (delete '(Fremont . Froelich) '((Fremont . Froelich) 2591 (Fruitland . Fulton) 2592 (Furay . Galbraith) 2593 (Galesburg . Galland) 2594 (Galt . Galva))) 2595 (lambda (result) 2596 (equal? result '((Fruitland . Fulton) 2597 (Furay . Galbraith) 2598 (Galesburg . Galland) 2599 (Galt . Galva))))) 2600 2601(test 'delete:in-middle-of-longer-list 2602 (delete '(Gambrill . Garber) '((Gardiner . Gardner) 2603 (Garfield . Garland) 2604 (Garnavillo . Garner) 2605 (Garrison . Garwin) 2606 (Gambrill . Garber) 2607 (Gaza . Geneva) 2608 (Genoa . George))) 2609 (lambda (result) 2610 (equal? result '((Gardiner . Gardner) 2611 (Garfield . Garland) 2612 (Garnavillo . Garner) 2613 (Garrison . Garwin) 2614 (Gaza . Geneva) 2615 (Genoa . George))))) 2616 2617(test 'delete:at-end-of-longer-list 2618 (delete '(Georgetown . Gerled) '((Germantown . Germanville) 2619 (Giard . Gibbsville) 2620 (Gibson . Gifford) 2621 (Gilbert . Gilbertville) 2622 (Georgetown . Gerled))) 2623 (lambda (result) 2624 (equal? result '((Germantown . Germanville) 2625 (Giard . Gibbsville) 2626 (Gibson . Gifford) 2627 (Gilbert . Gilbertville))))) 2628 2629(test 'delete:not-in-longer-list 2630 (delete '(Gilliatt . Gilman) '((Givin . Gladbrook) 2631 (Gladstone . Gladwin) 2632 (Glasgow . Glendon) 2633 (Glenwood . Glidden) 2634 (Goddard . Goldfield))) 2635 (lambda (result) 2636 (equal? result '((Givin . Gladbrook) 2637 (Gladstone . Gladwin) 2638 (Glasgow . Glendon) 2639 (Glenwood . Glidden) 2640 (Goddard . Goldfield))))) 2641 2642(test 'delete:several-matches-in-longer-list 2643 (delete '(Goodell . Gosport) '((Gowrie . Goddard) 2644 (Grable . Graettinger) 2645 (Goodell . Gosport) 2646 (Graf . Grafton) 2647 (Goodell . Gosport) 2648 (Grandview . Granger) 2649 (Goodell . Gosport))) 2650 (lambda (result) 2651 (equal? result '((Gowrie . Goddard) 2652 (Grable . Graettinger) 2653 (Graf . Grafton) 2654 (Grandview . Granger))))) 2655 2656;;; DELQ! 2657 2658(define delq! 2659 (lambda (x lst) 2660 (delete! x lst eq?))) 2661 2662(test 'delq!:null-list 2663 (delq! 'Granite (list)) 2664 null?) 2665 2666(test 'delq!:in-singleton-list 2667 (delq! 'Grant (list 'Grant)) 2668 null?) 2669 2670(test 'delq!:not-in-singleton-list 2671 (delq! 'Granville (list 'Gravity)) 2672 (lambda (result) (equal? result '(Gravity)))) 2673 2674(test 'delq!:at-beginning-of-longer-list 2675 (delq! 'Gray 2676 (list 'Gray 'Greeley 'Greenbush 'Greene 'Greenfield)) 2677 (lambda (result) 2678 (equal? result '(Greeley Greenbush Greene Greenfield)))) 2679 2680(test 'delq!:in-middle-of-longer-list 2681 (delq! 'Gridley (list 'Griffinsville 'Grimes 'Grinnell 2682 'Griswold 'Gridley 'Gruver 'Guernsey)) 2683 (lambda (result) 2684 (equal? result '(Griffinsville Grimes Grinnell Griswold 2685 Gruver Guernsey)))) 2686 2687(test 'delq!:at-end-of-longer-list 2688 (delq! 'Gunder 2689 (list 'Guss 'Guttenberg 'Gypsum 'Halbur 'Gunder)) 2690 (lambda (result) 2691 (equal? result '(Guss Guttenberg Gypsum Halbur)))) 2692 2693(test 'delq!:not-in-longer-list 2694 (delq! 'Hale 2695 (list 'Hamburg 'Hamilton 'Hamlin 'Hampton 'Hancock)) 2696 (lambda (result) 2697 (equal? result 2698 '(Hamburg Hamilton Hamlin Hampton Hancock)))) 2699 2700(test 'delq!:several-matches-in-longer-list 2701 (delq! 'Hanford (list 'Hanley 'Hanlontown 'Hanford 'Hanna 2702 'Hanford 'Hanover 'Hanford)) 2703 (lambda (result) 2704 (equal? result '(Hanley Hanlontown Hanna Hanover)))) 2705 2706;;; DELV! 2707 2708(define delv! 2709 (lambda (x lst) 2710 (delete! x lst eqv?))) 2711 2712(test 'delv!:null-list 2713 (delv! 'Hansell (list)) 2714 null?) 2715 2716(test 'delv!:in-singleton-list 2717 (delv! 'Harcourt (list 'Harcourt)) 2718 null?) 2719 2720(test 'delv!:not-in-singleton-list 2721 (delv! 'Hardin (list 'Hardy)) 2722 (lambda (result) (equal? result '(Hardy)))) 2723 2724(test 'delv!:at-beginning-of-longer-list 2725 (delv! 'Harlan 2726 (list 'Harlan 'Harper 'Harris 'Harrisburg 'Hartford)) 2727 (lambda (result) 2728 (equal? result '(Harper Harris Harrisburg Hartford)))) 2729 2730(test 'delv!:in-middle-of-longer-list 2731 (delv! 'Hartley (list 'Hartwick 'Harvard 'Harvey 'Haskins 2732 'Hartley 'Hastie 'Hastings)) 2733 (lambda (result) 2734 (equal? result '(Hartwick Harvard Harvey Haskins Hastie 2735 Hastings)))) 2736 2737(test 'delv!:at-end-of-longer-list 2738 (delv! 'Hauntown 2739 (list 'Havelock 'Haven 'Haverhill 'Havre 'Hauntown)) 2740 (lambda (result) 2741 (equal? result '(Havelock Haven Haverhill Havre)))) 2742 2743(test 'delv!:not-in-longer-list 2744 (delv! 'Hawarden (list 'Hawkeye 'Hawleyville 'Hawthorne 2745 'Hayesville 'Hayfield)) 2746 (lambda (result) 2747 (equal? result '(Hawkeye Hawleyville Hawthorne Hayesville 2748 Hayfield)))) 2749 2750(test 'delv!:several-matches-in-longer-list 2751 (delv! 'Hazleton (list 'Hebron 'Hedrick 'Hazleton 'Helena 2752 'Hazleton 'Henderson 'Hazleton)) 2753 (lambda (result) 2754 (equal? result '(Hebron Hedrick Helena Henderson)))) 2755 2756;;; DELETE! 2757 2758(test 'delete!:null-list 2759 (delete! (cons 'Henshaw 'Hentons) (list)) 2760 null?) 2761 2762(test 'delete!:in-singleton-list 2763 (delete! (cons 'Hepburn 'Herndon) 2764 (list (cons 'Hepburn 'Herndon))) 2765 null?) 2766 2767(test 'delete!:not-in-singleton-list 2768 (delete! (cons 'Hesper 'Hiattsville) 2769 (list (cons 'Hiawatha 'Hicks))) 2770 (lambda (result) (equal? result '((Hiawatha . Hicks))))) 2771 2772(test 'delete!:at-beginning-of-longer-list 2773 (delete! (cons 'Highland 'Highlandville) 2774 (list (cons 'Highland 'Highlandville) 2775 (cons 'Highview 'Hills) 2776 (cons 'Hillsboro 'Hillsdale) 2777 (cons 'Hilltop 'Hinton) 2778 (cons 'Hiteman 'Hobarton))) 2779 (lambda (result) 2780 (equal? result '((Highview . Hills) 2781 (Hillsboro . Hillsdale) 2782 (Hilltop . Hinton) 2783 (Hiteman . Hobarton))))) 2784 2785(test 'delete!:in-middle-of-longer-list 2786 (delete! (cons 'Hocking 'Holbrook) 2787 (list (cons 'Holland 'Holmes) 2788 (cons 'Holstein 'Homer) 2789 (cons 'Homestead 'Hopeville) 2790 (cons 'Hopkinton 'Hornick) 2791 (cons 'Hocking 'Holbrook) 2792 (cons 'Horton 'Hospers) 2793 (cons 'Houghton 'Howardville))) 2794 (lambda (result) 2795 (equal? result '((Holland . Holmes) 2796 (Holstein . Homer) 2797 (Homestead . Hopeville) 2798 (Hopkinton . Hornick) 2799 (Horton . Hospers) 2800 (Houghton . Howardville))))) 2801 2802(test 'delete!:at-end-of-longer-list 2803 (delete! (cons 'Howe 'Hubbard) 2804 (list (cons 'Hudson 'Hugo) 2805 (cons 'Hull 'Humboldt) 2806 (cons 'Humeston 'Huntington) 2807 (cons 'Hurley 'Huron) 2808 (cons 'Howe 'Hubbard))) 2809 (lambda (result) 2810 (equal? result '((Hudson . Hugo) 2811 (Hull . Humboldt) 2812 (Humeston . Huntington) 2813 (Hurley . Huron))))) 2814 2815(test 'delete!:not-in-longer-list 2816 (delete! (cons 'Hurstville 'Hutchins) 2817 (list (cons 'Huxley 'Iconium) 2818 (cons 'Illyria 'Imogene) 2819 (cons 'Independence 'Indianapolis) 2820 (cons 'Indianola 'Industry) 2821 (cons 'Inwood 'Ion))) 2822 (lambda (result) 2823 (equal? result '((Huxley . Iconium) 2824 (Illyria . Imogene) 2825 (Independence . Indianapolis) 2826 (Indianola . Industry) 2827 (Inwood . Ion))))) 2828 2829(test 'delete!:several-matches-in-longer-list 2830 (delete! (cons 'Ionia 'Ira) 2831 (list (cons 'Ireton 'Ironhills) 2832 (cons 'Irving 'Irvington) 2833 (cons 'Ionia 'Ira) 2834 (cons 'Irwin 'Ivester) 2835 (cons 'Ionia 'Ira) 2836 (cons 'Iveyville 'Ivy) 2837 (cons 'Ionia 'Ira))) 2838 (lambda (result) 2839 (equal? result '((Ireton . Ironhills) 2840 (Irving . Irvington) 2841 (Irwin . Ivester) 2842 (Iveyville . Ivy))))) 2843 2844;;; DEL-DUPLICATES 2845 2846(define del-duplicates 2847 (lambda (f lst) 2848 (delete-duplicates lst f))) 2849 2850(test 'del-duplicates:null-list 2851 (del-duplicates (lambda (x y) #t) '()) 2852 null?) 2853 2854(test 'del-duplicates:singleton-list 2855 (del-duplicates (lambda (x y) #t) '(Jacksonville)) 2856 (lambda (result) (equal? result '(Jacksonville)))) 2857 2858(test 'del-duplicates:in-doubleton-list 2859 (del-duplicates (lambda (x y) #t) '(Jamaica James)) 2860 (lambda (result) (equal? result '(Jamaica)))) 2861 2862(test 'del-duplicates:none-removed-in-longer-list 2863 (del-duplicates (lambda (x y) #f) 2864 '(Jamestown Jamison Janesville Jefferson 2865 Jerome)) 2866 (lambda (result) 2867 (equal? result '(Jamestown Jamison Janesville Jefferson 2868 Jerome)))) 2869 2870(test 'del-duplicates:some-removed-in-longer-list 2871 (del-duplicates (lambda (x y) (= (+ x y) 1011)) 2872 '(501 502 503 504 508 510 511)) 2873 (lambda (result) (equal? result '(501 502 503 504 511)))) 2874 2875(test 'del-duplicates:all-but-one-removed-in-longer-list 2876 (del-duplicates (lambda (x y) #t) 2877 '(Jesup Jewell Johnston Joice Jolley)) 2878 (lambda (result) (equal? result '(Jesup)))) 2879 2880;;; DEL-DUPLICATES! 2881 2882(define del-duplicates! 2883 (lambda (f lst) 2884 (delete-duplicates! lst f))) 2885 2886(test 'del-duplicates!:null-list 2887 (del-duplicates! (lambda (x y) #t) '()) 2888 null?) 2889 2890(test 'del-duplicates!:singleton-list 2891 (del-duplicates! (lambda (x y) #t) (list 'Jordan)) 2892 (lambda (result) (equal? result '(Jordan)))) 2893 2894(test 'del-duplicates!:in-doubleton-list 2895 (del-duplicates! (lambda (x y) #t) (list 'Jubilee 'Judd)) 2896 (lambda (result) (equal? result '(Jubilee)))) 2897 2898(test 'del-duplicates!:none-removed-in-longer-list 2899 (del-duplicates! (lambda (x y) #f) 2900 (list 'Julien 'Juniata 'Kalo 'Kalona 2901 'Kamrar)) 2902 (lambda (result) 2903 (equal? result '(Julien Juniata Kalo Kalona Kamrar)))) 2904 2905(test 'del-duplicates!:some-removed-in-longer-list 2906 (del-duplicates! (lambda (x y) (= (+ x y) 1031)) 2907 (list 511 512 513 514 518 520 521)) 2908 (lambda (result) (equal? result '(511 512 513 514 521)))) 2909 2910(test 'del-duplicates!:all-but-one-removed-in-longer-list 2911 (del-duplicates! (lambda (x y) #t) 2912 (list 'Kanawha 'Kellerton 'Kelley 'Kellogg 2913 'Kendallville)) 2914 (lambda (result) (equal? result '(Kanawha)))) 2915 2916;;; DELQ-DUPLICATES 2917 2918(define delq-duplicates 2919 (lambda (lst) 2920 (delete-duplicates lst eq?))) 2921 2922(test 'delq-duplicates:null-list 2923 (delq-duplicates '()) 2924 null?) 2925 2926(test 'delq-duplicates:singleton-list 2927 (delq-duplicates '(Kenfield)) 2928 (lambda (result) (equal? result '(Kenfield)))) 2929 2930(test 'delq-duplicates:in-doubleton-list 2931 (delq-duplicates '(Kennebec Kennebec)) 2932 (lambda (result) (equal? result '(Kennebec)))) 2933 2934(test 'delq-duplicates:none-removed-in-longer-list 2935 (delq-duplicates '(Kennedy Kensett Kent Kenwood Keokuk)) 2936 (lambda (result) 2937 (equal? result '(Kennedy Kensett Kent Kenwood Keokuk)))) 2938 2939(test 'delq-duplicates:some-removed-in-longer-list 2940 (delq-duplicates '(Keosauqua Keota Keota Kesley Keosauqua 2941 Keswick Keota Keystone Keota)) 2942 (lambda (result) 2943 (equal? result '(Keosauqua Keota Kesley Keswick Keystone)))) 2944 2945(test 'delq-duplicates:all-but-one-removed-in-longer-list 2946 (delq-duplicates '(Kidder Kidder Kidder Kidder Kidder)) 2947 (lambda (result) (equal? result '(Kidder)))) 2948 2949;;; DELV-DUPLICATES 2950 2951(define delv-duplicates 2952 (lambda (lst) 2953 (delete-duplicates lst eqv?))) 2954 2955(test 'delv-duplicates:null-list 2956 (delv-duplicates '()) 2957 null?) 2958 2959(test 'delv-duplicates:singleton-list 2960 (delv-duplicates '(Kilbourn)) 2961 (lambda (result) (equal? result '(Kilbourn)))) 2962 2963(test 'delv-duplicates:in-doubleton-list 2964 (delv-duplicates '(Killduff Killduff)) 2965 (lambda (result) (equal? result '(Killduff)))) 2966 2967(test 'delv-duplicates:none-removed-in-longer-list 2968 (delv-duplicates '(Kimballton King Kingsley Kingston Kinross)) 2969 (lambda (result) 2970 (equal? result 2971 '(Kimballton King Kingsley Kingston Kinross)))) 2972 2973(test 'delv-duplicates:some-removed-in-longer-list 2974 (delv-duplicates '(Kirkman Kirkville Kirkville Kiron Kirkman 2975 Klemme Kirkville Klinger Kirkville)) 2976 (lambda (result) 2977 (equal? result '(Kirkman Kirkville Kiron Klemme Klinger)))) 2978 2979(test 'delv-duplicates:all-but-one-removed-in-longer-list 2980 (delv-duplicates '(Klondike Klondike Klondike Klondike Klondike)) 2981 (lambda (result) (equal? result '(Klondike)))) 2982 2983;;; DELETE-DUPLICATES 2984 2985(test 'delete-duplicates:null-list 2986 (delete-duplicates '()) 2987 null?) 2988 2989(test 'delete-duplicates:singleton-list 2990 (delete-duplicates '((Knierim . Knittel))) 2991 (lambda (result) (equal? result '((Knierim . Knittel))))) 2992 2993(test 'delete-duplicates:in-doubleton-list 2994 (delete-duplicates '((Knoke . Knowlton) (Knoke . Knowlton))) 2995 (lambda (result) (equal? result '((Knoke . Knowlton))))) 2996 2997(test 'delete-duplicates:none-removed-in-longer-list 2998 (delete-duplicates '((Knox . Knoxville) 2999 (Konigsmark . Kossuth) 3000 (Koszta . Lacelle) 3001 (Lacey . Lacona) 3002 (Ladoga . Ladora))) 3003 (lambda (result) 3004 (equal? result '((Knox . Knoxville) 3005 (Konigsmark . Kossuth) 3006 (Koszta . Lacelle) 3007 (Lacey . Lacona) 3008 (Ladoga . Ladora))))) 3009 3010(test 'delete-duplicates:some-removed-in-longer-list 3011 (delete-duplicates '((Lafayette . Lainsville) 3012 (Lakeside . Lakewood) 3013 (Lakeside . Lakewood) 3014 (Lakonta . Lakota) 3015 (Lafayette . Lainsville) 3016 (Lamoille . Lamoni) 3017 (Lakeside . Lakewood) 3018 (Lamont . Lancaster) 3019 (Lakeside . Lakewood))) 3020 (lambda (result) 3021 (equal? result '((Lafayette . Lainsville) 3022 (Lakeside . Lakewood) 3023 (Lakonta . Lakota) 3024 (Lamoille . Lamoni) 3025 (Lamont . Lancaster))))) 3026 3027(test 'delete-duplicates:all-but-one-removed-in-longer-list 3028 (delete-duplicates '((Lanesboro . Langdon) 3029 (Lanesboro . Langdon) 3030 (Lanesboro . Langdon) 3031 (Lanesboro . Langdon) 3032 (Lanesboro . Langdon))) 3033 (lambda (result) (equal? result '((Lanesboro . Langdon))))) 3034 3035;;; DELQ-DUPLICATES! 3036 3037(define delq-duplicates! 3038 (lambda (lst) 3039 (delete-duplicates! lst eq?))) 3040 3041(test 'delq-duplicates!:null-list 3042 (delq-duplicates! (list)) 3043 null?) 3044 3045(test 'delq-duplicates!:singleton-list 3046 (delq-duplicates! (list 'Langworthy)) 3047 (lambda (result) (equal? result '(Langworthy)))) 3048 3049(test 'delq-duplicates!:in-doubleton-list 3050 (delq-duplicates! (list 'Lansing 'Lansing)) 3051 (lambda (result) (equal? result '(Lansing)))) 3052 3053(test 'delq-duplicates!:none-removed-in-longer-list 3054 (delq-duplicates! (list 'Lanyon 'Larchwood 'Larland 'Larrabee 3055 'Latimer)) 3056 (lambda (result) 3057 (equal? result 3058 '(Lanyon Larchwood Larland Larrabee Latimer)))) 3059 3060(test 'delq-duplicates!:some-removed-in-longer-list 3061 (delq-duplicates! (list 'Lattnerville 'Latty 'Latty 'Laurel 3062 'Lattnerville 'Laurens 'Latty 'Lavinia 3063 'Latty)) 3064 (lambda (result) 3065 (equal? result 3066 '(Lattnerville Latty Laurel Laurens Lavinia)))) 3067 3068(test 'delq-duplicates!:all-but-one-removed-in-longer-list 3069 (delq-duplicates! (list 'Lawler 'Lawler 'Lawler 'Lawler 3070 'Lawler)) 3071 (lambda (result) (equal? result '(Lawler)))) 3072 3073;;; DELV-DUPLICATES! 3074 3075(define delv-duplicates! 3076 (lambda (lst) 3077 (delete-duplicates! lst eqv?))) 3078 3079(test 'delv-duplicates!:null-list 3080 (delv-duplicates! (list)) 3081 null?) 3082 3083(test 'delv-duplicates!:singleton-list 3084 (delv-duplicates! (list 'Lawton)) 3085 (lambda (result) (equal? result '(Lawton)))) 3086 3087(test 'delv-duplicates!:in-doubleton-list 3088 (delv-duplicates! (list 'Leando 'Leando)) 3089 (lambda (result) (equal? result '(Leando)))) 3090 3091(test 'delv-duplicates!:none-removed-in-longer-list 3092 (delv-duplicates! (list 'Lebanon 'Ledyard 'Leeds 'Lehigh 3093 'Leighton)) 3094 (lambda (result) 3095 (equal? result '(Lebanon Ledyard Leeds Lehigh Leighton)))) 3096 3097(test 'delv-duplicates!:some-removed-in-longer-list 3098 (delv-duplicates! (list 'Leland 'Lena 'Lena 'Lenox 'Leland 3099 'Leon 'Lena 'LeRoy 'Lena)) 3100 (lambda (result) 3101 (equal? result '(Leland Lena Lenox Leon LeRoy)))) 3102 3103(test 'delv-duplicates!:all-but-one-removed-in-longer-list 3104 (delv-duplicates! (list 'Leslie 'Leslie 'Leslie 'Leslie 3105 'Leslie)) 3106 (lambda (result) (equal? result '(Leslie)))) 3107 3108;;; DELETE-DUPLICATES! 3109 3110(test 'delete-duplicates!:null-list 3111 (delete-duplicates! (list)) 3112 null?) 3113 3114(test 'delete-duplicates!:singleton-list 3115 (delete-duplicates! (list (cons 'Lester 'Letts))) 3116 (lambda (result) (equal? result '((Lester . Letts))))) 3117 3118(test 'delete-duplicates!:in-doubleton-list 3119 (delete-duplicates! (list (cons 'Leverette 'Levey) 3120 (cons 'Leverette 'Levey))) 3121 (lambda (result) (equal? result '((Leverette . Levey))))) 3122 3123(test 'delete-duplicates!:none-removed-in-longer-list 3124 (delete-duplicates! (list (cons 'Lewis 'Lexington) 3125 (cons 'Liberty 'Libertyville) 3126 (cons 'Lidderdale 'Lima) 3127 (cons 'Linby 'Lincoln) 3128 (cons 'Linden 'Lineville))) 3129 (lambda (result) 3130 (equal? result '((Lewis . Lexington) 3131 (Liberty . Libertyville) 3132 (Lidderdale . Lima) 3133 (Linby . Lincoln) 3134 (Linden . Lineville))))) 3135 3136(test 'delete-duplicates!:some-removed-in-longer-list 3137 (delete-duplicates! (list (cons 'Lisbon 'Liscomb) 3138 (cons 'Littleport 'Littleton) 3139 (cons 'Littleport 'Littleton) 3140 (cons 'Livermore 'Livingston) 3141 (cons 'Lisbon 'Liscomb) 3142 (cons 'Lockman 'Lockridge) 3143 (cons 'Littleport 'Littleton) 3144 (cons 'Locust 'Logan) 3145 (cons 'Littleport 'Littleton))) 3146 (lambda (result) 3147 (equal? result '((Lisbon . Liscomb) 3148 (Littleport . Littleton) 3149 (Livermore . Livingston) 3150 (Lockman . Lockridge) 3151 (Locust . Logan))))) 3152 3153(test 'delete-duplicates!:all-but-one-removed-in-longer-list 3154 (delete-duplicates! (list (cons 'Logansport 'Lohrville) 3155 (cons 'Logansport 'Lohrville) 3156 (cons 'Logansport 'Lohrville) 3157 (cons 'Logansport 'Lohrville) 3158 (cons 'Logansport 'Lohrville))) 3159 (lambda (result) 3160 (equal? result '((Logansport . Lohrville))))) 3161 3162;;; MEM 3163 3164(define mem 3165 (lambda (elm= x lst) 3166 (srfi-1:member x lst elm=))) 3167 3168(test 'mem:null-list 3169 (mem (lambda (x y) #t) 'Lorah '()) 3170 not) 3171 3172(let ((source '(Lore))) 3173 (test 'mem:in-singleton-list 3174 (mem (lambda (x y) #t) 'Lorimor source) 3175 (lambda (result) (eq? result source)))) 3176 3177(test 'mem:not-in-singleton-list 3178 (mem (lambda (x y) #f) 'Loring '(Loring)) 3179 not) 3180 3181(let ((source '(Lossing Louisa Lourdes Loveland Lovilla))) 3182 (test 'mem:at-beginning-of-longer-list 3183 (mem (lambda (x y) #t) 'Lovington source) 3184 (lambda (result) (eq? result source)))) 3185 3186(let ((source '(521 522 523 524 528 525 526))) 3187 (test 'mem:in-middle-of-longer-list 3188 (mem < 527 source) 3189 (lambda (result) (eq? result (cddddr source))))) 3190 3191(let ((source '(529 530 531 532 534))) 3192 (test 'mem:at-end-of-longer-list 3193 (mem < 533 source) 3194 (lambda (result) (eq? result (cddddr source))))) 3195 3196(test 'mem:not-in-longer-list 3197 (mem (lambda (x y) #f) 3198 'Lowden 3199 '(Lowell Luana Lucas Ludlow Lundgren)) 3200 not) 3201 3202;;; ASS 3203 3204(define ass 3205 (lambda (elm= x lst) 3206 (srfi-1:assoc x lst elm=))) 3207 3208(test 'ass:null-list 3209 (ass (lambda (x y) #t) 'Lunsford '()) 3210 not) 3211 3212(let ((source '((Luray . Luther)))) 3213 (test 'ass:in-singleton-list 3214 (ass (lambda (x y) #t) 'Luton source) 3215 (lambda (result) (eq? result (car source))))) 3216 3217(test 'ass:not-in-singleton-list 3218 (ass (lambda (x y) #f) 'LuVerne '((Luxemburg . Luzerne))) 3219 not) 3220 3221(let ((source '((Lycurgus . Lyman) 3222 (Lyndale . Lynnville) 3223 (Lytton . Macedonia) 3224 (Mackey . Macksburg) 3225 (Madrid . Magnolia)))) 3226 (test 'ass:at-beginning-of-longer-list 3227 (ass (lambda (x y) #t) 'Maine source) 3228 (lambda (result) (eq? result (car source))))) 3229 3230(let ((source '((535 . 536) 3231 (537 . 538) 3232 (539 . 540) 3233 (541 . 542) 3234 (549 . 543) 3235 (544 . 545) 3236 (546 . 547)))) 3237 (test 'ass:in-middle-of-longer-list 3238 (ass < 548 source) 3239 (lambda (result) (eq? result (car (cddddr source)))))) 3240 3241(let ((source '((550 . 551) 3242 (552 . 553) 3243 (554 . 555) 3244 (556 . 557) 3245 (560 . 558)))) 3246 (test 'ass:at-end-of-longer-list 3247 (ass < 559 source) 3248 (lambda (result) (eq? result (car (cddddr source)))))) 3249 3250(test 'ass:not-in-longer-list 3251 (ass (lambda (x y) #f) 3252 'Malcom 3253 '((Malcom . Mallard) 3254 (Malcom . Malone) 3255 (Malcom . Maloy) 3256 (Malcom . Malvern) 3257 (Malcom . Mammon))) 3258 not) 3259 3260;;; ACONS 3261 3262(define acons alist-cons) 3263 3264(test 'acons:null-list 3265 (acons 'Manawa 'Manchester '()) 3266 (lambda (result) (equal? result '((Manawa . Manchester))))) 3267 3268(let ((base '((Manilla . Manly)))) 3269 (test 'acons:singleton-list 3270 (acons 'Manning 'Manson base) 3271 (lambda (result) 3272 (and (equal? result '((Manning . Manson) 3273 (Manilla . Manly))) 3274 (eq? (cdr result) base))))) 3275 3276(let ((base '((Manteno . Mapleside) 3277 (Mapleton . Maquoketa) 3278 (Marathon . Marcus) 3279 (Marengo . Marietta) 3280 (Marion . Mark)))) 3281 (test 'acons:longer-list 3282 (acons 'Marne 'Marquette base) 3283 (lambda (result) 3284 (and (equal? result '((Marne . Marquette) 3285 (Manteno . Mapleside) 3286 (Mapleton . Maquoketa) 3287 (Marathon . Marcus) 3288 (Marengo . Marietta) 3289 (Marion . Mark))) 3290 (eq? (cdr result) base))))) 3291 3292(let ((base '((Marquisville . Marsh) 3293 (Marshalltown . Martelle) 3294 (Martensdale . Martinsburg) 3295 (Martinstown . Marysville) 3296 (Masonville . Massena) 3297 (Massey . Massilon) 3298 (Matlock . Maud)))) 3299 (test 'acons:longer-list-with-duplicate-key 3300 (acons 'Masonville 'Maurice base) 3301 (lambda (result) 3302 (and (equal? result '((Masonville . Maurice) 3303 (Marquisville . Marsh) 3304 (Marshalltown . Martelle) 3305 (Martensdale . Martinsburg) 3306 (Martinstown . Marysville) 3307 (Masonville . Massena) 3308 (Massey . Massilon) 3309 (Matlock . Maud))) 3310 (eq? (cdr result) base))))) 3311 3312;;; ALIST-COPY 3313 3314(test 'alist-copy:null-list 3315 (alist-copy '()) 3316 null?) 3317 3318(let ((original '((Maxon . Maxwell) 3319 (Maynard . Maysville) 3320 (McCallsburg . McCausland) 3321 (McClelland . McGregor) 3322 (McIntire . McNally)))) 3323 (test 'alist-copy:flat-list 3324 (alist-copy original) 3325 (lambda (result) 3326 (and (equal? result original) 3327 (not (eq? result original)) 3328 (not (eq? (car result) (car original))) 3329 (not (eq? (cdr result) (cdr original))) 3330 (not (eq? (cadr result) (cadr original))) 3331 (not (eq? (cddr result) (cddr original))) 3332 (not (eq? (caddr result) (caddr original))) 3333 (not (eq? (cdddr result) (cdddr original))) 3334 (not (eq? (cadddr result) (cadddr original))) 3335 (not (eq? (cddddr result) (cddddr original))) 3336 (not (eq? (car (cddddr result)) 3337 (car (cddddr original)))))))) 3338 3339(let ((first '(McPaul)) 3340 (second '(McPherson 3341 Mechanicsville 3342 Mederville 3343 (Mediapolis Medora) 3344 ((Mekee Melbourne Melcher)))) 3345 (third 'Melrose)) 3346 (let ((original (list (cons 'Meltonville first) 3347 (cons 'Melvin second) 3348 (cons 'Menlo third)))) 3349 (test 'alist-copy:bush 3350 (alist-copy original) 3351 (lambda (result) 3352 (and (equal? result original) 3353 (not (eq? result original)) 3354 (not (eq? (car result) (car original))) 3355 (eq? (cdar result) first) 3356 (not (eq? (cdr result) (cdr original))) 3357 (not (eq? (cadr result) (cadr original))) 3358 (eq? (cdadr result) second) 3359 (not (eq? (cddr result) (cddr original))) 3360 (not (eq? (caddr result) (caddr original))) 3361 (eq? (cdaddr result) third)))))) 3362 3363;;; ALIST-DELETE 3364 3365(test 'alist-delete:null-list 3366 (alist-delete 'Mercer '() (lambda (x y) #t)) 3367 null?) 3368 3369(test 'alist-delete:singleton-list 3370 (alist-delete 3371 'Meriden 3372 '((Merrill . Merrimac)) 3373 (lambda (x y) #f)) 3374 (lambda (result) (equal? result '((Merrill . Merrimac))))) 3375 3376(test 'alist-delete:all-elements-removed 3377 (alist-delete 3378 'Meservey 3379 '((Metz . Meyer) 3380 (Middleburg . Middletwon) 3381 (Midvale . Midway) 3382 (Miles . Milford) 3383 (Miller . Millersburg)) 3384 (lambda (x y) #t)) 3385 null?) 3386 3387(test 'alist-delete:some-elements-removed 3388 (alist-delete 3389 561 3390 '((562 . 563) 3391 (565 . 564) 3392 (566 . 567) 3393 (569 . 568) 3394 (570 . 571)) 3395 (lambda (x y) (odd? (+ x y)))) 3396 (lambda (result) 3397 (equal? result '((565 . 564) (569 . 568))))) 3398 3399(test 'alist-delete:no-elements-removed 3400 (alist-delete 3401 'Millerton 3402 '((Millman . Millnerville) 3403 (Millville . Milo) 3404 (Milton . Minburn) 3405 (Minden . Mineola) 3406 (Minerva . Mingo)) 3407 (lambda (x y) #f)) 3408 (lambda (result) 3409 (equal? result '((Millman . Millnerville) 3410 (Millville . Milo) 3411 (Milton . Minburn) 3412 (Minden . Mineola) 3413 (Minerva . Mingo))))) 3414 3415;;; ALIST-DELETE! 3416 3417(test 'alist-delete!:null-list 3418 (alist-delete! 'Mitchell '() (lambda (x y) #t)) 3419 null?) 3420 3421(test 'alist-delete!:singleton-list 3422 (alist-delete! 3423 'Mitchellville 3424 (list (cons 'Modale 'Moingona)) 3425 (lambda (x y) #f)) 3426 (lambda (result) (equal? result '((Modale . Moingona))))) 3427 3428(test 'alist-delete!:all-elements-removed 3429 (alist-delete! 3430 'Mona 3431 (list (cons 'Mondamin 'Moneta) 3432 (cons 'Moningers 'Monmouth) 3433 (cons 'Monona 'Monroe) 3434 (cons 'Monteith 'Monterey) 3435 (cons 'Montezuma 'Montgomery)) 3436 (lambda (x y) #t)) 3437 null?) 3438 3439(test 'alist-delete!:some-elements-removed 3440 (alist-delete! 3441 572 3442 (list (cons 573 574) 3443 (cons 576 575) 3444 (cons 577 578) 3445 (cons 580 579) 3446 (cons 581 582)) 3447 (lambda (x y) (even? (+ x y)))) 3448 (lambda (result) 3449 (equal? result '((573 . 574) (577 . 578) (581 . 582))))) 3450 3451(test 'alist-delete!:no-elements-removed 3452 (alist-delete! 3453 'Monti 3454 (list (cons 'Monticello 'Montour) 3455 (cons 'Montpelier 'Montrose) 3456 (cons 'Mooar 'Moorhead) 3457 (cons 'Moorland 'Moran) 3458 (cons 'Moravia 'Morley)) 3459 (lambda (x y) #f)) 3460 (lambda (result) 3461 (equal? result '((Monticello . Montour) 3462 (Montpelier . Montrose) 3463 (Mooar . Moorhead) 3464 (Moorland . Moran) 3465 (Moravia . Morley))))) 3466 3467;;;;; DEL-ASS 3468;; 3469;;(test 'del-ass:null-list 3470;; (del-ass (lambda (x y) #t) 'Morningside '()) 3471;; null?) 3472;; 3473;;(test 'del-ass:singleton-list 3474;; (del-ass (lambda (x y) #f) 'Morrison '((Morse . Moscow))) 3475;; (lambda (result) (equal? result '((Morse . Moscow))))) 3476;; 3477;;(test 'del-ass:all-elements-removed 3478;; (del-ass (lambda (x y) #t) 'Motor '((Moulton . Moville) 3479;; (Munterville . Murray) 3480;; (Muscatine . Mystic) 3481;; (Napier . Nashua) 3482;; (Nashville . National))) 3483;; null?) 3484;; 3485;;(test 'del-ass:some-elements-removed 3486;; (del-ass (lambda (x y) (even? (+ x y))) 583 '((584 . 585) 3487;; (587 . 586) 3488;; (588 . 589) 3489;; (591 . 590) 3490;; (592 . 593))) 3491;; (lambda (result) 3492;; (equal? result '((584 . 585) (588 . 589) (592 . 593))))) 3493;; 3494;;(test 'del-ass:no-elements-removed 3495;; (del-ass (lambda (x y) #f) 'Nemaha '((Neola . Neptune) 3496;; (Nevada . Nevinville) 3497;; (Newbern . Newburg) 3498;; (Newell . Newhall) 3499;; (Newkirk . Newport))) 3500;; (lambda (result) 3501;; (equal? result '((Neola . Neptune) 3502;; (Nevada . Nevinville) 3503;; (Newbern . Newburg) 3504;; (Newell . Newhall) 3505;; (Newkirk . Newport))))) 3506;; 3507;;;;; DEL-ASS! 3508;; 3509;;(test 'del-ass!:null-list 3510;; (del-ass! (lambda (x y) #t) 'Newton '()) 3511;; null?) 3512;; 3513;;(test 'del-ass!:singleton-list 3514;; (del-ass! (lambda (x y) #f) 3515;; 'Nichols 3516;; (list (cons 'Nira 'Nishna))) 3517;; (lambda (result) (equal? result '((Nira . Nishna))))) 3518;; 3519;;(test 'del-ass!:all-elements-removed 3520;; (del-ass! (lambda (x y) #t) 3521;; 'Noble 3522;; (list (cons 'Nodaway 'Norness) 3523;; (cons 'Northboro 'Northfield) 3524;; (cons 'Northwood 'Norwalk) 3525;; (cons 'Norway 'Norwich) 3526;; (cons 'Norwood 'Norwoodville))) 3527;; null?) 3528;; 3529;;(test 'del-ass!:some-elements-removed 3530;; (del-ass! (lambda (x y) (odd? (+ x y))) 3531;; 594 3532;; (list (cons 595 596) 3533;; (cons 598 597) 3534;; (cons 599 600) 3535;; (cons 602 601) 3536;; (cons 603 604))) 3537;; (lambda (result) 3538;; (equal? result '((598 . 597) (602 . 601))))) 3539;; 3540;;(test 'del-ass!:no-elements-removed 3541;; (del-ass! (lambda (x y) #f) 3542;; 'Numa 3543;; (list (cons 'Nyman 'Oakdale) 3544;; (cons 'Oakley 'Oakville) 3545;; (cons 'Oakwood 'Oasis) 3546;; (cons 'Ocheyedan 'Odebolt) 3547;; (cons 'Oelwein 'Ogden))) 3548;; (lambda (result) 3549;; (equal? result '((Nyman . Oakdale) 3550;; (Oakley . Oakville) 3551;; (Oakwood . Oasis) 3552;; (Ocheyedan . Odebolt) 3553;; (Oelwein . Ogden))))) 3554;; 3555;;;;; DEL-ASSQ 3556;; 3557;;(test 'del-assq:null-list 3558;; (del-assq 'Okoboji '()) 3559;; null?) 3560;; 3561;;(test 'del-assq:in-singleton-list 3562;; (del-assq 'Olaf '((Olaf . Olds))) 3563;; null?) 3564;; 3565;;(test 'del-assq:not-in-singleton-list 3566;; (del-assq 'Olin '((Olivet . Ollie))) 3567;; (lambda (result) (equal? result '((Olivet . Ollie))))) 3568;; 3569;;(test 'del-assq:at-beginning-of-longer-list 3570;; (del-assq 'Olmitz '((Olmitz . Onawa) 3571;; (Oneida . Onslow) 3572;; (Ontario . Oralabor) 3573;; (Oran . Orange) 3574;; (Orchard . Orient))) 3575;; (lambda (result) 3576;; (equal? result '((Oneida . Onslow) 3577;; (Ontario . Oralabor) 3578;; (Oran . Orange) 3579;; (Orchard . Orient))))) 3580;; 3581;;(test 'del-assq:in-middle-of-longer-list 3582;; (del-assq 'Orilla '((Orleans . Ormanville) 3583;; (Orson . Ortonville) 3584;; (Osage . Osborne) 3585;; (Osceola . Osgood) 3586;; (Orilla . Oskaloosa) 3587;; (Ossian . Osterdock) 3588;; (Oswalt . Otho))) 3589;; (lambda (result) 3590;; (equal? result '((Orleans . Ormanville) 3591;; (Orson . Ortonville) 3592;; (Osage . Osborne) 3593;; (Osceola . Osgood) 3594;; (Ossian . Osterdock) 3595;; (Oswalt . Otho))))) 3596;; 3597;;(test 'del-assq:at-end-of-longer-list 3598;; (del-assq 'Otley '((Oto . Otranto) 3599;; (Ottawa . Otterville) 3600;; (Ottosen . Ottumwa) 3601;; (Owasa . Owego) 3602;; (Otley . Oxford))) 3603;; (lambda (result) 3604;; (equal? result '((Oto . Otranto) 3605;; (Ottawa . Otterville) 3606;; (Ottosen . Ottumwa) 3607;; (Owasa . Owego))))) 3608;; 3609;;(test 'del-assq:not-in-longer-list 3610;; (del-assq 'Oyens '((Ozark .Packard) 3611;; (Packwood . Palmer) 3612;; (Palmyra . Palo) 3613;; (Panama . Panora) 3614;; (Panther . Paralta))) 3615;; (lambda (result) 3616;; (equal? result '((Ozark .Packard) 3617;; (Packwood . Palmer) 3618;; (Palmyra . Palo) 3619;; (Panama . Panora) 3620;; (Panther . Paralta))))) 3621;; 3622;;(test 'del-assq:several-matches-in-longer-list 3623;; (del-assq 'Paris '((Parkersburg . Parkview) 3624;; (Parnell . Paton) 3625;; (Paris . Patterson) 3626;; (Paullina . Pekin) 3627;; (Paris . Pella) 3628;; (Peoria . Peosta) 3629;; (Paris . Percival))) 3630;; (lambda (result) 3631;; (equal? result '((Parkersburg . Parkview) 3632;; (Parnell . Paton) 3633;; (Paullina . Pekin) 3634;; (Peoria . Peosta))))) 3635;; 3636;;;;; DEL-ASSV 3637;; 3638;;(test 'del-assv:null-list 3639;; (del-assv 'Perkins '()) 3640;; null?) 3641;; 3642;;(test 'del-assv:in-singleton-list 3643;; (del-assv 'Perlee '((Perlee . Perry))) 3644;; null?) 3645;; 3646;;(test 'del-assv:not-in-singleton-list 3647;; (del-assv 'Pershing '((Persia . Peter))) 3648;; (lambda (result) (equal? result '((Persia . Peter))))) 3649;; 3650;;(test 'del-assv:at-beginning-of-longer-list 3651;; (del-assv 'Petersburg '((Petersburg . Peterson) 3652;; (Petersville . Philby) 3653;; (Pickering . Pierson) 3654;; (Pilotsburg . Pioneer) 3655;; (Piper . Pisgah))) 3656;; (lambda (result) 3657;; (equal? result '((Petersville . Philby) 3658;; (Pickering . Pierson) 3659;; (Pilotsburg . Pioneer) 3660;; (Piper . Pisgah))))) 3661;; 3662;;(test 'del-assv:in-middle-of-longer-list 3663;; (del-assv 'Pittsburg '((Pitzer . Plainfield) 3664;; (Plainview . Plano) 3665;; (Pleasanton . Pleasantville) 3666;; (Plessis . Plover) 3667;; (Pittsburg . Plymouth) 3668;; (Pocahontas . Pomeroy) 3669;; (Popejoy . Poplar))) 3670;; (lambda (result) 3671;; (equal? result '((Pitzer . Plainfield) 3672;; (Plainview . Plano) 3673;; (Pleasanton . Pleasantville) 3674;; (Plessis . Plover) 3675;; (Pocahontas . Pomeroy) 3676;; (Popejoy . Poplar))))) 3677;; 3678;;(test 'del-assv:at-end-of-longer-list 3679;; (del-assv 'Portland '((Portsmouth . Postville) 3680;; (Powersville . Prairieburg) 3681;; (Prescott . Preston) 3682;; (Primghar . Primrose) 3683;; (Portland . Princeton))) 3684;; (lambda (result) 3685;; (equal? result '((Portsmouth . Postville) 3686;; (Powersville . Prairieburg) 3687;; (Prescott . Preston) 3688;; (Primghar . Primrose))))) 3689;; 3690;;(test 'del-assv:not-in-longer-list 3691;; (del-assv 'Probstel '((Prole . Protivin) 3692;; (Pulaski . Purdy) 3693;; (Quandahl . Quarry) 3694;; (Quasqueton . Quick) 3695;; (Quimby . Quincy))) 3696;; (lambda (result) 3697;; (equal? result '((Prole . Protivin) 3698;; (Pulaski . Purdy) 3699;; (Quandahl . Quarry) 3700;; (Quasqueton . Quick) 3701;; (Quimby . Quincy))))) 3702;; 3703;;(test 'del-assv:several-matches-in-longer-list 3704;; (del-assv 'Radcliffe '((Rake . Raleigh) 3705;; (Ralston . Randalia) 3706;; (Radcliffe . Randall) 3707;; (Randolph . Rands) 3708;; (Radcliffe . Rathbun) 3709;; (Raymar . Raymond) 3710;; (Radcliffe . Readlyn))) 3711;; (lambda (result) 3712;; (equal? result '((Rake . Raleigh) 3713;; (Ralston . Randalia) 3714;; (Randolph . Rands) 3715;; (Raymar . Raymond))))) 3716;; 3717;;;;; DEL-ASSOC 3718;; 3719;;(test 'del-assoc:null-list 3720;; (del-assoc '(Reasnor . Redding) '()) 3721;; null?) 3722;; 3723;;(test 'del-assoc:in-singleton-list 3724;; (del-assoc '(Redfield . Reeceville) 3725;; '(((Redfield . Reeceville) . Reinbeck))) 3726;; null?) 3727;; 3728;;(test 'del-assoc:not-in-singleton-list 3729;; (del-assoc '(Rembrandt . Remsen) 3730;; '(((Renwick . Republic) . Rhodes))) 3731;; (lambda (result) 3732;; (equal? result '(((Renwick . Republic) . Rhodes))))) 3733;; 3734;;(test 'del-assoc:at-beginning-of-longer-list 3735;; (del-assoc '(Riceville . Richard) 3736;; '(((Riceville . Richard) . Richfield) 3737;; ((Richland . Richmond) . Rickardsville) 3738;; ((Ricketts . Rider) . Ridgeport) 3739;; ((Ridgeway . Riggs) . Rinard) 3740;; ((Ringgold . Ringsted) . Rippey))) 3741;; (lambda (result) 3742;; (equal? result '(((Richland . Richmond) . Rickardsville) 3743;; ((Ricketts . Rider) . Ridgeport) 3744;; ((Ridgeway . Riggs) . Rinard) 3745;; ((Ringgold . Ringsted) . Rippey))))) 3746;; 3747;;(test 'del-assoc:in-middle-of-longer-list 3748;; (del-assoc '(Ritter . Riverdale) 3749;; '(((Riverside . Riverton) . Roberts) 3750;; ((Robertson . Robins) . Robinson) 3751;; ((Rochester . Rockdale) . Rockford) 3752;; ((Rockville . Rockwell) . Rodman) 3753;; ((Ritter . Riverdale) . Rodney) 3754;; ((Roelyn . Rogers) . Roland) 3755;; ((Rolfe . Rome) . Roscoe))) 3756;; (lambda (result) 3757;; (equal? result '(((Riverside . Riverton) . Roberts) 3758;; ((Robertson . Robins) . Robinson) 3759;; ((Rochester . Rockdale) . Rockford) 3760;; ((Rockville . Rockwell) . Rodman) 3761;; ((Roelyn . Rogers) . Roland) 3762;; ((Rolfe . Rome) . Roscoe))))) 3763;; 3764;;(test 'del-assoc:at-end-of-longer-list 3765;; (del-assoc '(Rose . Roselle) 3766;; '(((Roseville . Ross) . Rosserdale) 3767;; ((Rossie . Rossville) . Rowan) 3768;; ((Rowley . Royal) . Rubio) 3769;; ((Ruble . Rudd) . Runnells) 3770;; ((Rose . Roselle) . Russell))) 3771;; (lambda (result) 3772;; (equal? result '(((Roseville . Ross) . Rosserdale) 3773;; ((Rossie . Rossville) . Rowan) 3774;; ((Rowley . Royal) . Rubio) 3775;; ((Ruble . Rudd) . Runnells))))) 3776;; 3777;;(test 'del-assoc:not-in-longer-list 3778;; (del-assoc '(Ruthven . Rutland) 3779;; '(((Rutledge . Ryan) . Sabula) 3780;; ((Sageville . Salem) . Salina) 3781;; ((Salix . Sanborn) . Sandusky) 3782;; ((Sandyville . Santiago) . Saratoga) 3783;; ((Sattre . Saude) . Savannah))) 3784;; (lambda (result) 3785;; (equal? result '(((Rutledge . Ryan) . Sabula) 3786;; ((Sageville . Salem) . Salina) 3787;; ((Salix . Sanborn) . Sandusky) 3788;; ((Sandyville . Santiago) . Saratoga) 3789;; ((Sattre . Saude) . Savannah))))) 3790;; 3791;;(test 'del-assoc:several-matches-in-longer-list 3792;; (del-assoc '(Sawyer . Saylor) 3793;; '(((Saylorville . Scarville) . Schaller) 3794;; ((Schleswig . Schley) . Sciola) 3795;; ((Sawyer . Saylor) . Scranton) 3796;; ((Searsboro . Sedan) . Selma) 3797;; ((Sawyer . Saylor) . Seneca) 3798;; ((Seney . Sewal) . Sexton) 3799;; ((Sawyer . Saylor) . Seymour))) 3800;; (lambda (result) 3801;; (equal? result '(((Saylorville . Scarville) . Schaller) 3802;; ((Schleswig . Schley) . Sciola) 3803;; ((Searsboro . Sedan) . Selma) 3804;; ((Seney . Sewal) . Sexton))))) 3805;; 3806;;;;; DEL-ASSQ! 3807;; 3808;;(test 'del-assq!:null-list 3809;; (del-assq! 'Shaffton (list)) 3810;; null?) 3811;; 3812;;(test 'del-assq!:in-singleton-list 3813;; (del-assq! 'Shambaugh (list (cons 'Shambaugh 'Sharon))) 3814;; null?) 3815;; 3816;;(test 'del-assq!:not-in-singleton-list 3817;; (del-assq! 'Sharpsburg (list (cons 'Shawondasse 'Sheffield))) 3818;; (lambda (result) 3819;; (equal? result '((Shawondasse . Sheffield))))) 3820;; 3821;;(test 'del-assq!:at-beginning-of-longer-list 3822;; (del-assq! 'Shelby (list (cons 'Shelby 'Sheldahl) 3823;; (cons 'Sheldon 'Shellsburg) 3824;; (cons 'Shenandoah 'Sheridan) 3825;; (cons 'Sherrill 'Sherwood) 3826;; (cons 'Shipley 'Shueyville))) 3827;; (lambda (result) 3828;; (equal? result '((Sheldon . Shellsburg) 3829;; (Shenandoah . Sheridan) 3830;; (Sherrill . Sherwood) 3831;; (Shipley . Shueyville))))) 3832;; 3833;;(test 'del-assq!:in-middle-of-longer-list 3834;; (del-assq! 'Siam (list (cons 'Sibley 'Sidney) 3835;; (cons 'Sigourney 'Sinclair) 3836;; (cons 'Sixmile 'Sixteen) 3837;; (cons 'Slater 'Slifer) 3838;; (cons 'Siam 'Sloan) 3839;; (cons 'Smithland 'Smiths) 3840;; (cons 'Smyrna 'Soldier))) 3841;; (lambda (result) 3842;; (equal? result '((Sibley . Sidney) 3843;; (Sigourney . Sinclair) 3844;; (Sixmile . Sixteen) 3845;; (Slater . Slifer) 3846;; (Smithland . Smiths) 3847;; (Smyrna . Soldier))))) 3848;; 3849;;(test 'del-assq!:at-end-of-longer-list 3850;; (del-assq! 'Solomon (list (cons 'Solon 'Somers) 3851;; (cons 'Spaulding 'Spencer) 3852;; (cons 'Sperry 'Spillville) 3853;; (cons 'Sprague 'Spragueville) 3854;; (cons 'Solomon 'Springbrook))) 3855;; (lambda (result) 3856;; (equal? result '((Solon . Somers) 3857;; (Spaulding . Spencer) 3858;; (Sperry . Spillville) 3859;; (Sprague . Spragueville))))) 3860;; 3861;;(test 'del-assq!:not-in-longer-list 3862;; (del-assq! 'Springdale (list (cons 'Springville 'Stacyville) 3863;; (cons 'Stanhope 'Stanley) 3864;; (cons 'Stanton 'Stanwood) 3865;; (cons 'Stanzel 'Stennett) 3866;; (cons 'Sterling 'Stevens))) 3867;; (lambda (result) 3868;; (equal? result '((Springville . Stacyville) 3869;; (Stanhope . Stanley) 3870;; (Stanton . Stanwood) 3871;; (Stanzel . Stennett) 3872;; (Sterling . Stevens))))) 3873;; 3874;;(test 'del-assq!:several-matches-in-longer-list 3875;; (del-assq! 'Stiles (list (cons 'Stilson 'Stockport) 3876;; (cons 'Stockton 'Stonega) 3877;; (cons 'Stiles 'Stout) 3878;; (cons 'Strahan 'Stratford) 3879;; (cons 'Stiles 'Streepyville) 3880;; (cons 'Stringtown 'Struble) 3881;; (cons 'Stiles 'Stuart))) 3882;; (lambda (result) 3883;; (equal? result '((Stilson . Stockport) 3884;; (Stockton . Stonega) 3885;; (Strahan . Stratford) 3886;; (Stringtown . Struble))))) 3887;; 3888;;;;; DEL-ASSV! 3889;; 3890;;(test 'del-assv!:null-list 3891;; (del-assv! 'Sully (list)) 3892;; null?) 3893;; 3894;;(test 'del-assv!:in-singleton-list 3895;; (del-assv! 'Summerset (list (cons 'Summerset 'Summitville))) 3896;; null?) 3897;; 3898;;(test 'del-assv!:not-in-singleton-list 3899;; (del-assv! 'Sumner (list (cons 'Sunbury 'Sunshine))) 3900;; (lambda (result) 3901;; (equal? result '((Sunbury . Sunshine))))) 3902;; 3903;;(test 'del-assv!:at-beginning-of-longer-list 3904;; (del-assv! 'Superior (list (cons 'Superior 'Sutherland) 3905;; (cons 'Sutiff 'Swaledale) 3906;; (cons 'Swan 'Swanwood) 3907;; (cons 'Swedesburg 'Swisher) 3908;; (cons 'Tabor 'Taintor))) 3909;; (lambda (result) 3910;; (equal? result '((Sutiff . Swaledale) 3911;; (Swan . Swanwood) 3912;; (Swedesburg . Swisher) 3913;; (Tabor . Taintor))))) 3914;; 3915;;(test 'del-assv!:in-middle-of-longer-list 3916;; (del-assv! 'Talleyrand (list (cons 'Talmage 'Tama) 3917;; (cons 'Tara 'Taylor) 3918;; (cons 'Taylorsville 'Templeton) 3919;; (cons 'Tenmile 'Tennant) 3920;; (cons 'Talleyrand 'Tenville) 3921;; (cons 'Terril 'Thayer) 3922;; (cons 'Thirty 'Thomasville))) 3923;; (lambda (result) 3924;; (equal? result '((Talmage . Tama) 3925;; (Tara . Taylor) 3926;; (Taylorsville . Templeton) 3927;; (Tenmile . Tennant) 3928;; (Terril . Thayer) 3929;; (Thirty . Thomasville))))) 3930;; 3931;;(test 'del-assv!:at-end-of-longer-list 3932;; (del-assv! 'Thompson (list (cons 'Thor 'Thornburg) 3933;; (cons 'Thornton 'Thorpe) 3934;; (cons 'Thurman 'Ticonic) 3935;; (cons 'Tiffin 'Tilton) 3936;; (cons 'Thompson 'Tingley))) 3937;; (lambda (result) 3938;; (equal? result '((Thor . Thornburg) 3939;; (Thornton . Thorpe) 3940;; (Thurman . Ticonic) 3941;; (Tiffin . Tilton))))) 3942;; 3943;;(test 'del-assv!:not-in-longer-list 3944;; (del-assv! 'Tipton (list (cons 'Titonka 'Tivali) 3945;; (cons 'Toddville 'Toeterville) 3946;; (cons 'Toledo 'Toolesboro) 3947;; (cons 'Toronto 'Tracy) 3948;; (cons 'Traer 'Trenton))) 3949;; (lambda (result) 3950;; (equal? result '((Titonka . Tivali) 3951;; (Toddville . Toeterville) 3952;; (Toledo . Toolesboro) 3953;; (Toronto . Tracy) 3954;; (Traer . Trenton))))) 3955;; 3956;;(test 'del-assv!:several-matches-in-longer-list 3957;; (del-assv! 'Treynor (list (cons 'Tripoli 'Troy) 3958;; (cons 'Truesdale 'Truro) 3959;; (cons 'Treynor 'Turin) 3960;; (cons 'Tuskeego 'Tyrone) 3961;; (cons 'Treynor 'Udell) 3962;; (cons 'Ulmer 'Underwood) 3963;; (cons 'Treynor 'Union))) 3964;; (lambda (result) 3965;; (equal? result '((Tripoli . Troy) 3966;; (Truesdale . Truro) 3967;; (Tuskeego . Tyrone) 3968;; (Ulmer . Underwood))))) 3969;; 3970;;;;; DEL-ASSOC! 3971;; 3972;;(test 'del-assoc!:null-list 3973;; (del-assoc! (cons 'Unionville 'Unique) (list)) 3974;; null?) 3975;; 3976;;(test 'del-assoc!:in-singleton-list 3977;; (del-assoc! (cons 'Updegraff 'Urbana) 3978;; (list (cons (cons 'Updegraff 'Urbana) 3979;; 'Summitville))) 3980;; null?) 3981;; 3982;;(test 'del-assoc!:not-in-singleton-list 3983;; (del-assoc! (cons 'Urbandale 'Ute) 3984;; (list (cons (cons 'Utica 'Vail) 'Valeria))) 3985;; (lambda (result) 3986;; (equal? result '(((Utica . Vail) . Valeria))))) 3987;; 3988;;(test 'del-assoc!:at-beginning-of-longer-list 3989;; (del-assoc! (cons 'Valley 'Vandalia) 3990;; (list (cons (cons 'Valley 'Vandalia) 'Varina) 3991;; (cons (cons 'Ventura 'Vernon) 'Victor) 3992;; (cons (cons 'Viele 'Villisca) 'Vincennes) 3993;; (cons (cons 'Vincent 'Vining) 'Vinje) 3994;; (cons (cons 'Vinton 'Viola) 'Volga))) 3995;; (lambda (result) 3996;; (equal? result '(((Ventura . Vernon) . Victor) 3997;; ((Viele . Villisca) . Vincennes) 3998;; ((Vincent . Vining) . Vinje) 3999;; ((Vinton . Viola) . Volga))))) 4000;; 4001;;(test 'del-assoc!:in-middle-of-longer-list 4002;; (del-assoc! (cons 'Volney 'Voorhies) 4003;; (list (cons (cons 'Wadena 'Wahpeton) 'Walcott) 4004;; (cons (cons 'Wald 'Wales) 'Walford) 4005;; (cons (cons 'Walker 'Wallin) 'Wallingford) 4006;; (cons (cons 'Walnut 'Wapello) 'Ward) 4007;; (cons (cons 'Volney 'Voorhies) 'Ware) 4008;; (cons (cons 'Washburn 'Washington) 'Washta) 4009;; (cons (cons 'Waterloo 'Waterville) 4010;; 'Watkins))) 4011;; (lambda (result) 4012;; (equal? result '(((Wadena . Wahpeton) . Walcott) 4013;; ((Wald . Wales) . Walford) 4014;; ((Walker . Wallin) . Wallingford) 4015;; ((Walnut . Wapello) . Ward) 4016;; ((Washburn . Washington) . Washta) 4017;; ((Waterloo . Waterville) . Watkins))))) 4018;; 4019;;(test 'del-assoc!:at-end-of-longer-list 4020;; (del-assoc! (cons 'Watson 'Watterson) 4021;; (list (cons (cons 'Waubeek 'Waucoma) 'Waukee) 4022;; (cons (cons 'Waukon 'Waupeton) 'Waverly) 4023;; (cons (cons 'Wayland 'Webb) 'Webster) 4024;; (cons (cons 'Weldon 'Weller) 'Wellman) 4025;; (cons (cons 'Watson 'Watterson) 'Wellsburg))) 4026;; (lambda (result) 4027;; (equal? result '(((Waubeek . Waucoma) . Waukee) 4028;; ((Waukon . Waupeton) . Waverly) 4029;; ((Wayland . Webb) . Webster) 4030;; ((Weldon . Weller) . Wellman))))) 4031;; 4032;;(test 'del-assoc!:not-in-longer-list 4033;; (del-assoc! (cons 'Welton 'Wesley) 4034;; (list (cons (cons 'Western 'Westerville) 4035;; 'Westfield) 4036;; (cons (cons 'Westgate 'Weston) 'Westphalia) 4037;; (cons (cons 'Westside 'Westview) 'Wever) 4038;; (cons (cons 'Wheatland 'Whiting) 4039;; 'Whittemore) 4040;; (cons (cons 'Whitten 'Whittier) 'Wichita))) 4041;; (lambda (result) 4042;; (equal? result '(((Western . Westerville) . Westfield) 4043;; ((Westgate . Weston) . Westphalia) 4044;; ((Westside . Westview) . Wever) 4045;; ((Wheatland . Whiting) . Whittemore) 4046;; ((Whitten . Whittier) . Wichita))))) 4047;; 4048;;(test 'del-assoc!:several-matches-in-longer-list 4049;; (del-assoc! (cons 'Wick 'Wightman) 4050;; (list (cons (cons 'Wilke 'Willey) 'Williams) 4051;; (cons (cons 'Williamsburg 'Williamson) 4052;; 'Williamstown) 4053;; (cons (cons 'Wick 'Wightman) 'Wilmar) 4054;; (cons (cons 'Wilton 'Winchester) 'Windham) 4055;; (cons (cons 'Wick 'Wightman) 'Winfield) 4056;; (cons (cons 'Winkelmans 'Winterset) 4057;; 'Winthrop) 4058;; (cons (cons 'Wick 'Wightman) 'Wiota))) 4059;; (lambda (result) 4060;; (equal? result '(((Wilke . Willey) . Williams) 4061;; ((Williamsburg . Williamson) 4062;; . Williamstown) 4063;; ((Wilton . Winchester) . Windham) 4064;; ((Winkelmans . Winterset) . Winthrop))))) 4065 4066 4067(total-report) 4068