I am looking to create this function that takes a number and returns a string that gives that number as an item quantity. So far, I cannot think of a way to transfer this number into a string, nor come up with a clause that can change the grammar from 1 item to 2 item(s).
(check-expect (package-quantity 1) "1 item")
(check-expect (package-quantity 2) "2 items")
(define (package-quantity q)
(
When producing quantities for the human reader, there could also be special cases:
;language: Advanced Student
(check-expect (package-quantity 1) "1 item")
(check-expect (package-quantity 2) "1 pair")
(check-expect (package-quantity 3) "3 items")
(: package-quantity (Natural -> String))
(define (package-quantity q)
;; produce description of quantity, with special cases
(cond
[(zero? q) "nothing" ]
[(= q 2) "1 pair" ]
[(= q 12) "1 dozen" ]
[else (string-append
(number->string q)
(cond
[(= q 1) " item" ]
[else " items" ])) ]))
Related
I am trying to concatenate all elements in the list argument into a single list.
I have this code:
(define (concatenate . lsts)
(let rec ([l lsts]
[acc '()])
(if (empty? l)
acc
(rec (cons (list* l)
acc)))))
An example of output is here:
> (concatenate '(1 2 3) '(hi bye) '(4 5 6))
'(1 2 3 hi bye 4 5 6)
But I keep getting this error:
rec: arity mismatch;
the expected number of arguments does not match the given number
expected: 2
given: 1
Can someone please explain this?
Another answer explains the OP error,
and shows how the code can be fixed using append.
But there could be reasons for append to be disallowed in this assignment
(of course, it could be replaced with, for example, an inner "named let" iteration).
This answer will present an alternative approach and describe how it can be derived.
#lang racket
(require test-engine/racket-tests)
(define (conc . lols) ;; ("List of Lists" -> List)
;; produce (in order) the elements of the list elements of lols as one list
;; example: (conc '(1 2 3) '(hi bye) '(4 5 6)) => '(1 2 3 hi bye 4 5 6)
(cond
[(andmap null? lols) empty ] ;(1) => empty result
[else
(cons (if (null? (car lols)) ;(2) => head of result
(car (apply conc (cdr lols)))
(caar lols))
(apply conc ;(3) => tail of result
(cond
[(null? (car lols))
(list (cdr (apply conc (cdr lols)))) ]
[(null? (cdar lols))
(cdr lols) ]
[else
(cons (cdar lols) (cdr lols)) ]))) ]))
(check-expect (conc '() ) '())
(check-expect (conc '() '() ) '())
(check-expect (conc '(1) ) '(1))
(check-expect (conc '() '(1) ) '(1))
(check-expect (conc '() '(1 2) ) '(1 2))
(check-expect (conc '(1) '() ) '(1))
(check-expect (conc '(1) '(2) ) '(1 2))
(check-expect (conc '(1 2) '(3 4) ) '(1 2 3 4))
(check-expect (conc '(1 2 3) '(hi bye) '(4 5 6)) '(1 2 3 hi bye 4 5 6))
(test)
Welcome to DrRacket, version 8.6 [cs].
Language: racket, with debugging; memory limit: 128 MB.
All 8 tests passed!
>
How was this code derived?
"The observation that program structure follows data structure is a key lesson in
introductory programming" [1]
A systematic program design method can be used to derive function code from the structure
of arguments. For a List argument, a simple template (natural recursion) is often appropriate:
(define (fn lox) ;; (Listof X) -> Y ; *template*
;; produce a Y from lox using natural recursion ;
(cond ;
[(empty? lox) ... ] #|base case|# ;; Y ;
[else (... #|something|# ;; X Y -> Y ;
(first lox) (fn (rest lox))) ])) ;
(Here the ...s are placeholders to be replaced by code to create a particular list-argumented
function; eg with 0 and + the result is (sum list-of-numbers), with empty and cons it's
list-copy; many list functions follow this pattern. Racket's "Student Languages" support
placeholders.)
Gibbons [1] points out that corecursion, a design recipe based on result structure, can also
be helpful, and says:
For a structurally corecursive program towards lists, there are three questions to ask:
When is the output empty?
If the output isn’t empty, what is its head?
And from what data is its tail recursively constructed?
So for simple corecursion producing a List result, a template could be:
(define (fn x) ;; X -> ListOfY
;; produce list of y from x using natural corecursion
(cond
[... empty] ;(1) ... => empty
[else (cons ... ;(2) ... => head
(fn ...)) ])) ;(3) ... => tail data
Examples are useful to work out what should replace the placeholders:
the design recipe for structural recursion calls for examples that cover all possible input variants,
examples for co-programs should cover all possible output variants.
The check-expect examples above can be worked through to derive (1), (2), and (3).
[1] Gibbons 2021 How to design co-programs
Assuming you are allowed to call append, for simplicity. You have
(define (concatenate . lsts)
(let rec ([l lsts]
[acc '()])
(if (empty? l)
acc
(rec (cons (list* l) ; only ONE
acc) ; argument
))))
calling rec with only one argument. I have added a newline there so it becomes more self-evident.
But your definition says it needs two. One way to fix this is
(define (conc . lsts)
(let rec ([ls lsts]
[acc '()])
(if (empty? ls)
acc
(rec (cdr ls) ; first argument
(append acc (car ls)) ; second argument
))))
Now e.g.
(conc (list 1 2) (list 3 4))
; => '(1 2 3 4)
I used append. Calling list* doesn't seem to do anything useful here, to me.
(edit:)
Using append that way was done for simplicity. Repeatedly appending on the right is actually an anti-pattern, because it leads to quadratic code (referring to its time complexity).
Appending on the left with consequent reversing of the final result is the usual remedy applied to that problem, to get the linear behavior back:
(define (conc2 . lsts)
(let rec ([ls lsts]
[acc '()])
(if (empty? ls)
(reverse acc)
(rec (cdr ls)
(append (reverse (car ls))
acc)))))
This assumes that append reuses its second argument and only creates new list structure for the copy of its first.
The repeated reverses pattern is a bit grating. Trying to make it yet more linear, we get this simple recursive code:
(define (conc3 . lols)
(cond
[(null? lols) empty ]
[(null? (car lols))
(apply conc3 (cdr lols)) ]
[else
(cons (caar lols)
(apply conc3
(cons (cdar lols) (cdr lols))))]))
This would be even better if the "tail recursive modulo cons" optimization was applied by a compiler, or if cons were evaluated lazily.
But we can build the result in the top-down manner ourselves, explicitly, set-cdr!-ing the growing list's last cell. This can be seen in this answer.
Using accumulator-style recursion, write a function
one-long-string that consumes a ListOfString and produces the
concatenation of strings in the list in the order they appear in the list.
That is, (one-long-string (list "Alice" "Bob" "Eve")
returns "AliceBobEve"
Notes (added later):
Original question (quoted below) did not specify a particular Racket language, or provide an
attempted solution, or indicate what sort of issue prompted the question.
This answer will use Racket's Beginning Student
language (BSL), and develop (in exhaustive detail) a simple "natural recursion" solution, followed by
conversion to the requested "accumulator-style". BSL is used to focus attention on how using the design method
enables solution development without requiring "leaps of intuition", or familiarity with advanced language.
Readers may wonder how long it actually takes, meticulously following the design recipe with it's
signatures, check-expect tests, template copying and editing, etc, to produce the finished function.
The answer, for me, is about 10 minutes; for comparison, just "writing a function" (with signature and purpose)
and repl checking examples, takes about half that.
Using accumulator-style recursion, write a function one-long-string that consumes a ListOfString and produces the concatenation of strings in the list in the order they appear in the list. That is, (one-long-string (list "Alice" "Bob" "Eve") returns "AliceBobEve"
Get started
Using the design recipe for writing functions, one starts with a function signature and purpose; these can be copied from the question above and pasted into a Racket function definition stub in the DrRacket definitions area:
(define (one-long-string los) ;; ListOfString -> String ; *stub* ;; *signature*
;; produce the concatenation of los strings in order ; *purpose statement*
"") ; *stub body* (valid result)
The next step is to add a minimal example in the form of a check-expect:
(check-expect (one-long-string empty) "") ; *minimal example*
And then (with DrRacket's Language set to Beginning Student), Run:
The test passed!
>
Follow the recipe
Continue following the design recipe by selecting a template based on the argument type ListOfString -
copy it into the definitions area:
(define (fn lox) ;; ListOfX -> Y ; *template*
;; produce a Y from lox using natural recursion ;
(cond ;
[(empty? lox) ... ] ; ... = "base case value" ;; Y
[else (.... ; .... = "inventory fn(s)" ;; X Y -> Y
(first lox) (fn (rest lox))) ])) ;
(There is a template for "accumulator-style recursion", but this answer will start with the simplest
ListOf template. The solution will be modified to accumulator-style later.)
Edit the template, replacing the generic names with the appropriate ones for this problem, to get:
(define (one-long-string los) ;; ListOfString -> String
;; produce the concatenation of los strings in order
(cond
[(empty? los) "" ] ;; String
[else (.... ;; String String -> String
(first los) (one-long-string (rest los))) ]))
The placeholder ... has been replaced by "" by reference to the first example above.
Note that the signature of .... has been deduced from the signatures of its arguments and result.
Comment out the stub (prefix it with #;), and Run again to confirm that The test passed!.
(Always run after any change to confirm that everything still works, and fix any typos immediately.)
Add another example:
(check-expect (one-long-string (list "Alice")) "Alice")
and Run: the error message confirms that the placeholder .... needs to be replaced.
(This test could be made to pass by adding (define (arg1 x y) x) and using arg1 for ....,
but one can see that something better is likely to be needed.)
The replacement for .... will have signature String String -> String; we don't have such a
function, but checking Strings in Beginning Student
for suitable functions yields the following possibilities:
; format ;; String Any -> String ; *inventory* (all functions with
; string-append ;; String String -> String ; signature String String -> String)
Consider another example:
(check-expect (one-long-string (list "Alice" "Bob")) "AliceBob")
given "Alice" and "Bob", one can produce "AliceBob" with string-append, ie the example can be written:
(check-expect (one-long-string (list "Alice" "Bob")) (string-append "Alice" "Bob"))
This suggests that .... should be string-append; one can now add a final example:
(check-expect (one-long-string (list "Alice" "Bob" "Eve")) "AliceBobEve")
Run again, and the (non-accumulator) function is complete:
#;
(define (one-long-string los) ;; ListOfString -> String ; *stub* ;; *signature*
;; produce the concatenation of los strings in order ; *purpose statement*
"") ; *stub body* (valid result)
(check-expect (one-long-string empty) "") ; *minimal example*
(define (one-long-string los) ;; ListOfString -> String
;; produce the concatenation of los strings in order
(cond
[(empty? los) "" ]
[else (string-append
(first los) (one-long-string (rest los))) ]))
(check-expect (one-long-string (list "Alice")) "Alice")
(check-expect (one-long-string (list "Alice" "Bob")) (string-append "Alice" "Bob"))
(check-expect (one-long-string (list "Alice" "Bob" "Eve")) "AliceBobEve")
All 4 tests passed!
>
Accumulator style
As mentioned earlier, there is a template for "accumulator-style recursion", which uses
features of Advanced Student
language. Why would one use a version of the function incorporating an accumulator?
A common reason is to put the recursive call in tail position.
To explore this style, first try to edit the template to be tail-recursive:
(define (fn lox) ;; ListOfX -> Y ; *template*
;; produce a Y from lox (tail recursive) ;
(cond ;
[(empty? lox) ... ] ; result ;; Y
[else (fn (rest lox)) ; tail recursion
.... (first lox) ; (where do these go?)
])) ;
This can't be right (the placeholder .... and (first lox) don't fit) but continue by
replacing the generic names:
(define (one-long-string los) ;; ListOfString -> String
;; produce the concatenation of los strings in order
(cond
[(empty? los) ... ] ;; String
[else (one-long-string (rest los))
.... (first los) ; ?
]))
The recursive one-long-string call in the partially filled-in template is now in tail position,
with argument (rest los) so that it can deal with all the elements of los,
but to make progress in producing the result the function must do something with (first los).
Where can this be fitted in?
One way to resolve this question is to introduce an argument: with the additional argument,
one-long-string (now renamed to one-long-string-with-arg) has a place in the recursive
call to hold (first los):
(define (one-long-string-with-arg los arg) ;; ListOfString X -> String
;; produce the concatenation of los strings in order, using extra arg
(cond
[(empty? los) (... arg) ] ;; String
[else (one-long-string-with-arg (rest los) (.... arg (first los)))
]))
(define (one-long-string los) ;; ListOfString -> String
;; produce the concatenation of los strings in order
(one-long-string-with-arg los .....))
one-long-string now just calls one-long-string-with-arg, supplying ..... for arg.
Recalling the first two examples:
(check-expect (one-long-string empty) "")
(check-expect (one-long-string (list "Alice")) "Alice")
one can see that a simple replacement for ..... is "", and for (... arg)
just arg. As before, the other examples suggest string-append for .....
The rôle of arg in one-long-string-with-arg is to accumulate a "result so far" value,
so it is renamed rsf, and the complete accumulator style solution is:
#;
(define (one-long-string los) ;; ListOfString -> String ; *stub* ;; *signature*
;; produce the concatenation of los strings in order ; *purpose statement*
"") ; *stub body* (valid result)
(check-expect (one-long-string empty) "") ; *minimal example*
(define (one-long-string-acc los rsf) ;; ListOfString String -> String
;; produce the concatenation of los strings in order using rsf accumulator
(cond
[(empty? los) rsf ]
[else (one-long-string-acc (rest los)
(string-append rsf (first los))) ]))
(define (one-long-string los) ;; ListOfString -> String
;; produce the concatenation of los strings in order, using accumulator
(one-long-string-acc los ""))
(check-expect (one-long-string (list "Alice")) "Alice")
(check-expect (one-long-string (list "Alice" "Bob")) (string-append "Alice" "Bob"))
(check-expect (one-long-string (list "Alice" "Bob" "Eve")) "AliceBobEve")
All 4 tests passed!
>
(to be continued)
I am trying to make a toy system for writing documents using a macro (doc):
Example #1:
(doc id: 1
title: "First document"
"First sentence."
"Second sentence.")
Intended expansion:
(make-doc (list (list 'id: 1) (list 'title: "First document"))
(list "First sentence" "Second sentence"))
Example #2:
(let ((my-name "XYZ"))
(doc title: "Second document"
id: (+ 1 1)
"First sentence."
(string-append "My name is " my-name ".")
"Last sentence."))
Intended expansion:
(let ((my-name "XYZ"))
(make-doc (list (list 'title: "Second document") (list 'id: (+ 1 1)))
(list "First sentence."
(string-append "My name is " my-name ".")
"Last sentence.")))
More sample calls to this macro are:
(doc id: 1 "First sentence." "Second sentence.")
(doc id: 1 title: "First document" subtitle: "First subdocument"
"First sentence." "Second sentence." "Third sentence.")
First come the metadata specs, then sentences. Metadata must come before the sentences. The macro must accept any number of metadata specs.
Evaluating (doc ...) should return a string, or write the resulting text into a file. But I have not yet implemented this functionality, because I am stuck on the definition of the doc macro (which is the point of this question).
Below is my implementation of the doc macro. Vocabulary: title: "ABC" and id: 123 are called "metadata"; title: and id: are called "metadata IDs".
;;; (metadata-id? 'x:) -> #t
;;; (metadata-id? 'x) -> #f
;;; (metadata-id? "Hi!") -> #f
(define (metadata-id? x)
(cond [(symbol? x)
(let* ([str (symbol->string x)]
[last-char (string-ref str (- (string-length str) 1))])
(char=? last-char #\:))]
[else #f]))
;;; (pair-elements '(1 2 3 4 5)) -> '((1 2) (3 4) (5)).
(define (pair-elements l [acc '()] [temp null])
(cond [(and (null? l) (null? temp)) acc]
[(null? l)
(append acc (list (list temp)))]
[(null? temp)
(pair-elements (cdr l) acc (car l))]
[else
(pair-elements (cdr l)
(append acc (list (list temp (car l)))))]))
(define-syntax doc
(syntax-rules ()
((doc arg . args)
(let* ([orig-args (cons 'arg 'args)]
[metadata-bindings (takef (pair-elements orig-args)
(lambda (e)
(metadata-id? (car e))))]
[sentences (drop orig-args (* 2 (length metadata-bindings)))])
(make-doc metadata-bindings sentences)))))
(define (make-doc metadata-bindings sentences)
;; Do something ...
;; Placeholder stubs:
(writeln metadata-bindings)
(writeln sentences))
Using this implementation, evaluating example #1 prints as expected:
((id: 1) (title: "First document"))
("First sentence." "Second sentence.")
However, evaluating example #2 prints:
((id: (+ 1 1)) (title: "Second document"))
("First sentence." (string-append "My name is " my-name ".") "Last sentence.")
Apparently, the arguments were not evaluated. The expected result of example #2 is supposed to be this instead:
((id: 2) (title: "Second document"))
("First sentence." "My name is XYZ." "Last sentence.")
What is wrong with the implementation of the doc macro? How can I make the macro evaluate some of its arguments?
The reason is that you're quoting 'args, which results in it being an s-expression after macro expansion, not evaluated with function application. To fix this, you probably want make use of quasiquote. This'll also require you to rework how you specify the macro pattern. I suggest using the ... notation. Here's a sketch of what I'm describing:
(define-syntax doc
(syntax-rules ()
[(doc arg rest-args ...)
(let* ([orig-args `(arg ,rest-args ...)]
; the rest is the same
))]))
I'm not sure if this is the proper way, but I've managed to write a helper macro parse-args using syntax-case in Racket. It works like this:
(parse-args title: "Interesting document"
id: (+ 1 2)
"First sentence."
(string-append "Second sentence" "!")
"Last sentence.")
The above gets transformed into a list:
'((metadata title: "Interesting document")
(metadata id: 3)
(sentences "First sentence."
"Second sentence!"
"Last sentence."))
Implementation:
(begin-for-syntax
;;; (metadata-id? 'x:) -> #t; (metadata-id? 'x) -> #f.
(define (metadata-id? x)
(cond [(symbol? x)
(let* ([str (symbol->string x)]
[last-char (string-ref str (- (string-length str) 1))])
(char=? last-char #\:))]
[else #f])))
(define-syntax (parse-args stx)
(syntax-case stx ()
[(_ arg1 arg2) ; If no sentences.
(metadata-id? (syntax->datum (syntax arg1)))
(syntax `((metadata arg1 ,arg2)))]
[(_ arg1 arg2 rest-args ...)
(metadata-id? (syntax->datum (syntax arg1)))
(syntax `((metadata arg1 ,arg2) ,#(parse-args rest-args ...)))]
[(_ sentence rest-sentences ...)
(syntax (list `(sentences ,sentence ,rest-sentences ...)))]))
Notice how I used a "fender" ((metadata-id? (syntax->datum (syntax arg1)))). This is the crucial feature missing in syntax-rules macros, which is why I implemented the macro using syntax-case instead.
Now that I am able to parse the arguments, all that remains is to use parse-args in the definition of doc.
(define-syntax (doc stx)
(syntax-case stx ()
((doc arg rest-args ...)
(syntax (apply make-doc
(group-args (parse-args arg rest-args ...)))))))
group-args rearranges the list returned by parse-args like so:
(group-args '((metadata a: 1)
(metadata b: 2)
(sentences "ABC" "DEF")))
;; Returns:
;; '(((a: 1)
;; (b: 2))
;; ("ABC" "DEF"))
;; The car is an assoc list of metadata.
;; The cadr is the list of sentences.
Implementation:
;;; 'lst' is valid even if there is no 'metadata'.
;;; 'lst' is valid even if there is no 'sentences'.
;;; However, if there is a 'sentences', it must be the last item in the list.
(define (group-args lst [metadata-acc '()])
(define tag-name car)
(define remove-tag cdr)
(cond [(null? lst) (list metadata-acc '())]
[(eq? 'metadata (tag-name (car lst)))
(group-args (cdr lst)
(cons (remove-tag (car lst))
metadata-acc))]
[(eq? 'sentences (tag-name (car lst)))
(cons metadata-acc
(list (remove-tag (car lst))))]
[else
(error "Invalid values" lst)]))
make-doc can now be defined like this:
;;; 'metadata' is an assoc list of metadata.
;;; 'sentences' is a list of strings.
(define (make-doc metadata sentences)
;; ... create the document ...
;; Placeholder stubs:
(display "ID: ")
(displayln (cadr (assq 'id: metadata)))
(display "Title: ")
(displayln (cadr (assq 'title: metadata)))
(displayln sentences))
Usage:
(let ((my-name "XYZ"))
(doc title: "Second document"
id: (+ 1 1)
"First sentence."
(string-append "My name is " my-name ".")
"Last sentence."))
Prints:
ID: 2
Title: Second document
(First sentence. My name is XYZ. Last sentence.)
I would recommend you to use the syntax/parse library, since it's so much easier to write this kind of macro with it.
#lang racket
(require syntax/parse/define)
(define (make-doc x y) `(make-doc ,x ,y))
(begin-for-syntax
;; metadata-id? :: symbol? -> boolean?
(define (metadata-id? x)
(define str (symbol->string x))
(define len (string-length str))
;; Need to check that len > 0.
;; Otherwise, the empty identifier (||)
;; would cause an "internal" error
(and (> len 0)
(char=? (string-ref str (sub1 len)) #\:)))
(define-splicing-syntax-class key-val-class
(pattern (~seq key:id val:expr)
#:when (metadata-id? (syntax-e #'key)))))
(define-simple-macro (doc key-val:key-val-class ... xs ...)
(make-doc (list (list (quote key-val.key) key-val.val) ...)
(list xs ...)))
;;;;;;;;;;;;;;;;;
(doc id: 1
title: "First document"
"First sentence."
"Second sentence.")
;; '(make-doc ((id: 1) (title: "First document")) ("First sentence." "Second sentence."))
(let ([my-name "XYZ"])
(doc title: "Second document"
id: (+ 1 1)
"First sentence."
(string-append "My name is " my-name ".")
"Last sentence."))
;; '(make-doc
;; ((title: "Second document") (id: 2))
;; ("First sentence." "My name is XYZ." "Last sentence."))
(let ([|| 1])
(doc || 2))
;; '(make-doc () (1 2))
I have the following struct:
(define-struct my-struct (label value))
I want to change the property value of all items in my list. I want to set the value 2 in all items.
(define (change-value mylist priority)
( cond
[( empty? mylist) mylist]
[else ( cons ((struct-copy my-struct (first mylist) [value 2]) ) (change-value (rest mylist) value) )]))
)
I am trying to use struct-copy but I am getting the following error:
struct-copy: this function is not defined
Any idea why I am getting this error? Should I import any library?
It's not entirely clear what you intended your code to do. Here's a version that traverses the list of "my-struct" and sets all the "value" properties to 2:
#lang racket
(define-struct my-struct (label value) #:transparent)
(define (change-value mylist)
(for/fold ([result '()])
([s (in-list mylist)])
(cons (struct-copy my-struct s [value 2]) result)))
If I run it I get:
> (define l (list (my-struct 1 3) (my-struct 4 6) (my-struct 8 7)))
> l
(list (my-struct 1 3) (my-struct 4 6) (my-struct 8 7))
>
> (change-value l)
(list (my-struct 8 2) (my-struct 4 2) (my-struct 1 2))
You can change struct by build another struct e.g. if we want to switch element inside struct.
#lang racket
(define-struct s (s1 s2) #:transparent #:mutable)
(define (switch st)
(s (s-s2 st) (s-s1 st)))
;;; TEST
(switch (s 1 2)) ; (s 2 1)
So in here we can use map change every second element inside struct.
#lang racket
(define-struct my-struct (label value) #:transparent #:mutable)
(define (change-value->2 lst-of-struct new-value)
(map (λ (s) (my-struct (my-struct-label s) new-value))
lst-of-struct))
;;; TEST
(change-value->2 (list (my-struct 'a 1) (my-struct 'b 1) (my-struct 'c 1))
2)
Greets,
Summary
having trouble passing '(+) or '(-) as data to a cond (non evaluated). On their own, they return (+) or (-) which, as an argument returns the identity element (0).
HELP!
Background.
For the non standard scheme in the code.
In this book;
sentences are flat lists and
words are sybmols and strings.
There are three higher order functions/procedures in simply.scm, part of the library to illustrate the topic, every, keep and accumulate;
(every function data) [do this function to every element of data]
(keep predicate? data) [keep the elements of data that pass predicate? test]
(accumulate function data) [collect all data into the form of function — combine with keep to remove invalid data]
eg (accumulate + (keep number? data)) [remove non numbers then add the remaining numbers together, zero if no numbers found]
Data Flow.
Exercise 8.11 is a gpa calculator procedure. By instruction, no lambda or recursion allowed (not yet taught if read sequentially).
The first implementation I tried takes multiple grades in a single sentence and outputs individual sentences, each with a single grade. It then passes this output to a helper procedure.
If the single grade output has a + or - it is separated, for example '(a+) into '(a) and '(+) and all output is then passed to a further helper procedure.
then a cond allocates scores
a 4
b 3
c 2
d 1
e 0
+ 0.33
- -0.33
This, only worked in my head (why don't computers work like minds?) When a grade like '(a+) or '(a-) is seperated, the '(a) is processed properly but the '(+) or '(-) evaluate to the identity element (0) and fail to add to the gpa.
Is there a way to make '(+) and '(-) passable as data instead of as an expression? Alternatively, can I convert them to some arbitrary data usable in the cond before they return (0)?
The current version, a lengthy cond for each grade, works, but is hideous. Makes the implementation feel like imperative instead of functional programming.
Code.
returns the wrong gpa (doesn't add 0.33 or -0.33):
also, input type check in (gpa-helper) failed spectacularly.
(define (gpa gradesset)
(/ (accumulate + (every gpa-helper gradesset)) (count gradesset)) )
(define (gpa-helper gradewrd)
(cond ((or (< (count gradewrd) 1) (> (count gradewrd) 2)) '(Please use valid grade input))
((= (count gradewrd) 1) (gpa-allocator (keep valid-grade? gradewrd)))
((= (count gradewrd) 2) (every gpa-helper (keep valid-grade? gradewrd)))
(else '(Please check that all grades entered are valid)) ) )
(define (gpa-allocator gradeletter+-)
(cond ((equal? gradeletter+- 'a) 4)
((equal? gradeletter+- 'b) 3)
((equal? gradeletter+- 'c) 2)
((equal? gradeletter+- 'd) 1)
((equal? gradeletter+- 'e) 0)
((equal? gradeletter+- +) .33)
((equal? gradeletter+- -) (- .33))
(else 0) ) )
(define (valid-grade? gradein)
(if (member? gradein '(+ - a+ a a- b+ b b- c+ c c- d+ d d- e)) #t #f) )
redone version that returns a sentence of the individual scores. The 0 returned by '(+) and '(-) is visible here. Implements successful input type checking but introduces new problems. (accumulate + ing the result for one)
(define (gpa gradesset)
(every gpa-cleaner gradesset) )
(define (gpa-cleaner gradewrd)
(cond ((or (< (count gradewrd) 1) (> (count gradewrd) 2)) 0)
(else (every gpa-accumulator gradewrd)) ) )
(define (gpa-accumulator gradewrd)
(/ (accumulate + (every gpa-helper gradewrd)) (count gradewrd)) )
(define (gpa-helper gradewrd)
(cond ((= (count gradewrd) 1) (gpa-allocator (keep valid-grade? gradewrd)))
((= (count gradewrd) 2) (every gpa-helper (keep valid-grade? gradewrd)))
(else '(Please check that all grades entered are valid)) ) )
(define (gpa-allocator gradeletter+-)
(cond ((equal? gradeletter+- 'a) 4)
((equal? gradeletter+- 'b) 3)
((equal? gradeletter+- 'c) 2)
((equal? gradeletter+- 'd) 1)
((equal? gradeletter+- 'e) 0)
((equal? gradeletter+- +) .33)
((equal? gradeletter+- -) (- .33))
(else 0) ) )
(define (valid-grade? gradein)
(if (member? gradein '(+ - a b c d e)) #t #f) )
Using SCM version 5e7 with Slib 3b3, the additional libraries supplied with Simply Scheme (link provided under background above — simply.scm, functions.scm, ttt.scm, match.scm, database.scm) and the library where I input my answers for every exercise loaded.
If you need to pass + or - as a symbol (not as a procedure), you have to quote it first:
'+
'-
For example:
((equal? gradeletter+- '+) .33)
((equal? gradeletter+- '-) -.33)
But from the context, I don't think the gpa-allocator procedure is correct. A grade can be a or a+, the conditions imply that + or - are actual grades, which is wrong.
Maybe you should represent grades as strings and check (using string-ref) the first character in the string to determine if it's #\a, #\b, #\c, #\d, #\e and (if the string's length is greater than 1) test if the second character in the string is either #\+ or #\-. Then you can determine the appropriate value of the grade by adding the two values. Alternatively, you could pass the grade as a symbol and convert it to string. This is what I mean:
(define (gpa-allocator gradeletter+-)
(let ((grade (symbol->string gradeletter+-)))
(+ (case (string-ref grade 0)
((#\a #\A) 4)
((#\b #\B) 3)
((#\c #\C) 2)
((#\d #\D) 1)
((#\e #\E) 0)
(else 0))
(if (> (string-length grade) 1)
(case (string-ref grade 1)
((#\+) 0.33)
((#\-) -0.33)
(else 0))
0))))
Don't forget to test it:
(gpa-allocator 'A)
=> 4.0
(gpa-allocator 'A+)
=> 4.33
(gpa-allocator 'A-)
=> 3.67
Oscar is right about what's wrong, but his solution uses functions not used within the simply scheme book.
Here;s my solution from when I went through that chapter in that book
(define (gpa l-grades);;letter grades
(/ (accumulate + (every grade-value-mapper l-grades))
(count l-grades)
) )
(define (grade-value-mapper l-grade)
(let ((grade (first l-grade))
(g-mod (lambda (x)
(cond ((equal? '+ (bf l-grade))
(+ 1/3 x))
((equal? '- (bf l-grade))
(- 1/3 x))
(else x)
)) ) )
(cond ((equal? (first grade) 'a) (g-mod 4))
((equal? (first grade) 'b) (g-mod 3))
((equal? (first grade) 'c) (g-mod 2))
((equal? (first grade) 'd) (g-mod 1))
(else 0)
) ) )
Not my best work but hope it helps. The gmod you could pull out into it's own define. You would call it like so
((gmod l-grade) 4)
Or pull out more abraction
((gmod l-grade) (letter-value (first l-grade)))
I don't think the (let ... (grade ...) ...) is really doing much good. what's passed to grade-value-mapper is a single grade.
You could add the input cleaner/checker into the function grade-value-mapper as the first cond clause.