959 lines
35 KiB
Scheme
959 lines
35 KiB
Scheme
;;;
|
|
;;; <fold-test.ss> ---- Tests for list folds
|
|
;;; Time-stamp: <05/12/16 21:19:37 noel>
|
|
;;;
|
|
;;; Copyright (C) 2002 by Noel Welsh.
|
|
;;;
|
|
;;; This file is part of SRFI-1.
|
|
|
|
;;; SRFI-1 is free software; you can redistribute it and/or
|
|
;;; modify it under the terms of the GNU Lesser General Public
|
|
;;; License as published by the Free Software Foundation; either
|
|
;;; version 2.1 of the License, or (at your option) any later version.
|
|
|
|
;;; SRFI-1 is distributed in the hope that it will be useful,
|
|
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
;;; Lesser General Public License for more details.
|
|
|
|
;;; You should have received a copy of the GNU Lesser General Public
|
|
;;; License along with SRFI-1; if not, write to the Free Software
|
|
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
;;; Author: Noel Welsh <noelwelsh@yahoo.com>
|
|
;;
|
|
;;
|
|
;; Commentary:
|
|
|
|
;; Originally created by:
|
|
|
|
;; John David Stone
|
|
;; Department of Mathematics and Computer Science
|
|
;; Grinnell College
|
|
;; stone@math.grin.edu
|
|
|
|
(module fold-test
|
|
mzscheme
|
|
|
|
(require
|
|
(planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
|
(all-except srfi/1/fold map for-each)
|
|
(rename srfi/1/fold s:map map)
|
|
(rename srfi/1/fold s:for-each for-each))
|
|
|
|
(provide fold-tests)
|
|
|
|
(define fold-tests
|
|
(test-suite
|
|
"Folding list procedures tests"
|
|
|
|
;; UNFOLD
|
|
|
|
(test-case
|
|
"unfold:predicate-always-satisfied"
|
|
(check-true (null?
|
|
(unfold (lambda (seed) #t)
|
|
(lambda (seed) (* seed 2))
|
|
(lambda (seed) (* seed 3))
|
|
1))))
|
|
|
|
(test-case
|
|
"unfold:normal-case"
|
|
(check-equal?
|
|
(unfold (lambda (seed) (= seed 729))
|
|
(lambda (seed) (* seed 2))
|
|
(lambda (seed) (* seed 3))
|
|
1)
|
|
'(2 6 18 54 162 486)))
|
|
|
|
;; UNFOLD-RIGHT
|
|
|
|
(test-case
|
|
"unfold-right:predicate-always-satisfied"
|
|
(check-equal?
|
|
(unfold-right (lambda (seed) #t)
|
|
(lambda (seed) (* seed 2))
|
|
(lambda (seed) (* seed 3))
|
|
(lambda (seed) (* seed 5))
|
|
1)
|
|
(list 1)))
|
|
|
|
(test-case
|
|
"unfold-right:normal-case"
|
|
(check-equal?
|
|
(unfold-right (lambda (seed) (= seed 729))
|
|
(lambda (seed) (* seed 2))
|
|
(lambda (seed) (* seed 3))
|
|
1
|
|
1)
|
|
'(486 162 54 18 6 2 1)))
|
|
|
|
;; FOLD
|
|
|
|
(test-case
|
|
"fold:one-null-list"
|
|
(check = (fold (lambda (alpha beta) (* alpha (+ beta 1))) 13 '()) 13))
|
|
|
|
(test-case
|
|
"fold:one-singleton-list"
|
|
(check = (fold (lambda (alpha beta) (* alpha (+ beta 1))) 13 '(15)) 210))
|
|
|
|
(test-case
|
|
"fold:one-longer-list"
|
|
(check =
|
|
(fold (lambda (alpha beta) (* alpha (+ beta 1)))
|
|
13
|
|
'(15 17 19 21 23))
|
|
32927582))
|
|
|
|
(test-case
|
|
"fold:several-null-lists"
|
|
(check-eq? (fold vector 'Chad '() '() '() '() '()) 'Chad))
|
|
|
|
(test-case
|
|
"fold:several-singleton-lists"
|
|
(check-equal?
|
|
(fold vector 'Chile '(China) '(Colombia) '(Comoros) '(Congo)
|
|
'(Croatia))
|
|
'#(China Colombia Comoros Congo Croatia Chile)))
|
|
|
|
(test-case
|
|
"fold:several-longer-lists"
|
|
(check-equal?
|
|
(fold (lambda (alpha beta gamma delta epsilon zeta)
|
|
(cons (vector alpha beta gamma delta epsilon) zeta))
|
|
'()
|
|
'(Cuba Cyprus Denmark Djibouti Dominica Ecuador Egypt)
|
|
'(Eritrea Estonia Ethiopia Fiji Finland France Gabon)
|
|
'(Gambia Georgia Germany Ghana Greece Grenada
|
|
Guatemala)
|
|
'(Guinea Guyana Haiti Honduras Hungary Iceland India)
|
|
'(Indonesia Iran Iraq Ireland Israel Italy Jamaica))
|
|
'(#(Egypt Gabon Guatemala India Jamaica)
|
|
#(Ecuador France Grenada Iceland Italy)
|
|
#(Dominica Finland Greece Hungary Israel)
|
|
#(Djibouti Fiji Ghana Honduras Ireland)
|
|
#(Denmark Ethiopia Germany Haiti Iraq)
|
|
#(Cyprus Estonia Georgia Guyana Iran)
|
|
#(Cuba Eritrea Gambia Guinea Indonesia))))
|
|
|
|
(test-case
|
|
"fold:lists-of-different-lengths"
|
|
(check-equal?
|
|
(fold (lambda (alpha beta gamma delta)
|
|
(cons (vector alpha beta gamma) delta))
|
|
'()
|
|
'(Japan Jordan Kazakhstan Kenya)
|
|
'(Kiribati Kuwait)
|
|
'(Kyrgyzstan Laos Latvia))
|
|
'(#(Jordan Kuwait Laos)
|
|
#(Japan Kiribati Kyrgyzstan))))
|
|
|
|
;; FOLD-RIGHT
|
|
|
|
(test-case
|
|
"fold-right:one-null-list"
|
|
(check = (fold-right (lambda (alpha beta) (* alpha (+ beta 1))) 13 '())
|
|
13))
|
|
|
|
(test-case
|
|
"fold-right:one-singleton-list"
|
|
(check = (fold-right (lambda (alpha beta) (* alpha (+ beta 1))) 13 '(15))
|
|
210))
|
|
|
|
(test-case
|
|
"fold-right:one-longer-list"
|
|
(check = (fold-right (lambda (alpha beta) (* alpha (+ beta 1)))
|
|
13
|
|
'(15 17 19 21 23))
|
|
32868750))
|
|
|
|
(test-case
|
|
"fold-right:several-null-lists"
|
|
(check-eq? (fold-right vector 'Lebanon '() '() '() '() '())
|
|
'Lebanon))
|
|
|
|
(test-case
|
|
"fold-right:several-singleton-lists"
|
|
(check-equal?
|
|
(fold-right vector 'Lesotho '(Liberia) '(Libya) '(Liechtenstein)
|
|
'(Lithuania) '(Luxembourg))
|
|
#(Liberia Libya Liechtenstein Lithuania Luxembourg Lesotho)))
|
|
|
|
(test-case
|
|
"fold-right:several-longer-lists"
|
|
(check-equal?
|
|
(fold-right (lambda (alpha beta gamma delta epsilon zeta)
|
|
(cons (vector alpha beta gamma delta epsilon) zeta))
|
|
'()
|
|
'(Macedonia Madagascar Malawi Malaysia Maldives Mali
|
|
Malta)
|
|
'(Mauritania Mauritius Mexico Micronesia Moldova Monaco
|
|
Mongolia)
|
|
'(Morocco Mozambique Myanmar Namibia Nauru Nepal
|
|
Netherlands)
|
|
'(Nicaragua Niger Nigeria Norway Oman Pakistan Palau)
|
|
'(Panama Paraguay Peru Philippines Poland Portugal
|
|
Qatar))
|
|
|
|
'(#(Macedonia Mauritania Morocco Nicaragua Panama)
|
|
#(Madagascar Mauritius Mozambique Niger Paraguay)
|
|
#(Malawi Mexico Myanmar Nigeria Peru)
|
|
#(Malaysia Micronesia Namibia Norway Philippines)
|
|
#(Maldives Moldova Nauru Oman Poland)
|
|
#(Mali Monaco Nepal Pakistan Portugal)
|
|
#(Malta Mongolia Netherlands Palau Qatar))))
|
|
|
|
(test-case
|
|
"fold-right:lists-of-different-lengths"
|
|
(check-equal?
|
|
(fold-right (lambda (alpha beta gamma delta)
|
|
(cons (vector alpha beta gamma) delta))
|
|
'()
|
|
'(Romania Russia Rwanda Senegal)
|
|
'(Seychelles Singapore)
|
|
'(Slovakia Slovenia Somalia))
|
|
'(#(Romania Seychelles Slovakia)
|
|
#(Russia Singapore Slovenia))))
|
|
|
|
;; PAIR-FOLD
|
|
|
|
(let* ((revappend (lambda (reversend base)
|
|
(do ((rest reversend (cdr rest))
|
|
(result base (cons (car rest) result)))
|
|
((null? rest) result))))
|
|
(revappall (lambda (first . rest)
|
|
(let loop ((first first) (rest rest))
|
|
(if (null? rest)
|
|
first
|
|
(revappend first
|
|
(loop (car rest)
|
|
(cdr rest))))))))
|
|
(test-suite
|
|
"Pair-fold tests"
|
|
|
|
(test-case
|
|
"pair-fold:one-null-list"
|
|
(check-equal?
|
|
(pair-fold revappend '(Spain Sudan) '())
|
|
'(Spain Sudan)))
|
|
|
|
(test-case
|
|
"pair-fold:one-singleton-list"
|
|
(check-equal?
|
|
(pair-fold revappend '(Suriname Swaziland) '(Sweden))
|
|
'(Sweden Suriname Swaziland)))
|
|
|
|
(test-case
|
|
"pair-fold:one-longer-list"
|
|
(check-equal?
|
|
(pair-fold revappend
|
|
'(Switzerland Syria)
|
|
'(Taiwan Tajikistan Tanzania Thailand Togo))
|
|
'(Togo Togo Thailand Togo Thailand Tanzania Togo
|
|
Thailand Tanzania Tajikistan Togo Thailand
|
|
Tanzania Tajikistan Taiwan Switzerland Syria)))
|
|
|
|
(test-case
|
|
"pair-fold:several-null-lists"
|
|
(check-equal?
|
|
(pair-fold revappall '(Tonga Tunisia) '() '() '() '() '())
|
|
'(Tonga Tunisia)))
|
|
|
|
(test-case
|
|
"pair-fold:several-singleton-lists"
|
|
(check-equal?
|
|
(pair-fold revappall
|
|
'(Turkey Turkmenistan)
|
|
'(Tuvalu)
|
|
'(Uganda)
|
|
'(Ukraine)
|
|
'(Uruguay)
|
|
'(Uzbekistan))
|
|
'(Tuvalu Uganda Ukraine Uruguay Uzbekistan Turkey
|
|
Turkmenistan)))
|
|
|
|
(test-case
|
|
"pair-fold:several-longer-lists"
|
|
(check-equal?
|
|
(pair-fold revappall
|
|
'(Vanuatu Venezuela)
|
|
'(Vietnam Yemen Yugoslavia Zaire Zambia Zimbabwe
|
|
Agnon)
|
|
'(Aleixandre Andric Asturias Beckett Bellow
|
|
Benavente Bergson)
|
|
'(Bjornson Brodsky Buck Bunin Camus Canetti
|
|
Carducci)
|
|
'(Cela Churchill Deledda Echegary Eliot Elytis
|
|
Eucken)
|
|
'(Faulkner Galsworthy Gide Gjellerup Golding
|
|
Gordimer Hamsun))
|
|
'(Agnon Bergson Carducci Eucken Hamsun Agnon
|
|
Zimbabwe Bergson Benavente Carducci Canetti
|
|
Eucken Elytis Hamsun Gordimer Agnon Zimbabwe
|
|
Zambia Bergson Benavente Bellow Carducci Canetti
|
|
Camus Eucken Elytis Eliot Hamsun Gordimer
|
|
Golding Agnon Zimbabwe Zambia Zaire Bergson
|
|
Benavente Bellow Beckett Carducci Canetti Camus
|
|
Bunin Eucken Elytis Eliot Echegary Hamsun
|
|
Gordimer Golding Gjellerup Agnon Zimbabwe Zambia
|
|
Zaire Yugoslavia Bergson Benavente Bellow
|
|
Beckett Asturias Carducci Canetti Camus Bunin
|
|
Buck Eucken Elytis Eliot Echegary Deledda Hamsun
|
|
Gordimer Golding Gjellerup Gide Agnon Zimbabwe
|
|
Zambia Zaire Yugoslavia Yemen Bergson Benavente
|
|
Bellow Beckett Asturias Andric Carducci Canetti
|
|
Camus Bunin Buck Brodsky Eucken Elytis Eliot
|
|
Echegary Deledda Churchill Hamsun Gordimer
|
|
Golding Gjellerup Gide Galsworthy Agnon Zimbabwe
|
|
Zambia Zaire Yugoslavia Yemen Vietnam Bergson
|
|
Benavente Bellow Beckett Asturias Andric
|
|
Aleixandre Carducci Canetti Camus Bunin Buck
|
|
Brodsky Bjornson Eucken Elytis Eliot Echegary
|
|
Deledda Churchill Cela Hamsun Gordimer Golding
|
|
Gjellerup Gide Galsworthy Faulkner Vanuatu
|
|
Venezuela)))
|
|
|
|
(test-case
|
|
"pair-fold:lists-of-different-lengths"
|
|
(check-equal?
|
|
(pair-fold revappall
|
|
'(Hauptmann Hemingway Hesse)
|
|
'(Heyse Jensen Jimenez Johnson)
|
|
'(Karlfeldt Kawabata)
|
|
'(Kipling Lagerkvist Lagerlof Laxness Lewis))
|
|
'(Johnson Jimenez Jensen Kawabata Lewis Laxness
|
|
Lagerlof Lagerkvist Johnson Jimenez Jensen Heyse
|
|
Kawabata Karlfeldt Lewis Laxness Lagerlof
|
|
Lagerkvist Kipling Hauptmann Hemingway
|
|
Hesse)))
|
|
))
|
|
|
|
;; PAIR-FOLD-RIGHT
|
|
|
|
(let* ((revappend (lambda (reversend base)
|
|
(do ((rest reversend (cdr rest))
|
|
(result base (cons (car rest) result)))
|
|
((null? rest) result))))
|
|
(revappall (lambda (first . rest)
|
|
(let loop ((first first) (rest rest))
|
|
(if (null? rest)
|
|
first
|
|
(revappend first
|
|
(loop (car rest)
|
|
(cdr rest))))))))
|
|
(test-suite
|
|
"Pair-fold-right tests"
|
|
(test-case
|
|
"pair-fold-right:one-null-list"
|
|
(check-equal?
|
|
(pair-fold-right revappend '(Maeterlinck Mahfouz) '())
|
|
'(Maeterlinck Mahfouz)))
|
|
|
|
(test-case
|
|
"pair-fold-right:one-singleton-list"
|
|
(check-equal?
|
|
(pair-fold-right revappend '(Mann Martinson) '(Mauriac))
|
|
'(Mauriac Mann Martinson)))
|
|
|
|
(test-case
|
|
"pair-fold-right:one-longer-list"
|
|
(check-equal?
|
|
(pair-fold-right revappend
|
|
'(Milosz Mistral)
|
|
'(Mommsen Montale Morrison Neruda Oe))
|
|
'(Oe Neruda Morrison Montale Mommsen Oe Neruda
|
|
Morrison Montale Oe Neruda Morrison Oe Neruda Oe
|
|
Milosz Mistral)))
|
|
|
|
(test-case
|
|
"pair-fold-right:several-null-lists"
|
|
(check-equal?
|
|
(pair-fold-right revappall '(Pasternak Paz) '() '() '() '() '())
|
|
'(Pasternak Paz)))
|
|
|
|
(test-case
|
|
"pair-fold-right:several-singleton-lists"
|
|
(check-equal?
|
|
(pair-fold-right revappall
|
|
'(Perse Pirandello)
|
|
'(Pontoppidan)
|
|
'(Quasimodo)
|
|
'(Reymont)
|
|
'(Rolland)
|
|
'(Russell))
|
|
'(Pontoppidan Quasimodo Reymont Rolland Russell
|
|
Perse Pirandello)))
|
|
|
|
(test-case
|
|
"pair-fold-right:several-longer-lists"
|
|
(check-equal?
|
|
(pair-fold-right revappall
|
|
'(Sachs Sartre)
|
|
'(Seferis Shaw Sholokov Siefert Sienkiewicz
|
|
Sillanpaa Simon)
|
|
'(Singer Solzhenitsyn Soyinka Spitteler
|
|
Steinbeck Tagore Undset)
|
|
'(Walcott White Yeats Anderson Andrews Angelina
|
|
Aransas)
|
|
'(Archer Armstrong Alascosa Austin Bailey
|
|
Bandera Bastrop)
|
|
'(Baylor Bee Bell Bexar Blanco Borden Bosque
|
|
Bowie))
|
|
'(Simon Sillanpaa Sienkiewicz Siefert Sholokov
|
|
Shaw Seferis Undset Tagore Steinbeck Spitteler
|
|
Soyinka Solzhenitsyn Singer Aransas Angelina
|
|
Andrews Anderson Yeats White Walcott Bastrop
|
|
Bandera Bailey Austin Alascosa Armstrong Archer
|
|
Bowie Bosque Borden Blanco Bexar Bell Bee Baylor
|
|
Simon Sillanpaa Sienkiewicz Siefert Sholokov
|
|
Shaw Undset Tagore Steinbeck Spitteler Soyinka
|
|
Solzhenitsyn Aransas Angelina Andrews Anderson
|
|
Yeats White Bastrop Bandera Bailey Austin
|
|
Alascosa Armstrong Bowie Bosque Borden Blanco
|
|
Bexar Bell Bee Simon Sillanpaa Sienkiewicz
|
|
Siefert Sholokov Undset Tagore Steinbeck
|
|
Spitteler Soyinka Aransas Angelina Andrews
|
|
Anderson Yeats Bastrop Bandera Bailey Austin
|
|
Alascosa Bowie Bosque Borden Blanco Bexar Bell
|
|
Simon Sillanpaa Sienkiewicz Siefert Undset
|
|
Tagore Steinbeck Spitteler Aransas Angelina
|
|
Andrews Anderson Bastrop Bandera Bailey Austin
|
|
Bowie Bosque Borden Blanco Bexar Simon Sillanpaa
|
|
Sienkiewicz Undset Tagore Steinbeck Aransas
|
|
Angelina Andrews Bastrop Bandera Bailey Bowie
|
|
Bosque Borden Blanco Simon Sillanpaa Undset
|
|
Tagore Aransas Angelina Bastrop Bandera Bowie
|
|
Bosque Borden Simon Undset Aransas Bastrop Bowie
|
|
Bosque Sachs Sartre)))
|
|
|
|
(test-case
|
|
"pair-fold-right:lists-of-different-lengths"
|
|
(check-equal?
|
|
(pair-fold-right revappall
|
|
'(Brazoria Brazos Brewster)
|
|
'(Briscoe Brooks Brown Burleson)
|
|
'(Burnet Caldwell)
|
|
'(Calhoun Callahan Cameron Camp Carson))
|
|
'(Burleson Brown Brooks Briscoe Caldwell Burnet
|
|
Carson Camp Cameron Callahan Calhoun Burleson
|
|
Brown Brooks Caldwell Carson Camp Cameron
|
|
Callahan Brazoria Brazos Brewster)))
|
|
))
|
|
|
|
;; REDUCE
|
|
|
|
(test-case
|
|
"reduce:null-list"
|
|
(check-true (zero? (reduce (lambda (alpha beta) (* alpha (+ beta 1))) 0 '()))))
|
|
|
|
(test-case
|
|
"reduce:singleton-list"
|
|
(check = (reduce (lambda (alpha beta) (* alpha (+ beta 1))) 0 '(25)) 25))
|
|
|
|
(test-case
|
|
"reduce:doubleton-list"
|
|
(check =
|
|
(reduce (lambda (alpha beta) (* alpha (+ beta 1)))
|
|
0
|
|
'(27 29))
|
|
812))
|
|
|
|
(test-case
|
|
"reduce:longer-list"
|
|
(check =
|
|
(reduce (lambda (alpha beta) (* alpha (+ beta 1)))
|
|
0
|
|
'(31 33 35 37 39 41 43))
|
|
94118227527))
|
|
|
|
;; REDUCE-RIGHT
|
|
|
|
(test-case
|
|
"reduce-right:null-list"
|
|
(check-true (zero? (reduce-right (lambda (alpha beta) (* alpha (+ beta 1))) 0 '()))))
|
|
|
|
(test-case
|
|
"reduce-right:singleton-list"
|
|
(check =
|
|
(reduce-right (lambda (alpha beta) (* alpha (+ beta 1))) 0 '(25))
|
|
25))
|
|
|
|
(test-case
|
|
"reduce-right:doubleton-list"
|
|
(check =
|
|
(reduce-right (lambda (alpha beta) (* alpha (+ beta 1)))
|
|
0
|
|
'(27 29))
|
|
810))
|
|
|
|
(test-case
|
|
"reduce-right:longer-list"
|
|
(check =
|
|
(reduce-right (lambda (alpha beta) (* alpha (+ beta 1)))
|
|
0
|
|
'(31 33 35 37 39 41 43))
|
|
93259601719))
|
|
|
|
;; APPEND-MAP
|
|
|
|
(test-case
|
|
"append-map:one-null-list"
|
|
(check-true (null? (append-map (lambda (element) (list element element)) '()))))
|
|
|
|
(test-case
|
|
"append-map:one-singleton-list"
|
|
(check-equal? (append-map (lambda (element) (list element element)) '(Cass))
|
|
'(Cass Cass)))
|
|
|
|
(test-case
|
|
"append-map:one-longer-list"
|
|
(check-equal? (append-map (lambda (element) (list element element))
|
|
'(Castro Chambers Cherokee Childress Clay))
|
|
'(Castro Castro Chambers Chambers Cherokee Cherokee
|
|
Childress Childress Clay Clay)))
|
|
|
|
(test-case
|
|
"append-map:several-null-lists"
|
|
(check-true (null? (append-map (lambda elements (reverse elements))
|
|
'() '() '() '() '()))))
|
|
|
|
(test-case
|
|
"append-map:several-singleton-lists"
|
|
(check-equal? (append-map (lambda elements (reverse elements))
|
|
'(Cochran)
|
|
'(Coke)
|
|
'(Coleman)
|
|
'(Collin)
|
|
'(Collingsworth))
|
|
'(Collingsworth Collin Coleman Coke Cochran)))
|
|
|
|
(test-case
|
|
"append-map:several-longer-lists"
|
|
(check-equal?
|
|
(append-map (lambda elements (reverse elements))
|
|
'(Colorado Comal Comanche Concho Cooke Coryell
|
|
Cottle)
|
|
'(Crane Crockett Crosby Culberson Dallam Dallas
|
|
Dawson)
|
|
'(Delta Denton Dewitt Dickens Dimmit Donley Duval)
|
|
'(Eastland Ector Edwards Ellis Erath Falls Fannin)
|
|
'(Fayette Fisher Floyd Foard Franklin Freestone
|
|
Frio))
|
|
'(Fayette Eastland Delta Crane Colorado Fisher Ector
|
|
Denton Crockett Comal Floyd Edwards Dewitt Crosby
|
|
Comanche Foard Ellis Dickens Culberson Concho
|
|
Franklin Erath Dimmit Dallam Cooke Freestone Falls
|
|
Donley Dallas Coryell Frio Fannin Duval Dawson
|
|
Cottle)))
|
|
|
|
;; APPEND-MAP!
|
|
|
|
(test-case
|
|
"append-map!:one-null-list"
|
|
(check-true (null? (append-map! (lambda (element) (list element element))
|
|
(list)))))
|
|
|
|
(test-case
|
|
"append-map!:one-singleton-list"
|
|
(check-equal?
|
|
(append-map! (lambda (element) (list element element))
|
|
(list 'Gaines))
|
|
'(Gaines Gaines)))
|
|
|
|
(test-case
|
|
"append-map!:one-longer-list"
|
|
(check-equal?
|
|
(append-map! (lambda (element) (list element element))
|
|
(list 'Galveston 'Garza 'Gillespie 'Glasscock
|
|
'Goliad))
|
|
'(Galveston Galveston Garza Garza Gillespie
|
|
Gillespie Glasscock Glasscock Goliad Goliad)))
|
|
|
|
(test-case
|
|
"append-map!:several-null-lists"
|
|
(check-true (null? (append-map! (lambda elements (reverse elements))
|
|
(list)
|
|
(list)
|
|
(list)
|
|
(list)
|
|
(list)))))
|
|
|
|
(test-case
|
|
"append-map!:several-singleton-lists"
|
|
(check-equal?
|
|
(append-map! (lambda elements (reverse elements))
|
|
(list 'Gonzales)
|
|
(list 'Gray)
|
|
(list 'Grayson)
|
|
(list 'Gregg)
|
|
(list 'Grimes))
|
|
'(Grimes Gregg Grayson Gray Gonzales)))
|
|
|
|
(test-case
|
|
"append-map!:several-longer-lists"
|
|
(check-equal?
|
|
(append-map! (lambda elements (reverse elements))
|
|
(list 'Guadalupe 'Hale 'Hall 'Hamilton 'Hansford
|
|
'Hardeman 'Hardin)
|
|
(list 'Harris 'Harrison 'Hartley 'Haskell 'Hays
|
|
'Hemphill 'Henderson)
|
|
(list 'Hidalgo 'Hill 'Hockley 'Hood 'Hopkins
|
|
'Houston 'Howard)
|
|
(list 'Hudspeth 'Hunt 'Hutchinson 'Irion 'Jack
|
|
'Jackson 'Jasper)
|
|
(list 'Jefferson 'Johnson 'Jones 'Karnes 'Kaufman
|
|
'Kendall 'Kenedy))
|
|
'(Jefferson Hudspeth Hidalgo Harris Guadalupe
|
|
Johnson Hunt Hill Harrison Hale Jones Hutchinson
|
|
Hockley Hartley Hall Karnes Irion Hood Haskell
|
|
Hamilton Kaufman Jack Hopkins Hays Hansford
|
|
Kendall Jackson Houston Hemphill Hardeman Kenedy
|
|
Jasper Howard Henderson Hardin)))
|
|
|
|
;; MAP!
|
|
|
|
(test-case
|
|
"map!:one-null-list"
|
|
(check-true (null? (map! vector (list)))))
|
|
|
|
(test-case
|
|
"map!:one-singleton-list"
|
|
(check-equal? (map! vector (list 'Kent))
|
|
'(#(Kent))))
|
|
|
|
(test-case
|
|
"map!:one-longer-list"
|
|
(check-equal?
|
|
(map! vector (list 'Kerr 'Kimble 'King 'Kinney 'Kleberg))
|
|
'(#(Kerr) #(Kimble) #(King) #(Kinney) #(Kleberg))))
|
|
|
|
(test-case
|
|
"map!:several-null-lists"
|
|
(check-true (null? (map! vector (list) (list) (list) (list) (list)))))
|
|
|
|
(test-case
|
|
"map!:several-singleton-lists"
|
|
(check-equal?
|
|
(map! vector
|
|
(list 'Knox)
|
|
(list 'Lamar)
|
|
(list 'Lamb)
|
|
(list 'Lampasas)
|
|
(list 'Lavaca))
|
|
'(#(Knox Lamar Lamb Lampasas Lavaca))))
|
|
|
|
(test-case
|
|
"map!:several-longer-lists"
|
|
(check-equal?
|
|
(map! vector
|
|
(list 'Lee 'Leon 'Liberty 'Limestone 'Lipscomb 'Llano
|
|
'Loving)
|
|
(list 'Lubbock 'Lynn 'McCulloch 'McLennan 'McMullen
|
|
'Madison 'Marion)
|
|
(list 'Martin 'Mason 'Matagorda 'Maverick 'Medina
|
|
'Menard 'Midland)
|
|
(list 'Milam 'Mills 'Mitchell 'Montague 'Montgomery
|
|
'Moore 'Morris)
|
|
(list 'Motley 'Nacogdoches 'Navarro 'Newton 'Nolan
|
|
'Nueces 'Ochiltree))
|
|
'(#(Lee Lubbock Martin Milam Motley)
|
|
#(Leon Lynn Mason Mills Nacogdoches)
|
|
#(Liberty McCulloch Matagorda Mitchell Navarro)
|
|
#(Limestone McLennan Maverick Montague Newton)
|
|
#(Lipscomb McMullen Medina Montgomery Nolan)
|
|
#(Llano Madison Menard Moore Nueces)
|
|
#(Loving Marion Midland Morris Ochiltree))))
|
|
|
|
;; MAP-IN-ORDER
|
|
|
|
(test-case
|
|
"map-in-order:one-null-list"
|
|
(check-true (null? (let ((counter 0))
|
|
(map-in-order (lambda (element)
|
|
(set! counter (+ counter 1))
|
|
(cons counter element))
|
|
'())))))
|
|
|
|
(test-case
|
|
"map-in-order:one-singleton-list"
|
|
(check-equal?
|
|
(let ((counter 0))
|
|
(map-in-order (lambda (element)
|
|
(set! counter (+ counter 1))
|
|
(cons counter element))
|
|
'(Oldham)))
|
|
'((1 . Oldham))))
|
|
|
|
(test-case
|
|
"map-in-order:one-longer-list"
|
|
(check-equal?
|
|
(let ((counter 0))
|
|
(map-in-order (lambda (element)
|
|
(set! counter (+ counter 1))
|
|
(cons counter element))
|
|
'(Orange Panola Parker Parmer Pecos)))
|
|
'((1 . Orange)
|
|
(2 . Panola)
|
|
(3 . Parker)
|
|
(4 . Parmer)
|
|
(5 . Pecos))))
|
|
|
|
(test-case
|
|
"map-in-order:several-null-lists"
|
|
(check-true (null? (let ((counter 0))
|
|
(map-in-order (lambda elements
|
|
(set! counter (+ counter 1))
|
|
(apply vector counter elements))
|
|
'() '() '() '() '())))))
|
|
|
|
(test-case
|
|
"map-in-order:several-singleton-lists"
|
|
(check-equal?
|
|
(let ((counter 0))
|
|
(map-in-order (lambda elements
|
|
(set! counter (+ counter 1))
|
|
(apply vector counter elements))
|
|
'(Polk)
|
|
'(Potter)
|
|
'(Presidio)
|
|
'(Rains)
|
|
'(Randall)))
|
|
'(#(1 Polk Potter Presidio Rains Randall))))
|
|
|
|
(test-case
|
|
"map-in-order:several-longer-lists"
|
|
(check-equal?
|
|
(let ((counter 0))
|
|
(map-in-order (lambda elements
|
|
(set! counter (+ counter 1))
|
|
(apply vector counter elements))
|
|
'(Reagan Real Reeves Refugio Roberts Robertson
|
|
Rockwall)
|
|
'(Runnels Rusk Sabine Schleicher Scurry
|
|
Shackelford Shelby)
|
|
'(Sherman Smith Somervell Starr Stephens
|
|
Sterling Stonewall)
|
|
'(Sutton Swisher Tarrant Taylor Terrell Terry
|
|
Throckmorton)
|
|
'(Titus Travis Trinity Tyler Upshur Upton
|
|
Uvalde)))
|
|
'(#(1 Reagan Runnels Sherman Sutton Titus)
|
|
#(2 Real Rusk Smith Swisher Travis)
|
|
#(3 Reeves Sabine Somervell Tarrant Trinity)
|
|
#(4 Refugio Schleicher Starr Taylor Tyler)
|
|
#(5 Roberts Scurry Stephens Terrell Upshur)
|
|
#(6 Robertson Shackelford Sterling Terry Upton)
|
|
#(7 Rockwall Shelby Stonewall Throckmorton
|
|
Uvalde))))
|
|
|
|
;; PAIR-FOR-EACH
|
|
|
|
(test-case
|
|
"pair-for-each:one-null-list"
|
|
(check-true
|
|
(null? (let ((base '()))
|
|
(pair-for-each (lambda (tail)
|
|
(set! base (append tail base)))
|
|
'())
|
|
base))))
|
|
|
|
(test-case
|
|
"pair-for-each:one-singleton-list"
|
|
(check-equal?
|
|
(let ((base '()))
|
|
(pair-for-each (lambda (tail)
|
|
(set! base (append tail base)))
|
|
'(Victoria))
|
|
base)
|
|
'(Victoria)))
|
|
|
|
(test-case
|
|
"pair-for-each:one-longer-list"
|
|
(check-equal?
|
|
(let ((base '()))
|
|
(pair-for-each (lambda (tail)
|
|
(set! base (append tail base)))
|
|
'(Walker Waller Ward Washington Webb))
|
|
base)
|
|
'(Webb Washington Webb Ward Washington Webb Waller
|
|
Ward Washington Webb Walker Waller Ward
|
|
Washington Webb)))
|
|
|
|
(test-case
|
|
"pair-for-each:several-null-lists"
|
|
(check-true
|
|
(null? (let ((base '()))
|
|
(pair-for-each (lambda tails
|
|
(set! base
|
|
(cons (apply vector tails) base)))
|
|
'() '() '() '() '())
|
|
base))))
|
|
|
|
(test-case
|
|
"pair-for-each:several-singleton-lists"
|
|
(check-equal?
|
|
(let ((base '()))
|
|
(pair-for-each (lambda tails
|
|
(set! base
|
|
(cons (apply vector tails) base)))
|
|
'(Wharton)
|
|
'(Wheeler)
|
|
'(Wichita)
|
|
'(Wilbarger)
|
|
'(Willacy))
|
|
base)
|
|
'(#((Wharton) (Wheeler) (Wichita) (Wilbarger)
|
|
(Willacy)))))
|
|
|
|
(test-case
|
|
"pair-for-each:several-longer-lists"
|
|
(check-equal?
|
|
(let ((base '()))
|
|
(pair-for-each (lambda tails
|
|
(set! base
|
|
(cons (apply vector tails) base)))
|
|
'(Williamson Wilson Winkler Wise Wood Yoakum
|
|
Young)
|
|
'(Zapata Zavala Admiral Advil Ajax Anacin
|
|
Arrid)
|
|
'(Arnold Ban Barbie Beech Blockbuster Bounce
|
|
Breck)
|
|
'(Budweiser Bufferin BVD Carrier Celeste
|
|
Charmin Cheer)
|
|
'(Cheerios Cinemax Clairol Clorets Combat
|
|
Comet Coppertone))
|
|
base)
|
|
'(#((Young) (Arrid) (Breck) (Cheer) (Coppertone))
|
|
#((Yoakum Young) (Anacin Arrid) (Bounce Breck)
|
|
(Charmin Cheer) (Comet Coppertone))
|
|
#((Wood Yoakum Young)
|
|
(Ajax Anacin Arrid)
|
|
(Blockbuster Bounce Breck)
|
|
(Celeste Charmin Cheer)
|
|
(Combat Comet Coppertone))
|
|
#((Wise Wood Yoakum Young)
|
|
(Advil Ajax Anacin Arrid)
|
|
(Beech Blockbuster Bounce Breck)
|
|
(Carrier Celeste Charmin Cheer)
|
|
(Clorets Combat Comet Coppertone))
|
|
#((Winkler Wise Wood Yoakum Young)
|
|
(Admiral Advil Ajax Anacin Arrid)
|
|
(Barbie Beech Blockbuster Bounce Breck)
|
|
(BVD Carrier Celeste Charmin Cheer)
|
|
(Clairol Clorets Combat Comet Coppertone))
|
|
#((Wilson Winkler Wise Wood Yoakum Young)
|
|
(Zavala Admiral Advil Ajax Anacin Arrid)
|
|
(Ban Barbie Beech Blockbuster Bounce Breck)
|
|
(Bufferin BVD Carrier Celeste Charmin Cheer)
|
|
(Cinemax Clairol Clorets Combat Comet
|
|
Coppertone))
|
|
#((Williamson Wilson Winkler Wise Wood Yoakum
|
|
Young)
|
|
(Zapata Zavala Admiral Advil Ajax Anacin Arrid)
|
|
(Arnold Ban Barbie Beech Blockbuster Bounce
|
|
Breck)
|
|
(Budweiser Bufferin BVD Carrier Celeste Charmin
|
|
Cheer)
|
|
(Cheerios Cinemax Clairol Clorets Combat Comet
|
|
Coppertone)))))
|
|
|
|
;; FILTER-MAP
|
|
|
|
(test-case
|
|
"filter-map:one-null-list"
|
|
(check-true (null? (filter-map values '()))))
|
|
|
|
(test-case
|
|
"filter-map:one-singleton-list"
|
|
(check-equal?
|
|
(filter-map values '(Crest))
|
|
'(Crest)))
|
|
|
|
(test-case
|
|
"filter-map:one-list-all-elements-removed"
|
|
(check-true
|
|
(null? (filter-map (lambda (x) #f)
|
|
'(Crisco Degree Doritos Dristan Efferdent)))))
|
|
|
|
(test-case
|
|
"filter-map:one-list-some-elements-removed"
|
|
(check-equal?
|
|
(filter-map (lambda (n) (and (even? n) n))
|
|
'(44 45 46 47 48 49 50))
|
|
'(44 46 48 50)))
|
|
|
|
(test-case
|
|
"filter-map:one-list-no-elements-removed"
|
|
(check-equal?
|
|
(filter-map values '(ESPN Everready Excedrin Fab Fantastik))
|
|
'(ESPN Everready Excedrin Fab Fantastik)))
|
|
|
|
(test-case
|
|
"filter-map:several-null-lists"
|
|
(check-true (null? (filter-map vector '() '() '() '() '()))))
|
|
|
|
(test-case
|
|
"filter-map:several-singleton-lists"
|
|
(check-equal?
|
|
(filter-map vector
|
|
'(Foamy)
|
|
'(Gatorade)
|
|
'(Glad)
|
|
'(Gleem)
|
|
'(Halcion))
|
|
'(#(Foamy Gatorade Glad Gleem Halcion))))
|
|
|
|
(test-case
|
|
"filter-map:several-lists-all-elements-removed"
|
|
(check-true
|
|
(null?
|
|
(filter-map (lambda arguments #f)
|
|
'(Hanes HBO Hostess Huggies Ivory Kent Kinney)
|
|
'(Kleenex Knorr Lee Lenox Lerner Listerine
|
|
Marlboro)
|
|
'(Mazola Michelob Midas Miller NBC Newsweek
|
|
Noxema)
|
|
'(NutraSweet Oreo Pampers People Planters
|
|
Playskool Playtex)
|
|
'(Prego Prell Prozac Purex Ritz Robitussin
|
|
Rolaids)))))
|
|
|
|
(test-case
|
|
"filter-map:several-lists-some-elements-removed"
|
|
(check-equal?
|
|
(filter-map (lambda arguments
|
|
(let ((sum (apply + arguments)))
|
|
(and (odd? sum) sum)))
|
|
'(51 52 53 54 55 56 57)
|
|
'(58 59 60 61 62 63 64)
|
|
'(65 66 67 68 69 70 71)
|
|
'(72 73 74 75 76 77 78)
|
|
'(79 80 81 82 83 84 85))
|
|
'(325 335 345 355)))
|
|
|
|
(test-case
|
|
"filter-map:several-lists-no-elements-removed"
|
|
(check-equal?
|
|
(filter-map vector
|
|
'(Ronzoni Ruffles Scotch Skippy SnackWell Snapple
|
|
Spam)
|
|
'(Sprite Swanson Thomas Tide Tonka Trojan
|
|
Tupperware)
|
|
'(Tylenol Velveeta Vicks Victory Visine Wheaties
|
|
Wise)
|
|
'(Wonder Ziploc Abbott Abingdon Ackley Ackworth
|
|
Adair)
|
|
'(Adams Adaville Adaza Adel Adelphi Adena Afton))
|
|
'(#(Ronzoni Sprite Tylenol Wonder Adams)
|
|
#(Ruffles Swanson Velveeta Ziploc Adaville)
|
|
#(Scotch Thomas Vicks Abbott Adaza)
|
|
#(Skippy Tide Victory Abingdon Adel)
|
|
#(SnackWell Tonka Visine Ackley Adelphi)
|
|
#(Snapple Trojan Wheaties Ackworth Adena)
|
|
#(Spam Tupperware Wise Adair Afton))))
|
|
|
|
))
|
|
)
|
|
;;; fold-test.ss ends here
|