I am doing a scheme project and having some issues with the coding.
For my project we have to keep a class roster(implemented as a list) and be able to perform different operations. I have two questions:
My write roster function opens up the file name passed through but does NOT write the list to the file and Im not sure why? you can find this function in the perform task function , when n = 2.
And my remove function... when I go to test it, I get the error:
;The procedure #[compiled-procedure 13 ("list" #x3) #x14 #x11a2714] has been called with 4 arguments; it requires exactly 2 arguments.
My remove function is called removestu
here is my code:
(define performtask
(lambda (n roster)
(cond ((= n 0) (begin
(display "\n\tResetting roster...\n\n")
(menu '())
))
((= n 1) (begin
(display "\n\tLoad roster from file: ")
(read (open-input-file (read-line)))
(menu roster)
))
((= n 2) (begin
(display "\n\tStore roster to file: ")
(write roster (open-output-file (read-line)))
(menu roster)
))
((= n 3) (begin
(display "\n\tDisplaying roster, sorted by ID:\n")
(printroster (select-sort roster))
(menu roster)
))
((= n 4) (begin
(display "\n\tDisplaying roster, sorted by ID:\n")
(printroster (select-sort-name roster))
(menu roster)
))
((= n 5) (begin
(display "\n\tDisplaying roster, sorted by ID:\n")
(printroster (select-sort-grade roster))
(menu roster)
))
((= n 6) (begin
(display "\n\tEnter student name or ID: ")
(studentinfo roster (read-line))
(menu roster)
))
((= n 7) (begin
(display "\n\tAdd a student to the class roster:\n\n")
(cond ((null? roster) (menu (read-3-items 0 '())))
(else (menu (list (read-3-items 0 '()) roster))))
))
((= n 8) (begin
(display "\n\tEnter student name or ID: ")
(removestu roster (read-line))
(menu roster)
))
((= n 9) (begin
(display "\n\tExiting program...\n\n")
#t
))
(else (begin
(display "\n\tTask no. ")
(display n)
(display " does not exist.\n\n")
(menu roster)
)
)
)
)
)
(define studentinfo
(lambda (lst value)
(cond ((null? lst) (display "\n\tStudent is not found in roster.\n"))
((equal? (car (car lst)) value) (printrecord (car lst)))
((equal? (car (cdr (car lst))) value) (printrecord (car lst)))
(else (studentinfo (cdr lst) value))
)
)
)
(define printroster
(lambda (billy)
(cond ((null? billy) (newline))
(else (begin
(printrecord (car billy))
(printroster (cdr billy))
)
)
)
)
)
(define printrecord
(lambda (lst)
(begin
(display "\tID=")
(display (car lst))
(display ", Name=")
(display (car (cdr lst)))
(display ", Grade=")
(display (car (cdr (cdr lst))))
(newline)
)
)
)
(define select-sort
(lambda (roster)
(cond ((null? roster) '())
(else (cons (smallest roster (car roster)) (select-sort (remove roster (smallest roster (car roster))))))
)
)
)
(define select-sort-name
(lambda (roster)
(cond ((null? roster) '())
(else (cons (smallest-name roster (car roster)) (select-sort (remove roster (smallest-name roster (car ro\
ster))))))
)
)
)
(define select-sort-grade
(lambda (roster)
(cond ((null? roster) '())
(else (cons (smallest-grade roster (car roster)) (select-sort (remove roster (smallest-grade roster (\
car roster))))))
)
)
)
(define smallest
(lambda (roster record)
(cond ((null? roster) record)
((< (car (car roster)) (car record)) (smallest (cdr roster) (car roster)))
(else (smallest (cdr roster) record))
)
)
)
(define smallest-name
(lambda (roster record)
(cond ((null? roster) record)
((< (car (cdr (car roster))) (car (cdr record))) (smallest-name (cdr roster) (car roster)))
(else (smallest-name (cdr roster) record))
)
)
)
(define smallest-grade
(lambda (roster record)
(cond ((null? roster) record)
((< (cdr (cdr (car roster))) (cdr (cdr record))) (smallest-grade (cdr roster) (car roster)))
(else (smallest-grade (cdr roster) record))
)
)
)
(define removestu
(lambda (roster item)
(cond ((null? roster) '())
((equal? item (car roster)) (cdr roster))
(else (cons (car roster) removestu (cdr roster) item))
)
)
)
(define read-3-items
(lambda (n l)
(cond ((= n 0) (begin
(display "\tStudent ID: ")
(read-3-items 1 (list (read)))
))
((= n 1) (begin
(display "\n\tStudent name: ")
(read-3-items 2 (list (car l) (read-line)))
))
((= n 2) (begin
(display "\n\tGrade: ")
(list (car l) (car (cdr l)) (read))
))
)
)
)
(define menu
(lambda (roster)
(begin
(display "\n\tClass roster management system\n")
(display "\t============================\n")
(display "\t MENU\n")
(display "\t============================\n")
(display "\t0. Reset roster\n")
(display "\t1. Load roster from file\n")
(display "\t2. Store roster to file\n")
(display "\t3. Display roster sorted by ID\n")
(display "\t4. Display roster sorted by name\n")
(display "\t5. Display roster sorted by grade\n")
(display "\t6. Display student info\n")
(display "\t7. Add a student to roster\n")
(display "\t8. Remove a student from roster\n")
(display "\t9. Exit\n\n")
(display "\tEnter your choice: ")
(performtask (read) roster)
)
)
)
(write roster (open-output-file (read-line))) seems ok. but you don't close the port you get from open-output-file. Perhaps you should use with-output-to-file instead.
cons is called with 4 arguments (cons (car roster) removestu (cdr roster) item). It takes only two to make a pair!
I noticed that when reading a file you don't use it. The tail call is (menu roster) and the result from (read (open-input-file (read-line))) is read and returned and, since it's not used, deleted.
Related
I'm trying to create a function called evenElememt that takes a list as a parameter and appends all the elements in even positions to a new list and displays the new list.
My attempt:
(define newList '())
(define elementHelper
(lambda lst
((cdr lst)
(cons newList (car lst))
(elementHelper(cdr lst)))
)
)
(define evenElement
(lambda (lst)
(cond
((null? lst) ())
((null? (cdr lst)) ())
(else (elementHelper lst)
(display lst))
)
)
)
Example output: if I enter (evenElement '('a 'b 'c 'f 't 'y)), the output should be (b f y).
This is essentially the same as Can I print alternate elements of a list in Racket?, except that you want to print even positions (1-indexed) instead of odd positions.
(define (even-positions lst)
(cond ((null? lst)
'())
((null? (cdr lst))
'())
(else
(cons (second lst)
(even-positions (cddr lst))))))
(even-positions '(a b c f t y)) returns '(b f y).
Then, this is the function you are looking for:
(define (display-even-positions lst)
(display (even-positions lst)))
You don't need elementHelper. Just make evenElement return the result instead of displaying it.
You also don't need the global variable newList. The function should construct the result as it goes.
(define evenElement
(lambda (lst)
(cond
((null? lst) '())
((null? (cdr lst)) '())
(else (cons (car (cdr lst))
(evenElement (cdr (cdr lst)))))
)
)
)
(display (evenElement '(a b c f t y)))
This is what I have to sort strings:
;create a function that checks if a list of strings is sorted
(define (stringCmpr l)
(if (<= (length l) 1)
true
(and (string<=? (car l) (cadr l))(stringCmpr (cdr l))
)
)
)
;Create a funciton that checks if a list of numbers is sorted
(define (numCmpr l)
(if (<= (length l) 1)
true
(and (<= (car l) (cadr l)) (numCmpr (cdr l))
)
)
)
;create function that checks whether a list containes numbers of
strings checks if the list is sorted
(define (is-sorted? l)
(if (number? (car l))
(numCmpr l)
(stringCmpr l)
)
)
(define (bubble-pass lst)
(cond
((empty? lst) lst)
((= (length lst) 1) lst)
((and (= (length lst) 2) (string>? (first lst) (second lst)))
(list
(second lst) (first lst)))
((and (= (length lst) 2) (string<? (first lst) (second lst)))
lst)
((string>? (first lst) (second lst))
(append
(list (second lst))
(bubble-pass (append (list (first lst)) (rest (rest lst))))
)
)
(else
(append (list (first lst) (second lst)) (bubble-pass (rest
(rest lst))))
)
)
)
(define (string-bubble-sort lst)
(if (is-sorted? lst)
lst
(string-bubble-sort (bubble-pass last))
)
)
This works for sorting strings in order from A-Z
This is what I have so far for the general sort (func represents the comparer: <, > =, string<?, etc):
;create a function that checks if a list of strings is sorted
(define (gen-stringCmpr l func)
(if (<= (length l) 1)
true
(and (func (car l) (cadr l))(gen-stringCmpr (cdr l) func)
)
)
)
;Create a funciton that checks if a list of numbers is sorted
(define (gen-numCmpr l func)
(if (<= (length l) 1)
true
(and (func (car l) (cadr l)) (gen-numCmpr (cdr l) func)
)
)
)
;create funciton that checks whether a list contains numbers or
strings checks if the list is sorted
(define (general-sorted? l func)
(if (number? (car l))
(gen-numCmpr l func)
(gen-stringCmpr l func)
)
)
; Purpose: Create a function that bubble sorts a list given a
; comparison function
;Signature:
; list function-> list
;Examples:
(check-expect (general-bubble-sort (list "B" "A" "C") string<?) (list
"A" "B" "C"))
(check-expect (general-bubble-sort (list "B" "A" "C") string>?) (list
"C" "B" "A"))
(check-expect (general-bubble-sort (list 6 4 5) <) (list 4 5 6))
(check-expect (general-bubble-sort (list 2 3 1) >) (list 3 2 1))
Stub:
(define (general-bubble-sort lst func) '( "spinach")
Template:
Code:
(define (general-bubble-pass lst func)
(cond
((empty? lst) last)
((= (length lst) 1) last)
((and (= (length lst) 2) (equal? (func (first lst) (second lst))
false)) (list (second lst) (first lst)))
((and (= (length lst) 2) (func (first lst) (second lst))) last)
((equal? (func (first lst) (second lst)) false)
(append
(list (second last))
(general-bubble-pass (append (list (first lst)) (rest (rest
lst))) func)
)
)
(else
(append (list (first lst) (second lst)) (general-bubble-pass
(rest (rest lst)) func))
)
)
)
(define (general-bubble-sort lst func)
(if (general-sorted? lst func)
lst
(general-bubble-sort (general-bubble-pass lst func) func)
)
)
You aren't properly using your abstractions here because of overly permissive signatures. Technically you want your final bubble sort to work like this:
; general-bubble-sort: (X) [List-of X] [X X -> Boolean] -> [List-of X]
By constraining the types of what we take in and telling users how they should use it, we eliminate the checking we need to do in general-sorted?. We just know that we have to pass the correct function to it, otherwise it is the users fault for not passing the correct function. You can also abstract more of your code between your two functions. Like this:
(define (general-sorted? l func)
(or (<= (length l) 1) (and (func (car l) (cadr l)) (general-sorted? (cdr l)))))
Your second function has a lot going on in it, lets combine some of the cases and also not use (equal? x boolean). That is bad practice. Instead we should use a boolean expression to get us true when appropriate. We should also make use of accumulators here as it clearly says what piece of data we are keeping track of as we are recurring down:
(define (general-bubble-pass lst func)
(local [(define (general-bubble-pass-acc lst bubble)
(cond
[(empty? lst) (list bubble)]
[(not (func (first lst) bubble)) (cons bubble (general-bubble-pass-acc (rest lst) (first lst)))]
[else (cons (first lst) (general-bubble-pass-acc (rest lst) bubble))]))]
(if (<= (length lst) 1) lst (general-bubble-pass-acc (rest lst) (first lst)))))
Your final bubble sort function doesn't change.
I have the function getBoundedVars which uses the function boundsInLambda. In the end of it all the box bBox should contain all bounded variables in the expression exp.
I'm trying to debug this function and in order to do so I want to print the parameters of boundsInLambda every time the function is being activated but for some reason the values won't show up on the screen.
If I put the display operation in getBoundedVars it will print it but those are just the values in the first iteration.
If I run the following :
(getBoundedVars (lambda-simple (x) (lambda-simple (y) (const x))) bx)
when bx is an empty box,
'1 will be printed but the print commands in boundsInLambda will not
here's the code:
(define getBoundedVars
(lambda (exp bBox)
(if (atom? exp)
0 ;; don't put in box
(if (lambda? (car exp))
(begin
(display 1)
(newline)
(let ((pBox (make-pBox exp))
(lBox (box '()))
(bodyExp (make-body exp))
)
(boundsInLambda bodyExp lBox pBox bBox)))
(begin
(getBoundedVars (car exp) bBox)
(getBoundedVars (cdr exp) bBox))))))
(define boundsInLambda
(lambda (bodyExp lastBox paramBox boundsBox)
(newline)
(display `(bodyExp: ,bodyExp))
(newline)
(display `(lastBox: ,lastBox))
(newline)
(display `(paramBox: ,paramBox))
(newline)
(display `(boundsBox: ,boundsBox))
(newline)
(if (and (not (null? bodyExp))
(list bodyExp)
(equal? (car bodyExp) 'seq)
)
(map boundsInLambda (cadr bodyExp))
(let* ( (lists* (filter (lambda (el) (and (not (null? el)) (list? el) (not (equal? (car el) 'const)))) bodyExp))
(lists (map (lambda (el) (if (equal? (car el) 'set) (cddr el) el)) lists*))
(bounds (filter (lambda (el) (and (member el (unbox lastBox)) (not (member el (unbox paramBox))))) bodyExp))
(listsLeft? (> (length lists) 0))
(anyBounds? (> (length bounds) 0))
)
(if anyBounds?
(begin
(set-box! boundsBox (append (unbox boundsBox) bounds))))
(if listsLeft?
(map
(lambda (lst)
(if (lambda? (car lst))
(let* ((newBodyExp (make-body lst))
(newParamBox (make-pBox exp))
(newLastBox (box (append (unbox lastBox) (unbox paramBox))))
)
(boundsInLambda newBodyExp newLastBox newParamBox boundsBox))
(boundsInLambda lst lastBox paramBox boundsBox)))
lists)
0))
)))
(define make-pBox
(lambda (lamExp)
(if (equal? (car lamExp) 'lambda-simple)
(box (cadr lamExp))
(if (equal? (car lamExp) 'lambda-opt)
(box (cadr lamExp))
(box '())))))
(define make-body
(lambda (lamExp)
(if (equal? (car lamExp) 'lambda-opt)
(cdddr lamExp)
(cddr lamExp))))
any help would be very much appreciated.
I've been self-teaching myself Scheme R5RS for the past few months and have just started learning about mutable functions. I've did a couple of functions like this, but seem to find my mistake for this one.
(define (lst-functions)
(let ((lst '()))
(define (sum lst)
(cond ((null? lst) 0)
(else
(+ (car lst) (sum (cdr lst))))))
(define (length? lst)
(cond ((null? lst) 0)
(else
(+ 1 (length? (cdr lst))))))
(define (average)
(/ (sum lst) (length? lst)))
(define (insert x)
(set! lst (cons x lst)))
(lambda (function)
(cond ((eq? function 'sum) sum)
((eq? function 'length) length?)
((eq? function 'average) average)
((eq? function 'insert) insert)
(else
'undefined)))))
(define func (lst-functions))
((func 'insert) 2)
((func 'average))
You're not declaring the lst parameter in the procedures that use it, but you're passing it when invoking them. I marked the lines that were modified, try this:
(define (lst-functions)
(let ((lst '()))
(define (sum lst) ; modified
(cond ((null? lst) 0)
(else
(+ (car lst) (sum (cdr lst))))))
(define (length? lst) ; modified
(cond ((null? lst) 0)
(else
(+ 1 (length? (cdr lst))))))
(define (average)
(/ (sum lst) (length? lst)))
(define (insert x)
(set! lst (cons x lst)))
(lambda (function)
(cond ((eq? function 'sum) (lambda () (sum lst))) ; modified
((eq? function 'length) (lambda () (length? lst))) ; modified
((eq? function 'average) average)
((eq? function 'insert) insert)
(else
'undefined)))))
Now it works as expected:
(define func (lst-functions))
((func 'insert) 2)
((func 'average))
=> 2
((func 'sum))
=> 2
((func 'length))
=> 1
Some of your functions are recursive but defined without argument. Thus (sum (cdr lst)) shouldn't work since sum uses lst. You could do it by defining a helper:
(define (sum-rec lst)
(if (null? lst)
0
(+ (car lst) (sum-rec (cdr lst)))))
Or perhaps with an accumulator:
(define (sum-iter lst acc)
(if (null? lst)
acc
(sum-iter (cdr lst) (+ (car lst) acc)))
Your sum would of course use it passing the lst:
(define (sum)
(sum-iter lst 0))
Or you can just have the driver partial apply them like this:
(lambda (function)
(cond ((eq? function 'sum) (lambda () (sum-iter lst))
...))
A side note. length? is a strangely named function. A question mark in the end of a name is usually reserved for functions that return a true or a false value and this clearly returns a number.
I have 1 big list of smaller 3-element-lists that look like:
( ("001" "Bob" 80) ("002" "Sam" 85) ("003" "Aaron" 94) etc . . .)
I'm trying to create something like:
No.1: ID=001, Name=’’Bob’’, Grade=80
No.2: ID=002, Name=’’Sam’’, Grade=85
No.3: ID=003, Name=’’Aaron’’, Grade=94
I only have access to display and for-each (no "for" or "printf" functions)
I've been trying to create a for-each function that takes the list and:
pseudo-code:
for-each list in list
display "ID=(car list)"
display "Name ="(cadr list)" "
etc
Any help would be greatly appreciated!
So, your interpreter doesn't have printf after all? that's a shame. We can get the desired output by hand, it's a bit cumbersome but this should work on most Scheme interpreters, notice that an extra procedure is required for keeping track of the index:
(define lst
'(("001" "Bob" 80) ("002" "Sam" 85) ("003" "Aaron" 94)))
(define (add-index lst)
(let loop ((lst lst) (idx 1))
(if (null? lst)
'()
(cons (cons idx (car lst))
(loop (cdr lst) (+ idx 1))))))
(for-each (lambda (e)
(display "No.")
(display (car e))
(display ": ID=")
(display (cadr e))
(display ", Name=’’")
(display (caddr e))
(display "’’, Grade=")
(display (cadddr e))
(newline))
(add-index lst))
It prints the desired result:
No.1: ID=001, Name=’’Bob’’, Grade=80
No.2: ID=002, Name=’’Sam’’, Grade=85
No.3: ID=003, Name=’’Aaron’’, Grade=94
Here's another version. It avoids construction of a temporary list.
(define lst
'(("001" "Bob" 80) ("002" "Sam" 85) ("003" "Aaron" 94)))
(define (print-list lst)
(define (display-one-item item index)
(display "No.")
(display index)
(display ": ID=")
(display (car item))
(display ", Name=’’")
(display (cadr item))
(display "’’, Grade=")
(display (caddr item))
(newline))
(define (helper in index)
(if (not (null? in))
(begin
(display-one-item (car in) index)
(helper (cdr in) (+ index 1))
)))
(helper lst 0))
(print-list lst)