[TOC] ## 17.1.2 同时处理两张表 开发 cross，该函数读入一个符号表和一个数表，返回所有可能的符号——数对。 例如： ``` (cross '(a b c) '(1 2)) ;; 期望值： (list (list 'a 1) (list 'a 2) (list 'b 1) (list 'b 2) (list 'c 1) (list 'c 2)) ``` ``` (define (make-list symbol a-list) (cond [(empty? a-list) empty] [else (append (list (list symbol (first a-list))) (make-list symbol (rest a-list))) ])) (define (cross a-list b-list) (cond [(empty? a-list) empty] [(symbol? a-list) (make-list a-list b-list)] [else (append (cross (first a-list) b-list) (cross (rest a-list) b-list)) ])) (cross '(a b c) '(1 2)) ; '((a 1) (a 2) (b 1) (b 2) (c 1) (c 2)) ``` ## 17.2.1 计算员工薪水 在真实世界中，hours->wages 读入员工结构体的表和工作结构体的表。员工结构体包含员工的 名字、社会保险号码和单位工资（每小时工资）。工作结构体包含员工的名字和他一周中的工作时间。函 数的返回值是一个结构体的表，结构体中包含员工的名字和周工资 ``` ;;定义员工一周工作时长的结构体 (define-struct employees (name hours)) ;; 定义员工一周工资结构体 (define-struct employees-out (name salary)) ;; 定义薪水计算 (define (weekly-wage pay-rate hours-worked) (* pay-rate hours-worked)) ;; 计算员工一周薪水以 employess-out 的表 ;;hours->wages:employees,list-salary->employees (define (hours->wages alon1 alon2) (cond [(empty? alon1) empty] [else (list (make-employees-out (employees-name (first alon1)) (weekly-wage (employees-hours (first alon1)) (first alon2) ) ) (hours->wages (rest alon1) (rest alon2)))])) ;; '(#<employees-out> (#<employees-out> ())) (hours->wages (list (make-employees 'a 40.0) (make-employees 'b 30.0)) (list 5.65 8.75)) ``` ## 17.2.2 输出人名电话表 开发函数 zip，该函数把人名的表和电话号码的表结合成电话记录的表。假定其结构体定义如 下 ``` ;; 定义人名电话结构体 (define-struct phone-record (name number)) ;; 注意 else(cons 不能改为 list 否则会出现如下错误 ;; (zip (list 'a) (list 1)) -> '(#<phone-record> ()) (define (zip list-name list-phone) (cond [(empty? list-name) empty] [else (cons (make-phone-record (first list-name) (first list-phone)) (zip (rest list-name) (rest list-phone)))])) (zip empty empty) ;empty (zip (list 'a) (list 1)) ;'(#<phone-record>) (zip (list 'a 'b 'c) (list 1 2 3 ));'(#<phone-record> #<phone-record> #<phone-record>) ``` ## 17.3.1 开发 list-pick0，该函数从表中选出一个元素，类似于 list-pick，但是从 0 开始计数。 ``` (define (list-pick0 list-a n) (cond [(empty? list-a) (error 'list-pick0 "the list is too short")] [(= n 0) (first list-a)] [else (list-pick0 (rest list-a) (- n 1))])) (symbol=? (list-pick0 (list 'a 'b 'c 'd) 3)'d) (list-pick0 (list 'a 'b 'c 'd) 4) ``` ## 17.6 merge 函数,合并两个升序表 开发函数 merge，该函数读入两个升序排列的数表，返回一个升序排列的数表，表中包含（且 仅包含）两个输入表中所有的数，某个数在输出表中出现的次数应该与它在两个输入表中出现的总数相同 ``` ;; 读入两个升序排列的数表,返回一个升序排列的数表 ;; merge:asc1-list,asc2-list:asc3-list ;; 测试案例 ;;(merga empty empty) ;empty ;;(merga empty (list 1)) ;(list 1) ;;(merga (list 1) empty) ;(list 1) ;;(merga (list 1) (list 1 2)) ;(list 1 1 2) ;;(merga (list 1 2) (list 1 3)) ;(list 1 1 2 3) ;;模版 ;;(define (merga list-a list-b) ;; (cond ;; [(empty? list-a) list-b] ;; [(empty? list-b) list-a] ;; [(< (first list-a) (first list-b)) ... (first list-a) ... (merga (rest list-a) list-b )...] ;; [else ... (first list-b) ... (merga list-a (rest list-b ))...])) ;; 测试案例 (define (merga list-a list-b) (cond [(empty? list-a) list-b] [(empty? list-b) list-a] [(< (first list-a) (first list-b)) (cons (first list-a) (merga (rest list-a) list-b ))] [else (cons (first list-b) (merga list-a (rest list-b )))])) (merga empty empty) ;empty (merga empty (list 1)) ;(list 1) (merga (list 1) empty) ;(list 1) (merga (list 1) (list 1 2)) ;(list 1 1 2) (merga (list 1 2) (list 1 3)) ;(list 1 1 2 3) ``` ## 17.8 相等于测试 比较两个list 是否相等 ``` ;; 比较两个 list 是否相等 ;; list=?:a-list.b-list->boolean ;;测试 ;;(boolean=? (list=? empty empty) true) ;;(boolean=? (list=? (list 'a) empty) false) ;;(boolean=? (list=? empty (list 'a)) false) ;;(boolean=? (list=? (list 'a) (list 'a)) true) ;;(boolean=? (list=? (list 'a 'b) (list 'a 'b)) true) ;;(boolean=? (list=? (list 'a) (list 'b)) false) ;; 模板 ;;(define (list=? a-list b-list) ;; (cond ;; [(or (empty? a-list) (empty? b-list)) false ] ;; [not(symbol=? (first a-list) (first b-list) ) false] ;; [(symbol=? (first a-list) (first b-list)) ... (first a-list) ... (list=? (rest a-list) (rest )) ...] ;; [else true])) ;; (define (list=? a-list b-list) (cond [(and (empty? a-list) (empty? b-list)) true] [(or (empty? a-list) (empty? b-list)) false ] [else (and (symbol=? (first a-list) (first b-list)) (list=? (rest a-list) (rest b-list)))])) (boolean=? (list=? empty empty) true) (boolean=? (list=? (list 'a) empty) false) (boolean=? (list=? empty (list 'a)) false) (boolean=? (list=? (list 'a) (list 'a)) true) (boolean=? (list=? (list 'a 'b) (list 'a 'b)) true) (boolean=? (list=? (list 'a) (list 'b)) false) ``` ## 17.8.4 判断两个数表中是否含有相同的数,而不管他们的顺序 ``` ;; 判断两个数表中是否含有相同的数,而不管他们的顺序 ;; contains-same-numbers:a-list,b-list->boolean ;;辅助函数,检测 symbol 是否在 list 中 ;;测试 ;;(boolean=? (contains-symbol 1 (list 1)) true) ;;(boolean=? (contains-symbol 1 (list 2)) false) ;;(boolean=? (contains-symbol 1 (list 2 1)) true) ;;(boolean=? (contains-symbol 1 (list 2 3)) false) (define (contains-symbol num search-list) (cond [(empty? search-list) false] [(= num (first search-list)) true] [else (contains-symbol num (rest search-list))])) ;; 测试 ;;(boolean=? (contains-same-numbers empty empty) false) ;;(boolean=? (contains-same-numbers empty (list 1)) false) ;;(boolean=? (contains-same-numbers (list 1) (list 1)) true) ;;(boolean=? (contains-same-numbers (list 1 2 3) (list 3 2 1)) true) ;;模板 (define (contains-same-numbers a-list b-list) (cond [(empty? a-list) false] [else (and (contains-symbol (first a-list) b-list) (cond [(cons? (rest a-list)) (contains-same-numbers (rest a-list) b-list)] [else true]) )])) (boolean=? (contains-same-numbers empty empty) false) (boolean=? (contains-same-numbers empty (list 1)) false) (boolean=? (contains-same-numbers (list 1) (list 1)) true) (boolean=? (contains-same-numbers (list 1 2 3) (list 3 2 1)) true) ``` ## 17.8.5 开发函数 `list-equal?`,该函数读入两个原子表,判断它们是否相等。 ``` ;; 读入两张原子表,判断他们是否相等 ;;原子类型有三种,数,布尔,符号 ;;辅助函数,两个值是否相等 (define (any-type? x y) (cond [(and (empty? x) (empty? y)) true] [(and (boolean? x) (boolean? y)) (boolean=? x y)] [(and (number? x) (number? y)) (= x y)] [(and (symbol? x) (symbol? y)) (symbol=? x y)] [else false])) ;;辅助函数测试 ;;(boolean=? (any-type? empty empty) true) ;;(boolean=? (any-type? 1 1) true) ;;(boolean=? (any-type? 1 2) false) ;;(boolean=? (any-type? 'a 'a) true) ;;(boolean=? (any-type? 'a 'b) false) ;;(boolean=? (any-type? false false) true) ;;(boolean=? (any-type? false true) false) ;;(boolean=? (any-type? (list 1) 1) false) ;; list-equal?:a-list,b-list->boolean ;;测试 ;;(boolean=? (list-equal? empty empty) true) ;;(boolean=? (list-equal? (list 'a) (list 'a)) true) ;;(boolean=? (list-equal? (list 'a 1 true) (list 'a 1 true)) true) ;;(boolean=? (list-equal? (list 'a 1 true) (list 'a 2 true)) false) (define (list-equal? a-list b-list) (cond [(empty? a-list) (any-type? a-list b-list) ] [else (and (any-type? (first a-list) (first b-list)) (list-equal? (rest a-list) (rest b-list)))])) (boolean=? (list-equal? empty empty) true) (boolean=? (list-equal? (list 'a) (list 'a)) true) (boolean=? (list-equal? (list 'a 1 true) (list 'a 1 true)) true) (boolean=? (list-equal? (list 'a 1 true) (list 'a 2 true)) false) ``` ## 17.8.7 该函数读入两个二元的posn结构体,判断它们是否相等 ``` ;;该函数读入两个二元的posn结构体,判断它们是否相等。 ;; posn 的结构体 (define-struct posn (x y)) ;; posn=?:a-posn,b-posn->boolean ;; 测试 ;; (define (posn=? a-posn b-posn) (cond [(and (posn? a-posn) (posn? b-posn)) ( and (= (posn-x a-posn) (posn-x b-posn)) (= (posn-y a-posn) (posn-y b-posn)))] [else false])) (boolean=? (posn=? empty empty) false) (boolean=? (posn=? empty (make-posn 1 1)) false) (boolean=? (posn=? (make-posn 1 1) empty) false) (boolean=? (posn=? (make-posn 1 1) (make-posn 1 1)) true) (boolean=? (posn=? (make-posn 1 1) (make-posn 1 2)) false) ```