1 12687dd9 2023-08-04 jrmu ;; The first three lines of this file were inserted by DrScheme. They record metadata
2 12687dd9 2023-08-04 jrmu ;; about the language level of this file in a form that our tools can easily process.
3 12687dd9 2023-08-04 jrmu #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 12687dd9 2023-08-04 jrmu (define-struct punch-card (id hours))
6 12687dd9 2023-08-04 jrmu ;A punch-card is a structure
7 12687dd9 2023-08-04 jrmu ;(make-punch-card n1 n2)
8 12687dd9 2023-08-04 jrmu ;where both n1 and n2 are numbers.
10 12687dd9 2023-08-04 jrmu (define-struct employee (name id rate))
12 12687dd9 2023-08-04 jrmu ;An employee is a structure
13 12687dd9 2023-08-04 jrmu ;(make-employee s n1 n2)
14 12687dd9 2023-08-04 jrmu ;where s is a symbol and id, rate are numbers.
16 12687dd9 2023-08-04 jrmu ;A list-of-punch-cards is either
17 12687dd9 2023-08-04 jrmu ;1. empty or
18 12687dd9 2023-08-04 jrmu ;2. (cons pc lopc)
19 12687dd9 2023-08-04 jrmu ;where pc is a punch-card and lopc is a list-of-punch-cards.
21 12687dd9 2023-08-04 jrmu ;A list-of-employees is either
22 12687dd9 2023-08-04 jrmu ;1. empty or
23 12687dd9 2023-08-04 jrmu ;2. (cons e loe)
24 12687dd9 2023-08-04 jrmu ;where e is an employee and loe is a list-of-employees.
26 12687dd9 2023-08-04 jrmu ;A list-of-payroll is either
27 12687dd9 2023-08-04 jrmu ;1. empty or
28 12687dd9 2023-08-04 jrmu ;2. (cons (list id wages) lop)
29 12687dd9 2023-08-04 jrmu ;where id, wages are numbers and lop is a list-of-payroll.
31 12687dd9 2023-08-04 jrmu ;hours->wages2 : list-of-employees list-of-punch-cards -> list-of-payroll
32 12687dd9 2023-08-04 jrmu ;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.
34 12687dd9 2023-08-04 jrmu (define (hours->wages2 loe lopc)
36 12687dd9 2023-08-04 jrmu [(or (not (cons? loe))
37 12687dd9 2023-08-04 jrmu (not (cons? lopc))) (error 'hours->wages2 "expected arg: two lists")]
38 12687dd9 2023-08-04 jrmu [(= (length loe) (length lopc))
39 12687dd9 2023-08-04 jrmu (hours->wages2-sorted (sort-employee loe) (sort-punch-card lopc))]
40 12687dd9 2023-08-04 jrmu [else (error 'hours->wages2 "lists need to be of equal length")]))
42 12687dd9 2023-08-04 jrmu ;hours->wages2-sorted : list-of-employees list-of-punch-cards -> list-of-payroll
43 12687dd9 2023-08-04 jrmu ;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.
45 12687dd9 2023-08-04 jrmu (define (hours->wages2-sorted loe lopc)
47 12687dd9 2023-08-04 jrmu [(empty? loe) empty]
48 12687dd9 2023-08-04 jrmu [(cons? loe) (cons (list (employee-id (first loe))
49 12687dd9 2023-08-04 jrmu (* (employee-rate (first loe))
50 12687dd9 2023-08-04 jrmu (punch-card-hours (first lopc))))
51 12687dd9 2023-08-04 jrmu (hours->wages2-sorted (rest loe) (rest lopc)))]))
53 12687dd9 2023-08-04 jrmu ;sort-employee : list-of-employees -> list-of-employees
54 12687dd9 2023-08-04 jrmu ;Given loe, sort loe by employee-id.
56 12687dd9 2023-08-04 jrmu (define (sort-employee loe)
58 12687dd9 2023-08-04 jrmu [(empty? loe) empty]
59 12687dd9 2023-08-04 jrmu [(cons? loe) (insert-employee (first loe) (sort-employee (rest loe)))]))
61 12687dd9 2023-08-04 jrmu ;insert-employee : employee list-of-employees -> list-of-employees
62 12687dd9 2023-08-04 jrmu ;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.
64 12687dd9 2023-08-04 jrmu (define (insert-employee an-employee loe)
66 12687dd9 2023-08-04 jrmu [(empty? loe) (list an-employee)]
67 12687dd9 2023-08-04 jrmu [(< (employee-id an-employee) (employee-id (first loe))) (cons an-employee loe)]
68 12687dd9 2023-08-04 jrmu [else (cons (first loe)
69 12687dd9 2023-08-04 jrmu (insert-employee an-employee (rest loe)))]))
71 12687dd9 2023-08-04 jrmu ;sort-punch-card : list-of-punch-cards -> list-of-punch-cards
72 12687dd9 2023-08-04 jrmu ;Given lopc, sort lopc by punch-card-id.
74 12687dd9 2023-08-04 jrmu (define (sort-punch-card lopc)
76 12687dd9 2023-08-04 jrmu [(empty? lopc) empty]
77 12687dd9 2023-08-04 jrmu [(cons? lopc) (insert-punch-card (first lopc) (sort-punch-card (rest lopc)))]))
79 12687dd9 2023-08-04 jrmu ;insert-punch-card : punch-card list-of-punch-cards -> list-of-punch-cards
80 12687dd9 2023-08-04 jrmu ;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.
82 12687dd9 2023-08-04 jrmu (define (insert-punch-card a-punch-card lopc)
84 12687dd9 2023-08-04 jrmu [(empty? lopc) (list a-punch-card)]
85 12687dd9 2023-08-04 jrmu [(< (punch-card-id a-punch-card) (punch-card-id (first lopc)))
86 12687dd9 2023-08-04 jrmu (cons a-punch-card lopc)]
87 12687dd9 2023-08-04 jrmu [else (cons (first lopc)
88 12687dd9 2023-08-04 jrmu (insert-punch-card a-punch-card (rest lopc)))]))
90 12687dd9 2023-08-04 jrmu ;Test sort-employee, sort-punch-card, and hours->wages2
91 12687dd9 2023-08-04 jrmu (define emp-list (list (make-employee 'Sam 542 15.50)
92 12687dd9 2023-08-04 jrmu (make-employee 'Joe 234 24.50)
93 12687dd9 2023-08-04 jrmu (make-employee 'Jill 132 14.75)
94 12687dd9 2023-08-04 jrmu (make-employee 'Bob 953 35.25)
95 12687dd9 2023-08-04 jrmu (make-employee 'Amy 222 20.00)
96 12687dd9 2023-08-04 jrmu (make-employee 'Will 100 8.75)))
97 12687dd9 2023-08-04 jrmu (define punch-list (list (make-punch-card 542 20)
98 12687dd9 2023-08-04 jrmu (make-punch-card 234 15)
99 12687dd9 2023-08-04 jrmu (make-punch-card 132 25)
100 12687dd9 2023-08-04 jrmu (make-punch-card 953 35)
101 12687dd9 2023-08-04 jrmu (make-punch-card 222 37)
102 12687dd9 2023-08-04 jrmu (make-punch-card 100 28)))
104 12687dd9 2023-08-04 jrmu ;Test insert-employee and insert-punch-card:
105 12687dd9 2023-08-04 jrmu ;(define emp-list (list (make-employee 'Will 100 8.75)
106 12687dd9 2023-08-04 jrmu ; (make-employee 'Jill 132 14.75)
107 12687dd9 2023-08-04 jrmu ; (make-employee 'Amy 222 20.00)
108 12687dd9 2023-08-04 jrmu ; (make-employee 'Joe 234 24.50)
109 12687dd9 2023-08-04 jrmu ; (make-employee 'Sam 542 15.50)
110 12687dd9 2023-08-04 jrmu ; (make-employee 'Bob 953 35.25)))
111 12687dd9 2023-08-04 jrmu ;(define punch-list (list (make-punch-card 100 28)
112 12687dd9 2023-08-04 jrmu ; (make-punch-card 132 25)
113 12687dd9 2023-08-04 jrmu ; (make-punch-card 222 37)
114 12687dd9 2023-08-04 jrmu ; (make-punch-card 234 15)
115 12687dd9 2023-08-04 jrmu ; (make-punch-card 542 20)
116 12687dd9 2023-08-04 jrmu ; (make-punch-card 953 35)))
118 12687dd9 2023-08-04 jrmu ;(define new-guy (make-employee 'Newbie 435 13.25))
119 12687dd9 2023-08-04 jrmu ;(define new-punch (make-punch-card 435 35))
120 12687dd9 2023-08-04 jrmu ;(insert-employee new-guy emp-list)
122 12687dd9 2023-08-04 jrmu ;A list-of-numbers is either
123 12687dd9 2023-08-04 jrmu ;1. empty or
124 12687dd9 2023-08-04 jrmu ;2. (cons n lon)
125 12687dd9 2023-08-04 jrmu ;where n is a number and lon is a list-of-numbers.
127 12687dd9 2023-08-04 jrmu ;value : list-of-numbers list-of-numbers -> number
128 12687dd9 2023-08-04 jrmu ;Computes the sum of all the products of an element in list1 by an element in list2 with the same index.
129 12687dd9 2023-08-04 jrmu ;ASSUMPTION: list1 and list2 are the same length.
132 12687dd9 2023-08-04 jrmu ;(value '(4 5 6) '(1 2 3))
133 12687dd9 2023-08-04 jrmu ;(+ (* 4 1)
137 12687dd9 2023-08-04 jrmu (define (value list1 list2)
139 12687dd9 2023-08-04 jrmu [(empty? list1) 0]
140 12687dd9 2023-08-04 jrmu [(cons? list1) (+ (* (first list1) (first list2))
141 12687dd9 2023-08-04 jrmu (value (rest list1) (rest list2)))]))
