hey so im trying to make a function in lisp which takes in three parameters, a list of runners, a name and a medal type. The list of runners looks like the following:
((bolt ((gold 4)(silver 2)))
(farah ((gold 3)(silver 1)(bronze 1)))
(ottey ((bronze 3))))
I'm trying to update the type and number of medals each runner has e.g. if I wanted bolt to have 4 gold medals then I could use this function to update the list accordingly. I am very new to lisp and I am struggling to do this, I've tried looping through the list using dolist() but I'm struggling with the logic behind it. how would I go about doing this ?
(defun update (type name list)
(setf medal (get-runner(name *runner)) )
(if ((assoc ‘medal medals) != nil) ;
(setf count (assoc ‘medal medals)+1)
(new-list (assoc ‘medal medals) count)
So, first of all let's call these lists of ((key value) ...) mlists (for 'medal list' if you like): they are in fact association lists (alists), but association lists are normally of the form ((key . value) ...), so I wanted another name.
Let's write a general function update-mlist to update an mlist. It will:
stop if there is nothing left to do;
otherwise, if the first element of the mlist is the one it is looking for, call its updater function on the value of that element and return a new mlist;
otherwise return a new mlist with the existing first element, and the rest of the mlist updated.
Here it is:
(defun update-mlist (mlist key updater)
;; update an mlist, replacing the element with key KEY by calling
;; UPDATER on its value. An mlist is of the form ((key value) ...).
(cond
((null mlist)
;; no more to process: we're done
'())
((eql (first (first mlist)) key)
;; found it: call the updater on the value and return the new
;; mlist
(cons (list (first (first mlist))
(funcall updater (second (first mlist))))
(rest mlist)))
(t
;; didn't find it: search the rest
(cons (first mlist)
(update-mlist (rest mlist) key updater)))))
And we can try this:
> (update-mlist '((able 1) (baker 2) (charlie 2))
'charlie
(lambda (v)
(+ v 1)))
((able 1) (baker 2) (charlie 3))
OK.
So, now, let's stash the medal list in a variable so we can talk about it:
(defvar *medals* '((bolt ((gold 4)
(silver 2)))
(farah ((gold 3)
(silver 1)
(bronze 1)))
(ottey ((bronze 3)))))
What's interesting about *medals* is that its an mlist, of which the values of each element is an mlist. So the thing we're going to want to do is to use update-mlist where the updater function itself calls update-mlist to update the medal list. OK, well, we can write that:
(defun update-medals (medals person medal updater)
;; update the medal mlist for PERSON, calling UPDATER on the value
;; of the MEDAL medal
(update-mlist medals person
(lambda (medal-mlist)
(update-mlist medal-mlist
medal
updater))))
And that's it. Let's say that farah has just won a gold medal: we want to bump their gold count by 1:
> (update-medals *medals* 'farah 'gold
(lambda (count)
(+ count 1)))
((bolt ((gold 4) (silver 2)))
(farah ((gold 4) (silver 1) (bronze 1)))
(ottey ((bronze 3))))
But we have a little problem:
> (update-medals *medals* 'ottey 'gold
(lambda (count)
(+ count 1)))
((bolt ((gold 4) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3))))
Oh dear.
So, well, we can solve this: let's change update-mlist so that, if it ever gets to the end of the mlist, it provides a fallback:
(defun update-mlist (mlist key updater fallback)
;; update an mlist, replacing the element with key KEY by calling
;; UPDATER on its value. An mlist is of the form ((key value) ...).
;; If we reach the end of the list add an entry for KEY with FALLBACK
(cond
((null mlist)
;; no more to process: add the fallback
(list (list key fallback)))
((eql (first (first mlist)) key)
;; found it: call the updater on the value and return the new
;; mlist
(cons (list (first (first mlist))
(funcall updater (second (first mlist))))
(rest mlist)))
(t
;; didn't find it: search the rest
(cons (first mlist)
(update-mlist (rest mlist) key updater fallback)))))
And we can test this:
> (update-mlist '((able 1) (baker 2) (charlie 3))
'zebra
(lambda (v)
(+ v 1))
26)
((able 1) (baker 2) (charlie 3) (zebra 26))
And we need to change update-medals correspondingly:
(defun update-medals (medals person medal updater fallback)
;; update the medal mlist for PERSON, calling UPDATER on the value
;; of the MEDAL medal. If there is no entry add a fallback. If
;; there is no entry for the person add a fallback as well
(update-mlist medals person
(lambda (medal-mlist)
(update-mlist medal-mlist
medal
updater
fallback))
(list medal fallback)))
And this works:
> (update-medals *medals* 'ottey 'gold
(lambda (count)
(+ count 1))
1)
((bolt ((gold 4) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3) (gold 1))))
> (update-medals *medals* 'hercules 'gold
(lambda (count)
(+ count 100))
100)
((bolt ((gold 4) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3)))
(hercules (gold 100)))
OK, finally we can wrap this all in an award-medal function:
(defun award-medal (medals person medal &optional (number 1))
(update-medals medals person medal
(lambda (c)
(+ c number))
number))
And now
> (award-medal *medals* 'bolt 'gold)
((bolt ((gold 5) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3))))
> (award-medal *medals* 'ottey 'gold)
((bolt ((gold 4) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3) (gold 1))))
> (award-medal *medals* 'hercules 'diamond 10000)
((bolt ((gold 4) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3)))
(hercules (diamond 10000)))
Something you may have noticed is that each time I call one of these functions it is as if it's the first time: that's because they're functions they have arguments and return values, and the values they return are new structures: they don't destructively modify their arguments. This means both that they are much easier to reason about and understand, as they are what's called referentially transparent, and they can be composed easily and safely:
> (award-medal (award-medal *medals* 'bolt 'gold)
'ottey 'silver)
((bolt ((gold 5) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3) (silver 1))))
Well, we can writ a little function that does this, too:
(defun award-medals (medals award-mlist)
(if (null award-mlist)
medals
(award-medals (award-medal medals
(first (first award-mlist))
(second (first award-mlist)))
(rest award-mlist))))
And now
> (award-medals *medals*
'((bolt gold) (ottey silver) (farah bronze)))
((bolt ((gold 5) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 2)))
(ottey ((bronze 3) (silver 1))))
Two final things:
what's 'wrong' with update-mlist (both versions). What happens if you have really a huge lot of people in your mlist?
could you write a version of award-medals which didn't really care about the whole medal-awarding thing, and which would just do this trick for any function whatsoever? Would that be useful?
Related
(defun list-parser (list count)
...);;this function reads items by count from list and do some process to them.
;;i.e.convert items read from code to char, or to other things and then return it.
;;Also, the items in list should be consumed, globally.
(defmethod foo ((obj objtype-2) data-list)
(setf (slot-1 obj) (read-list data-list 1))
obj)
(defmethod foo ((obj objtype-1) data-list)
(setf (slot-1 obj) (read-list data-list 1)
(print data-list)
(slot-2 obj) (read-list data-list 2)
(print data-list)
(slot-3 obj) (foo (make-instance 'objtype-2) data-list)
(print data-list)
(slot-4 obj) (read-list data-list 3))
obj)
How to let it work like this:(read-list just works like read-byte in some way:
1.return a value read(and parsed here)
2.change the stream position(here the list)).
(let ((obj)
(data))
(setf data '(1 2 3 4 5 6 7 8)
obj (foo (make-instance 'objtype-1) data))
(print data))
>>(2 3 4 5 6 7 8)
>>(4 5 6 7 8)
>>(5 6 7 8)
>>(8)
Or rather, how do you deal with this kind of task? Do you convert list to other type?
I am not quite sure what you are after, but here is a function which creates a 'list reader' object (just a function). A list reader will let you read chunks of a list, treating it a bit like a stream.
(defun make-list-reader (l)
;; Make a list reader which, when called, returns three values: a
;; chunk of list, the length of tha chunk (which may be less than
;; how much was asked for) and the remaining length. The chunk is
;; allowed to share with L
(let ((lt l)
(len (length l)))
(lambda (&optional (n 1))
(cond
((zerop len)
(values nil 0 0))
((< len n)
(values lt len 0))
(t
(let ((it (subseq lt 0 n)))
(setf lt (nthcdr n lt)
len (- len n))
(values it n len)))))))
(defun read-from-list-reader (r &optional (n 1))
;; Read from a list reader (see above for values)
(funcall r n))
And now:
(defvar *l* (make-list-reader '(1 2 3)))
*l*
> (read-from-list-reader *l* 1)
(1)
1
2
> (read-from-list-reader *l* 2)
(2 3)
2
0
> (read-from-list-reader *l* 10)
nil
0
0
What you can't really do is write a function (not actually a function of course since it modifies its argument) which works like this while modifying its argument list. So you can write a function which will do this:
> (let ((l (list 1 2)))
(values (read-from-list l)
l))
(1)
(2)
which works by modifying the car and cdr of the first cons of l as you'd expect. But this can't work when there is no more to read: l is a cons and nil isn't a cons, so you can't ever make l nil with a function.
But in any case such a function is just a mass of traps for the unwary and generally horrid: for instance your example would involve modifying a literal, which isn't legal.
I'm new to lisp, and have been trying to learn Common Lisp by diving in and writing some code. I've read plenty of documentation on the subject, but it's taking a while to really sink in.
I have written a couple of macros (? and ??) for performing unit tests, but I'm having some difficulty. The code is at the end of the post, to avoid cluttering the actual question.
Here is an example of usage:
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3)
(= (+ 1 2 3) 6)
(= (+ -1 -3) -4))))
And an example of output:
[Arithmetic tests]
[Addition]
(PASS) '(= (+ 1 2) 3)'
(PASS) '(= (+ 1 2 3) 6)'
(PASS) '(= (+ -1 -3) -4)'
Results: 3 tests passed, 0 tests failed
Now, the existing code works. Unfortunately, the (? ...) macro is ugly, verbose, resistant to change - and I'm pretty sure also badly structured. For example, do I really have to use a list to store pieces of output code and then emit the contents at the end?
I'd like to modify the macro to permit description strings (or symbols) to optionally follow each test, whereupon it would replace the test literal in the output, thus:
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3) "Adding 1 and 2 results in 3"
(= (+ 1 2 3) 6)
(= (+ -1 -3) -4))))
Output:
[Arithmetic tests]
[Addition]
(PASS) Adding 1 and 2 results in 3
(PASS) '(= (+ 1 2 3) 6)'
(PASS) '(= (+ -1 -3) -4)'
But unfortunately I can't find a sensible place in the macro to insert this change. Depending on where I put it, I get errors like you're not inside a backquote expression, label is not defined or body-forms is not defined. I know what these errors mean, but I can't find a way to avoid them.
Also, I'll be wanting to handle exceptions in the test, and treat that as a failure. Currently, there is no exception handling code - the test result is merely tested against nil. Again, it is not clear how I should add this functionality.
I'm thinking that maybe this macro is over-complex, due to my inexperience in writing macros; and perhaps if I simplify it, modification will be easier. I don't really want to separate it out into several smaller macros without good reason; but maybe there's a terser way to write it?
Can anyone help me out here, please?
A complete code listing follows:
(defmacro with-gensyms ((&rest names) &body body)
`(let ,(loop for n in names collect `(,n (gensym)))
,#body))
(defmacro while (condition &body body)
`(loop while ,condition do (progn ,#body)))
(defun flatten (L)
"Converts a list to single level."
(if (null L)
nil
(if (atom (first L))
(cons (first L) (flatten (rest L)))
(append (flatten (first L)) (flatten (rest L))))))
(defun starts-with-p (str1 str2)
"Determine whether `str1` starts with `str2`"
(let ((p (search str2 str1)))
(and p (= 0 p))))
(defmacro pop-first-char (string)
`(with-gensyms (c)
(if (> (length ,string) 0)
(progn
(setf c (schar ,string 0))
(if (> (length ,string) 1)
(setf ,string (subseq ,string 1))
(setf ,string ""))))
c))
(defmacro pop-chars (string count)
`(with-gensyms (result)
(setf result ())
(dotimes (index ,count)
(push (pop-first-char ,string) result))
result))
(defun format-ansi-codes (text)
(let ((result ()))
(while (> (length text) 0)
(cond
((starts-with-p text "\\e")
(push (code-char #o33) result)
(pop-chars text 2)
)
((starts-with-p text "\\r")
(push (code-char 13) result)
(pop-chars text 2)
)
(t (push (pop-first-char text) result))
))
(setf result (nreverse result))
(coerce result 'string)))
(defun kv-lookup (values key)
"Like getf, but works with 'keys as well as :keys, in both the list and the supplied key"
(setf key (if (typep key 'cons) (nth 1 key) key))
(while values
(let ((k (pop values)) (v (pop values)))
(setf k (if (typep k 'cons) (nth 1 k) k))
(if (eql (symbol-name key) (symbol-name k))
(return v)))))
(defun make-ansi-escape (ansi-name)
(let ((ansi-codes '( :normal "\\e[00m" :white "\\e[1;37m" :light-grey "\\e[0;37m" :dark-grey "\\e[1;30m"
:red "\\e[0;31m" :light-red "\\e[1;31m" :green "\\e[0;32m" :blue "\\e[1;34m" :dark-blue "\\e[1;34m"
:cyan "\\e[1;36m" :magenta "\\e[1;35m" :yellow "\\e[0;33m"
:bg-dark-grey "\\e[100m"
:bold "\\e[1m" :underline "\\e[4m"
:start-of-line "\\r" :clear-line "\\e[2K" :move-up "\\e[1A")))
(format-ansi-codes (kv-lookup ansi-codes ansi-name))
))
(defun format-ansi-escaped-arg (out-stream arg)
(cond
((typep arg 'symbol) (format out-stream "~a" (make-ansi-escape arg)))
((typep arg 'string) (format out-stream arg))
(t (format out-stream "~a" arg))
))
(defun format-ansi-escaped (out-stream &rest args)
(while args
(let ((arg (pop args)))
(if (typep arg 'list)
(let ((first-arg (eval (first arg))))
(format out-stream first-arg (second arg))
)
(format-ansi-escaped-arg out-stream arg)
))
))
(defmacro while-pop ((var sequence &optional result-form) &rest forms)
(with-gensyms (seq)
`(let (,var)
(progn
(do () ((not ,sequence))
(setf ,var (pop ,sequence))
(progn ,#forms))
,result-form))))
(defun report-start (form)
(format t "( ) '~a'~%" form))
(defun report-result (result form)
(format-ansi-escaped t "(" (if result :green :red) `("~:[FAIL~;PASS~]" ,result) :normal `(") '~a'~%" ,form))
result)
(defmacro ? (name &body body-forms)
"Run any number of test forms, optionally nested within further (?) calls, and print the results of each test"
(with-gensyms (result indent indent-string)
(if (not body-forms)
:empty
(progn
(setf result () indent 0 indent-string " ")
(cond
((typep (first body-forms) 'integer)
(setf indent (pop body-forms))))
`(progn
(format t "~v#{~A~:*~}" ,indent ,indent-string)
(format-ansi-escaped t "[" :white ,name :normal "]~%")
(with-gensyms (test-results)
(setf test-results ())
,(while-pop (body-form body-forms `(progn ,#(nreverse result)))
(cond
( (EQL (first body-form) '?)
(push `(progn
(setf test-results (append test-results (? ',(nth 1 body-form) ,(1+ indent) ,#(nthcdr 2 body-form))))
(format t "~%")
test-results
) result)
)
(t
(push `(progn
(format t "~v#{~A~:*~}" ,(1+ indent) ,indent-string)
(report-start ',body-form)
(with-gensyms (result label)
(setf result ,body-form)
(format-ansi-escaped t :move-up :start-of-line :clear-line)
(format t "~v#{~A~:*~}" ,(1+ indent) ,indent-string)
(push (report-result result ',body-form) test-results)
test-results
)) result))))))))))
(defun ?? (&rest results)
"Run any number of tests, and print a summary afterward"
(setf results (flatten results))
(format-ansi-escaped t "~&" :white "Results: " :green `("~a test~:p passed" ,(count t results)) :normal ", "
(if (find NIL results) :red :normal) `("~a test~:p failed" ,(count NIL results))
:yellow `("~[~:;, ~:*~a test~:p not run~]" ,(count :skip results))
:brown `("~[~:;, ~:*~a empty test group~:p skipped~]" ,(count :empty results))
:normal "~%"))
For my part, the ? macro is rather technical and it's hard to follow the logic behind the formatting functions. So instead of tracking errors I'd like to suggest my own attempt, perhaps it'll be of use.
I think that actually your ?? doesn't want to evaluate anything, but rather to treat its body as individual tests or sections. If the body includes a list starting with ?, this list represents a section; other elements are test forms optionally followed by descriptions. So in my implementation ?? will be a macro, and ? will be just a symbol.
I start with wishful thinking. I suppose I can create individual tests using a function make-test-item and test sections using a function make-test-section (their implementation is unimportant for now), that I can display them using an auxiliary function display-test and compute results using the function results, which returns two values: the total number of tests and the number of passed ones. Then I'd like the code
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3) "Adding 1 and 2 results in 3"
(= (+ 1 2 3) 6)
(= (+ -1 -3) 4))
(? "Subtraction"
(= (- 1 2) 1)))
(= (sin 0) 0) "Sine of 0 equals 0")
to expand into something like
(let ((tests (list (make-test-section :header "Arithmetic tests"
:items (list (make-test-section :header "Addition"
:items (list (make-test-item :form '(= (+ 1 2) 3)
:description "Adding 1 and 2 results in 3"
:passp (= (+ 1 2) 3))
(make-test-item :form '(= (+ 1 2 3) 6)
:passp (= (+ 1 2 3) 6))
(make-test-item :form '(= (+ -1 -3) 4)
:passp (= (+ -1 -3) 4))))
(make-test-section :header "Subtraction"
:items (list (make-test-item :form '(= (- 1 2) 1)
:passp (= (- 1 2) 1))))))
(make-test-item :form '(= (sin 0) 0)
:passp (= (sin 0) 0)
:description "Sine of 0 equals 0"))))
(loop for test in tests
with total = 0
with passed = 0
do (display-test test 0 t)
do (multiple-value-bind (ttl p) (results test)
(incf total ttl)
(incf passed p))
finally (display-result total passed t)))
Here a list of tests is created; then we traverse it printing each test (0 denotes the zero level of indentation and t is as in format) and keeping track of the results, finally displaying the total results. I don't think explicit eval is needed here.
It may not be the most exquisite piece of code ever, but it seems manageable. I supply missing definitions below, they are rather trivial (and can be improved) and have nothing to do with macros.
Now we pass on to the macros. Consider both pieces of code as data, then we want a list processing function which would turn the first one into the second. A few auxiliary functions would come in handy.
The major task is to parse the body of ?? and generate the list of test to go inside the let.
(defun test-item-form (form description)
`(make-test-item :form ',form :description ,description :passp ,form))
(defun test-section-form (header items)
`(make-test-section :header ,header :items (list ,#items)))
(defun parse-test (forms)
(let (new-forms)
(loop
(when (null forms)
(return (nreverse new-forms)))
(let ((f (pop forms)))
(cond ((and (listp f) (eq (first f) '?))
(push (test-section-form (second f) (parse-test (nthcdr 2 f))) new-forms))
((stringp (first forms))
(push (test-item-form f (pop forms)) new-forms))
(t (push (test-item-form f nil) new-forms)))))))
Here parse-test essentially absorbs the syntax of ??. Each iteration consumes one or two forms and collects corresponding make-... forms. The functions can be easily tested in REPL (and, of course, I did test them while writing).
Now the macro becomes quite simple:
(defmacro ?? (&body body)
`(let ((tests (list ,#(parse-test body))))
(loop for test in tests
with total = 0
with passed = 0
do (display-test test 0 t)
do (multiple-value-bind (ttl p) (results test)
(incf total ttl)
(incf passed p))
finally (display-result total passed t))))
It captures a few symbols, both in the variable name space and in the function one (the expansion may contain make-test-item and make-test-section). A clean solution with gensyms would be cumbersome, so I'd suggest just moving all the definitions in a separate package and exporting only ?? and ?.
For completeness, here is an implementation of the test API. Actually, it's what I started coding with and proceeded until I made sure the big let-form works; then I passed on to the macro part. This implementation is fairly sloppy; in particular, it doesn't support terminal colours and display-test can't even output a section into a string.
(defstruct test-item form description passp)
(defstruct test-section header items)
(defun results (test)
(etypecase test
(test-item (if (test-item-passp test)
(values 1 1)
(values 1 0)))
(test-section (let ((items-count 0)
(passed-count 0))
(dolist (i (test-section-items test) (values items-count passed-count))
(multiple-value-bind (i p) (results i)
(incf items-count i)
(incf passed-count p)))))))
(defparameter *test-indent* 2)
(defun display-test-item (i level stream)
(format stream "~V,0T~:[(FAIL)~;(PASS)~] ~:['~S'~;~:*~A~]~%"
(* level *test-indent*)
(test-item-passp i)
(test-item-description i)
(test-item-form i)))
(defun display-test-section-header (s level stream)
(format stream "~V,0T[~A]~%"
(* level *test-indent*)
(test-section-header s)))
(defun display-test (test level stream)
(etypecase test
(test-item (display-test-item test level stream))
(test-section
(display-test-section-header test level stream)
(dolist (i (test-section-items test))
(display-test i (1+ level) stream)))))
(defun display-result (total passed stream)
(format stream "Results: ~D test~:P passed, ~D test~:P failed.~%" passed (- total passed)))
All the code is licenced under WTFPL.
(defparameter *todo* '("Conquer the world" "Bake cake"))
(defun how-many-items (list)
if (list
(1+ (how-many-items (cdr list)))
0))
(defun add-item (item)
(cons item *todo*)) ; Attempt to add an item to the todo list
(princ (how-many-items *todo*))
(princ '#\newline)
(add-item "Write a book")
(princ (how-many-items *todo*))
(princ '#\newline)
(princ (cdr *todo*))
(princ '#\newline)
I'm still learning Lisp but I can't understand why the size of the list doesn't add when I supposedly add the item "Write a book" to it, the cdr call returns "Bake Cake" and the number of items is always two.
The output is:
2
2
(Bake cake)
Your problem is that cons is non-destructive. This means that even though you're adding an item to the item to the list that *todo* contains, you're not modifying *todo*
> (defparameter x '(1 2 3))
(1 2 3)
> (cons 1 x)
(1 1 2 3)
> x
(1 2 3)
See? No modification.
Instead use push. It does modify its parameters.
> (defparameter x '(1 2 3))
(1 2 3)
> (push 1 x)
(1 1 2 3)
> x
(1 1 2 3)
You can think of push like this
(push x 1) === (setf x (cons 1 x))
In fact, it's a macro that expands to just this in some implementations.
Your output can't be real, since your function has wrong syntax.
(defun how-many-items (list)
if (list
(1+ (how-many-items (cdr list)))
0))
CL-USER 20 > (how-many-items '(1 2))
Error: The variable IF is unbound.
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.
I am not too proficient with functional style and I don't want to use any set functions, so I have a problem. I am really struggling whether I should do recursively or in a different manner.
I have a collection of pairs in a list, like so:
((4 2) (3 1) (3 2) (2 4) etc...)
In this pair '(4 2), the second element '2' tells me which other pairs it matches to, in this case '(3 2).
So, I add these two pairs together using their first element, in this case, it's '4' and '3'.
The new pair is now '(7 2). And so on for other pairs in the list too.
Finally, it should return:
((7 2) (3 1) (2 4))
I would care less about the order.
.
I already have a working function that add two different pairs. The only assumption with this function is that the pairs are matching.
Consequently, what I want to do is manipulated this list of pairs to return a list in these manners.
Examples:
take the list ((4 2) (3 1) (3 2) (2 4))
matching-pairs: '(4 2) and '(3 2)
and then return --> ((7 2) (3 1) (2 4))
take the list ((2 1) (3 2) (1 2) (5 1) (6 3))
matching-pairs: '(2 1) and '(5 1)
'(3 2) and '(1 2)
and then return --> ((7 1) (4 2) (6 3))
Thank you for your time and efforts.
Iterate over your list and store each pair's car into a list in an assoc that looks like this:
original: ((2 . 1) (3 . 2) (1 . 2) (5 . 1) (6 . 3))
new: ((1 . (2 5))
(2 . (3 1))
(3 . (6))
Then sum together all the cdrs and flip each pair to get this:
((7 . 1) (4 . 2) (6 . 3))
(defun get-pairs (alist index)
(cond
(alist
(if (= (nth 1 (car alist)) index)
(append (list (caar alist)) (get-pairs (cdr alist) index))
(get-pairs (cdr alist) index)))
((not alist)
'nil)))
(defun get-iterator (alist)
(labels
((f (alist res)
(cond
(alist
(if (member (nth 1 (car alist)) res)
(f (cdr alist) res)
(f (cdr alist) (append (cdar alist) res))))
((not alist)
res))))
(f alist 'nil)))
(defun get-value (alist)
(loop for i in (get-iterator alist)
collect (get-pairs alist i)))
(defun list-sum (alist)
(loop for i in (get-value alist)
collect (apply #'+ i)))
(defun match-value (alist)
(loop for i in (get-iterator alist)
for j in (list-sum alist)
collect (append (list j) (list i))))
(defparameter *my-list* '((2 1) (3 1) (4 2) (5 2) (8 1) (9 2) (1 3) (0 3)))
(print (match-value *my-list*))
Sorry for the messy code but that should do the trick if I understood the problem right.