blob: eced079124b8227fbb519c5ca32e3dacf699eada (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
#lang scheme
;; NAME: hw03.scm
;; AUTHOR: Ben Burwell
;; DESC: CSI310 - Programming Languages - Homework 3
;; HISTORY: Created 2013-01-31
;; ========== PROCEDURE ==========
;; NAME: merge
;; DESC: returns a sorted list of all of the numbers in
;; the two parameters
(define merge
(λ (lon1 lon2)
(qsort (append lon1 lon2))
))
;; helper function
;; this is an implementation of quicksort
(define qsp-helper
(λ (all check less more)
(cond
[ (null? all) (cons less (cons check (cons more '()))) ]
[ else (let ((x (car all)))
(if (<= x check)
(qsp-helper (cdr all) check (cons x less) more)
(qsp-helper (cdr all) check less (cons x more)))) ]
)))
(define qspartition
(λ (lst)
(qsp-helper (cdr lst) (car lst) '() '())
))
(define qsort
(λ (lst)
(cond
[ (null? lst) lst ]
[ else (let ((list1 (qspartition lst)))
(append
(qsort (car list1))
(cons
(cadr list1)
(qsort (caddr list1)))
)) ]
)))
;; ========== TEST CODE ==========
(newline)
(display "Testing (merge) ==========================================================================")
(newline)
(display "Expected output: (1 2 3 4 5 6) ")
(merge '(1 3 5) '(2 4 6))
(display "Expected output: (1 2 2 3) ")
(merge '(1 2) '(2 3))
;; ========== PROCEDURE ==========
;; NAME: car&cdr
;; DESC: returns the code for a procedure
;; that takes a list with the same structure
;; as slst and returns the value in the
;; same position as the leftmost occurrence
;; of s in slst. If s does not occur in
;; slst then errval is returned.
(define car&cdr-help
(λ (s slst errval var)
(cond
[ (null? slst) errval ]
[ (equal? (car slst) s) (list 'λ '(lst) (list 'car var)) ]
[ (and (list? (car slst)) (car&cdr-help s (car slst) errval (list 'car var))) ]
[ (car&cdr-help s (cdr slst) errval (list 'cdr var)) ]
[ else errval ]
)))
(define car&cdr
(λ (s slst errval)
(cond
[ (not (list? slst)) (display "Not a list") ]
[ (list? s) (display "Cannot find a list") ]
[ else (car&cdr-help s slst errval 'lst) ]
)))
;; ========== TEST CODE ==========
(newline)
(display "Testing (car&cdr) ========================================================================")
(newline)
(display "Expected output: (λ (lst) (car (cdr (cdr lst)))) ")
(car&cdr 'c '(a b c d) 'fail)
(display "Expected output: pass ")
(car&cdr 'a '(b c d) 'pass)
;; ========== PROCEDURE ==========
;; NAME: if->cond
;; DESC: that takes an if expression and
;; returns the corresponding cond
;; expression.
(define if->cond
(λ (condlist)
(cond
[ (equal? 3 (length condlist)) (list 'cond (list 'else (list 'if (cadr condlist) (caddr condlist)))) ]
[ (list? (cadddr condlist)) (cons 'cond (ifcondhelper condlist)) ]
[ else (list 'cond (list (cadr condlist) (caddr condlist)) (list 'else (cadddr condlist))) ]
)))
(define ifcondhelper
(λ (condlist)
(cond
[ (list? (cadddr condlist)) (cons (list (cadr condlist) (caddr condlist)) (ifcondhelper (cadddr condlist))) ]
[ else (list (list (cadr condlist) (caddr condlist)) (list 'else (cadddr condlist))) ]
)))
;; ========== TEST CODE ==========
(newline)
(display "Testing (if->cond) =======================================================================")
(newline)
(display "Expected output: (cond (else (if a b))) ")
(if->cond '(if a b))
(display "Expected output: (cond (a b) (else c)) ")
(if->cond '(if a b c))
(display "Expected output: (cond (a b) (c d) (else e)) ")
(if->cond '(if a b (if c d e)))
(display "Expected output: (cond (a (if b c d)) (e f) (else g)) ")
(if->cond '(if a (if b c d) (if e f g)))
|
