How to control if the predicate is given in the command prompt? - scheme

I am trying to do some operation in the list if the predicate returns true. But predicate is given as input in command line and it is a function. Let me give an example.
(define (delete-rows table predicate)
do_something)
And the command line looks like this.
(delete-rows student-table
(lambda (table row)
(eq? (get table row 'name) 'ali)))
=> '(students (name id gpa) (ayse 2 3.7))
Thanks for your help in advance.

Here is a very naïve and inefficient implementation in Racket, just to get you on the right track:
(define (list-index e lst)
(- (length lst) (length (memq e lst))))
(define (get table row col)
(list-ref row (list-index col (second table))))
(define (delete-rows table pred)
(list* (first table)
(second table)
(filter (lambda (r) (not (pred table r))) (cddr table))))
then
(define student-table '(students (name id gpa) (ali 1 2) (ayse 2 3.7) (zalde 3 5)))
(delete-rows student-table (lambda (table row) (eq? (get table row 'name) 'ali)))
=> '(students (name id gpa) (ayse 2 3.7) (zalde 3 5))

Related

Structure And Interpretation of Computer Programs Ex2_74

I'm trying to tag a list so that the file1 variable out like the following in Racket:
(Div1 ((Sam Parnell 100) (Tom Edward 1000) (Rob Hanbury 500) (Andy Springwood 500)))
however I am getting:
((Sam Parnell 100) (Tom Edward 1000) (Rob Hanbury 500) (Andy Springwood 500))
I am using "tag" internally in my package to tag a series of records using the make-file procedure. It should follow the evaluation model set out in section 1.1.3 I think, but it feels like it isn't and this may be to do with the fact that I have defined make-file to take an arbitrary number of arguments which may effect the evaluation model in ways I haven't yet understood. I've also attempted to debug this in Racket to no avail as it skips how it is evaluated as I step through, so I'm stuck. If anyone could help, it would be greatly appreciated.
#lang sicp
(#%require (only racket/base error))
(#%require (only racket/base make-hash))
(#%require (only racket/base hash-set!))
(#%require (only racket/base hash-ref))
; table set up
(define *op-table* (make-hash))
(define (put op type proc)
(hash-set! *op-table* (list op type) proc))
(define (get op type)
(hash-ref *op-table* (list op type) '()))
; data tagging set up
(define (attach-tag type-tag contents)
(cons type-tag contents))
(define (type-tag datum)
(if (pair? datum)
(car datum)
(error "Bad tagged datum -- TYPE-TAG" datum)))
(define (contents datum)
(if (pair? datum)
(cdr datum)
(error "Bad tagged datum -- CONTENTS" datum)))
(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc
(apply proc (map contents args))
(error
"No method for these types -- APPLY-GENERERIC"
(list op type-tags))))))
(define (install-Div1-Package)
(define (get-name record)
(car record))
(define (get-address record)
(cadr record))
(define (get-salary record)
(caddr record))
(define (make-record name address salary)
(list name address salary))
(define (get-record key file)
(cond ((null? file) (error "Employee not in file"))
((eq? key (get-name (car file)))
(car file))
(else (get-record key (cdr file)))))
(define (make-file . records)
records)
;interface to the rest of the system
(define (tag x) (attach-tag 'Div1 x))
(put 'get-name '(Div1) get-name)
(put 'get-address '(Div1) get-address)
(put 'get-salary '(Div1) get-salary)
(put 'make-record 'Div1
(lambda (name address salary)
(make-record name address salary)))
(put 'get-record '(Div1) get-record)
(put 'make-file 'Div1
(lambda args
(tag (make-file args)))))
(install-Div1-Package)
(define (make-record name address salary)
((get 'make-record 'Div1) name address salary))
(define record1 (make-record 'Sam 'Parnell 100))
(define record2 (make-record 'Tom 'Edward 1000))
(define record3 (make-record 'Rob 'Hanbury 500))
(define record4 (make-record 'Andy 'Springwood 500))
record1
(define (make-file . records)
(get 'make-file 'Div1) records)
(define file1 (make-file record1 record2 record3 record4))
file1
You forgot to actually call the make-file procedure:
(define (make-file . records)
(get 'make-file 'Div1) ; retrieves the procedure, does nothing with it
records) ; return the same input list
Also, because you want to take an arbitrary number of arguments you need to apply it; this should work:
(define (make-file . records)
(apply (get 'make-file 'Div1) records))

How to call function within a function to get price of a list?

I'm new to scheme and I'm trying to create a function that uses another function to get the price of a list.
I have the list:
(define-struct store(id desc price))
(define master (list
(make-store 1 'milk 2.50)
(make-store 2 'meat 3.29)
(make-store 3 'eggs 1.99)
(make-store 4 'cereal 2.99)
(make-store 5 'bread 2.79)
(make-store 6 'soda 1.29)
(make-store 7 'water 4.99)))
And the funtcion that looks in that list to find elements:
(define (lookup lst id)
(cond ((null? lst) #f)
((= (store-id (car lst)) id)
(list (store-id (car lst))
(store-desc (car lst))
(store-price (car lst))))
(else (lookup (cdr lst) id))))
How would i go about calling this function in another function to get the price to be printed alone? Am i wrong in thinking i can't do so without modifying the lookup function? Can someone walk me through this?
Lookup returns list or #f, so before getting price, you need to check what was returned. Don't modify your code and just add this:
(define (get-only-price id)
(let ((found (lookup master id)))
(if found (third found) #f)))
(get-only-price 3)
(get-only-price 10)
Why go and change the way you return a list when you can just return the object:
(define (lookup lst id)
(cond ((null? lst) #f)
((= (store-id (car lst)) id) (car lst))
(else (lookup (cdr lst) id))))
A store is actual one sales item so I'm guessing the name is slightly off. In a function you can get the price this way:
(define (product-price id)
(let ((item (lookup master id)))
(and item (store-price item))))
In the event the id was not to be found this will also return #f. If you are sure it exists (or want it to fail when it doesn't) you can just do this:
(store-price (lookup master id))

How to write a function in scheme that finds an element in a list with car & cdr?

I'm new to scheme and i don't know how to do this. I have this list:
(define-struct store(id desc price))
(define master (list
(make-store 1 'milk 2.50)
(make-store 2 'meat 3.29)
(make-store 3 'eggs 1.99)
(make-store 4 'cereal 2.99)
(make-store 5 'bread 2.79)
(make-store 6 'soda 1.29)
(make-store 7 'water 4.99)))
and i want to create a function that will take an id and return the desc and price. But im not sure where i should start. Can someone help?
Edit: Is there a way to do this with car and cdr? I know that i can retrieve the id desc and price with (store-id),(store-desc),and (store-price) using car and cdr as needed, but how would i incorporate that into a function.
You have to use struct accessors and some function for list searching or filtering. Struct accessors are named like this: if you have struct store and want to get value of slot id, that accessor will be named store-id:
(store-id (make-store 1 'milk 2.50)) => 1
Then use filter or findf to get your result and create new list with values from two other slots.
(define (find-by-id obj id)
(let ((found (findf (lambda (e)
(= (store-id e) id))
obj)))
(if found (list (store-desc found)
(store-price found))
#false)))
(find-by-id master 2)
(find-by-id master 5)
(find-by-id master 8)
EDIT: Version with car and cdr. If list of structures is empty, #false is returned. Else function checks first struct in list. If struct-id = id, it will return list with values. Else, this function is called again, only with cdr of list.
(define (find-by-id lst id)
(cond ((null? lst) #false)
((= (store-id (car lst)) id)
(list (store-desc (car lst))
(store-price (car lst))))
(else (find-by-id (cdr lst) id))))

"not a proper list" error in DrRacket writing Scheme

I just follow the instructions at 3.3.3 of SICP to create the table.
The code I wrote just works well.
here is code_0.scm:
#lang scheme
(require rnrs/base-6)
(require rnrs/mutable-pairs-6)
(define (make-table)
(list '*table*))
(define (assoc key records)
(cond ((null? records)
false)
((equal? key (caar records))
(car records))
(else
(assoc key (cdr records)))))
(define (insert! key value table)
(let ((record (assoc key (cdr table))))
(if record
(set-cdr! record value)
(set-cdr! table
(cons (cons key value)
(cdr table)))))
'OK)
(define (lookup key table)
(let ((record (assoc key (cdr table))))
(if record
(cdr record)
false)))
(define table (make-table))
(insert! 0 0 table)
(insert! 1 1 table)
(insert! 2 2 table)
Further, I want to reference the table as a library in other file, so I write a code_1.scm.
;plus: I delete the "#lang scheme" in code_0 at this time
code_1.scm:
#lang scheme/load
(load "code_0.scm")
(define table-0 (make-table))
(insert! 0 0 table-0)
(insert! 1 1 table-0)
(insert! 2 2 table-0)
compiling error shows:
assoc: not a proper list: {{0 . 0}}
What's wrong with all of this?
Its about LIST in the Scheme, problem of DrRacket, or the version/standard of language?
The problem is that assoc is an existing function in scheme. Try renaming the function to my-assoc, and it will work as expected.

General memoization procedure in Scheme

I am trying to create a general memoization procedure in Scheme. This is what I have so far (it's almost completely the same as excercise 3.27 in the SICP book):
(define (memo proc)
(let ((table (make-table)))
(lambda (args)
(let ((prev (lookup args table)))
(or prev
(let ((result (proc args)))
(insert! args result table)
result))))))
(The 'make-table', 'insert!' and 'lookup' procedures are defined in the SICP book)
If i call this method with a procedure that only takes one argument, it works just fine. What I can't figure out how to do is get it to work with a procedure that takes 0 or several arguments.
I found this link: http://community.schemewiki.org/?memoization , but I still can't get it to work. The procedure in the link uses apply values and call-with-values, and even though I got a rough idea on how they work, I can't seem to integrate it with my procedure.
(define (mem2 proc)
(let ((table (make-table)))
(lambda args
(let ((prev (lookup args table)))
(or prev
(call-with-values
(lambda () (apply proc args))
(lambda (result)
(insert! args result table)
result)))))))
This is my try on the procedure from the link, using a list. It's almost working, but if I have a procedure that takes several arguments, it will compute it several times. Let's say I pass a random procedure the arguments 1 2 3 4. It will save 1 2 3 4 in the table, but not the given results for 1, 2, 3 and 4 seperately. I guess my error is where I do the lookup, since I pass the whole list at once.
EDIT: added testprocedure that mem2 does not work correctly with.
(define (add . args)
(display "computing add of ")
(display args) (newline)
(if (null? args)
0
(+ (car args) (apply add (cdr args)))))
It will save in the lookup table the whole 'args'. So if I have:
(define add (mem2 add))
(add 2 3 4)
computing add of (2 3 4)
computing add of (3 4)
computing add of (4)
9
(add 3)
computing add of (3)
(define (make-table)
(vector '()))
(define (insert! key val t)
(vector-set! t 0 (cons (cons key val) (vector-ref t 0))))
(define (lookup key t)
(let ([result (assoc key (vector-ref t 0))])
(and result (cdr result))))
(define (mem2 proc)
(let ((table (make-table)))
(lambda args
(let ((prev (lookup args table)))
(or prev
(let ([result (apply proc args)])
(insert! args result table)
result))))))
(define (plus x y)
(display (list "Computing sum of: " x y))
(newline)
(+ 1 2))
(define memo-plus (mem2 plus))
(memo-plus 1 2)
(memo-plus 1 2)
Output:
(Computing sum of: 1 2)
3
3
Adding:
(define (add . args)
(display "computing add of ")
(display args) (newline)
(if (null? args)
0
(+ (car args) (apply add (cdr args)))))
(define memo-add (mem2 add))
(memo-add 1 2 3 4)
(memo-add 1 2 3 4)
Gives the output:
computing add of (1 2 3 4)
computing add of (2 3 4)
computing add of (3 4)
computing add of (4)
computing add of ()
10
10
Since nothing was printed before the last 10, the example
show that the result was memoized.

Resources