1 ;; The first three lines of this file were inserted by DrScheme. They record metadata
2 ;; about the language level of this file in a form that our tools can easily process.
3 #reader(lib "htdp-intermediate-reader.ss" "lang")((modname 17.6.3) (read-case-sensitive #t) (teachpacks ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "dir.ss" "teachpack" "htdp") (lib "hangman.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "dir.ss" "teachpack" "htdp") (lib "hangman.ss" "teachpack" "htdp")))))
4 (define-struct punch-card (id hours))
5 
6 ;A punch-card is a structure
7 ;(make-punch-card n1 n2)
8 ;where both n1 and n2 are numbers.
9 
10 (define-struct employee (name id rate))
11 
12 ;An employee is a structure
13 ;(make-employee s n1 n2)
14 ;where s is a symbol and id, rate are numbers.
15 ;
16 ;A list-of-punch-cards is either
17 ;1. empty or
18 ;2. (cons pc lopc)
19 ;where pc is a punch-card and lopc is a list-of-punch-cards.
20 ;
21 ;A list-of-employees is either
22 ;1. empty or
23 ;2. (cons e loe)
24 ;where e is an employee and loe is a list-of-employees.
25 ;
26 ;A list-of-payroll is either
27 ;1. empty or
28 ;2. (cons (list id wages) lop)
29 ;where id, wages are numbers and lop is a list-of-payroll.
30 
31 ;hours->wages2 : list-of-employees list-of-punch-cards -> list-of-payroll
32 ;Given loe and lopc, return a list-of-payroll which represent the weekly wage for each employee.  Each element within the list-of-payroll is a 2 element list, the first number representing the employee-id and the second number representing that employee's wages.
33 ;
34 (define (hours->wages2 loe lopc)
35   (cond
36     [(or (not (cons? loe))
37          (not (cons? lopc))) (error 'hours->wages2 "expected arg: two lists")]
38     [(= (length loe) (length lopc))
39      (hours->wages2-sorted (sort-employee loe) (sort-punch-card lopc))]
40     [else (error 'hours->wages2 "lists need to be of equal length")]))
41 ; 
42 ;hours->wages2-sorted : list-of-employees list-of-punch-cards -> list-of-payroll
43 ;Given loe and lopc, sorted by id, returns a list-of-payroll which represent the weekly wage for each employee.  Each element within the list-of-payroll is a 2 element list, the first number representing the employee-id and the second number representing that employee's wages.
44 
45 (define (hours->wages2-sorted loe lopc)   
46   (cond
47     [(empty? loe) empty]
48     [(cons? loe) (cons (list (employee-id (first loe)) 
49                              (* (employee-rate (first loe))
50                                 (punch-card-hours (first lopc))))
51                        (hours->wages2-sorted (rest loe) (rest lopc)))]))
52 
53 ;sort-employee : list-of-employees -> list-of-employees
54 ;Given loe, sort loe by employee-id.
55 
56 (define (sort-employee loe)
57   (cond
58     [(empty? loe) empty]
59     [(cons? loe) (insert-employee (first loe) (sort-employee (rest loe)))]))
60 
61 ;insert-employee : employee list-of-employees -> list-of-employees
62 ;Given an-employee and loe (sorted by id in ascending order), insert an-employee in the proper position in loe and return the resulting list-of-employees.
63 
64 (define (insert-employee an-employee loe)
65   (cond
66     [(empty? loe) (list an-employee)]
67     [(< (employee-id an-employee) (employee-id (first loe))) (cons an-employee loe)]
68     [else (cons (first loe)
69                 (insert-employee an-employee (rest loe)))]))
70 
71 ;sort-punch-card : list-of-punch-cards -> list-of-punch-cards
72 ;Given lopc, sort lopc by punch-card-id.
73 
74 (define (sort-punch-card lopc)
75   (cond
76     [(empty? lopc) empty]
77     [(cons? lopc) (insert-punch-card (first lopc) (sort-punch-card (rest lopc)))]))
78 
79 ;insert-punch-card : punch-card list-of-punch-cards -> list-of-punch-cards
80 ;Given a-punch-card and lopc (sorted by id in ascending order), insert a-punch-card in the proper position in lopc and return the resulting list-of-punch-cards.
81 
82 (define (insert-punch-card a-punch-card lopc)
83   (cond
84     [(empty? lopc) (list a-punch-card)]
85     [(< (punch-card-id a-punch-card) (punch-card-id (first lopc)))
86      (cons a-punch-card lopc)]
87     [else (cons (first lopc)
88                 (insert-punch-card a-punch-card (rest lopc)))]))
89 
90 ;Test sort-employee, sort-punch-card, and hours->wages2
91 (define emp-list (list (make-employee 'Sam 542 15.50)
92                        (make-employee 'Joe 234 24.50)
93                        (make-employee 'Jill 132 14.75)
94                        (make-employee 'Bob 953 35.25)
95                        (make-employee 'Amy 222 20.00)
96                        (make-employee 'Will 100 8.75)))
97 (define punch-list (list (make-punch-card 542 20)
98                          (make-punch-card 234 15)
99                          (make-punch-card 132 25)
100                          (make-punch-card 953 35)
101                          (make-punch-card 222 37)
102                          (make-punch-card 100 28)))
103 
104 ;Test insert-employee and insert-punch-card:
105 ;(define emp-list (list (make-employee 'Will 100 8.75)
106 ;                       (make-employee 'Jill 132 14.75)
107 ;                       (make-employee 'Amy 222 20.00)
108 ;                       (make-employee 'Joe 234 24.50)
109 ;                       (make-employee 'Sam 542 15.50)                    
110 ;                       (make-employee 'Bob 953 35.25)))
111 ;(define punch-list (list (make-punch-card 100 28)
112 ;                         (make-punch-card 132 25)
113 ;                         (make-punch-card 222 37)
114 ;                         (make-punch-card 234 15)
115 ;                         (make-punch-card 542 20)
116 ;                         (make-punch-card 953 35)))
117 ;
118 ;(define new-guy (make-employee 'Newbie 435 13.25))
119 ;(define new-punch (make-punch-card 435 35))
120 ;(insert-employee new-guy emp-list)
121 
122 ;A list-of-numbers is either
123 ;1. empty or
124 ;2. (cons n lon)
125 ;where n is a number and lon is a list-of-numbers.
126 ;
127 ;value : list-of-numbers list-of-numbers -> number
128 ;Computes the sum of all the products of an element in list1 by an element in list2 with the same index.
129 ;ASSUMPTION: list1 and list2 are the same length.
130 ;
131 ;Example:
132 ;(value '(4 5 6) '(1 2 3))
133 ;(+ (* 4 1)
134 ;   (* 5 2)
135 ;   (* 6 3))
136    
137 (define (value list1 list2)
138   (cond
139     [(empty? list1) 0]
140     [(cons? list1) (+ (* (first list1) (first list2))
141                       (value (rest list1) (rest list2)))]))