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.
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.
I am trying to make my own pattern-matching system in Scheme. To begin I am making a parser for s-expressions that divides them into tokens like this:
'(1 2 b (3 4)) => '(number number symbol (number number))
It should be noted that I have not used define-syntax before in Scheme so that may be where I am messing up. Chez Scheme throws me this error:
Exception: invalid syntax classify at line 21, char 4 of pmatch.scm. Note that the line numbers won't correspond exactly to the snippet here. Does anyone know what I am doing wrong?
(define-syntax classify
(syntax-rules ()
((_ checker replacement)
((checker (car sexpr)) (cons replacement (classify-sexpr (cdr sexpr)))))))
(define (classify-sexpr sexpr)
(cond
((null? sexpr) sexpr)
(classify list? (classify-sexpr (car sexpr)))
(classify number? 'number)
(classify symbol? 'symbol)
(else
(cons 'symbol (classify-sexpr (cdr sexpr))))))
(display (classify-sexpr '(1 (b 3) (4 5) 6)))
Your code is hugely confused. In fact it's so confused I'm not sure what you're trying to do completely: I've based my answer on what you say the classifier should produce at the start of your question.
First of all your macro refers to sexpr which has no meaning in the macro, and because Scheme macros are hygienic it will definitely not refer to the sexpr which is the argument to classify-sexpr.
Secondly you don't need a macro at all here. I suspect that you may be thinking that because you are trying to write a macro you must use macros in its construction: that's not necessarily true and often a bad idea.
Thirdly the syntax of your cond is botched beyond repair: I can't work out what it's trying to do.
Finally the list classification will never be needed: if you want to classify (1 2 3 (x)) as (number number number (symbol)) then you'll simply never reach a case where you have a list which you want to classify since you must walk into it to classify its elements.
Instead just write the obvious functions do do what you want:
(define classification-rules
;; an alist of predicate / replacement which drives classigy
`((,number? number)
(,symbol? symbol)))
(define (classify thing)
;; classify thing using classification-rules
(let loop ([tail classification-rules])
(cond [(null? tail)
'something]
[((first (first tail)) thing)
(second (first tail))]
[else
(loop (rest tail))])))
(define (classify-sexpr sexpr)
;; classify a sexpr using classify.
(cond
[(null? sexpr) '()]
[(cons? sexpr) (cons (classify-sexpr (car sexpr))
(classify-sexpr (cdr sexpr)))]
[else (classify sexpr)]))
And now
> (classify-sexpr '(1 2 3 (x 2) y))
'(number number number (symbol number) symbol)
It may be that what you really want is something which classifies (1 2 (x 2)) as (list number number (list symbol number)) say. You can do this fairly easily:
(define atomic-classification-rules
;; an alist of predicate / replacements for non-conses
`((,number? number)
(,symbol? symbol)))
(define (classify-sexpr sexpr)
(cond
[(null? sexpr) '()]
[(list? sexpr)
`(list ,#(map classify-sexpr sexpr))]
[(cons? sexpr)
`(cons ,(classify-sexpr (car sexpr))
,(classify-sexpr (cdr sexpr)))]
[else
(let caloop ([rtail atomic-classification-rules])
(cond [(null? rtail)
'unknown]
[((first (first rtail)) sexpr)
(second (first rtail))]
[else
(caloop (rest rtail))]))]))
And now
> (classify-sexpr '(1 2 3 (x 2) y))
'(list number number number (list symbol number) symbol)
> (classify-sexpr '(1 2 3 (x 2) . y))
'(cons number (cons number (cons number (cons (list symbol number) symbol))))
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.
What I would like to do is create a function that takes in a list of values and a list of characters and coalesce the corresponding characters("atoms" I think they would technically be called) into a new list.
Here is what I have so far;
#lang racket
(define (find num char)
(if (= num 1)
(car char) ;Problem here perhaps?
(find (- num 1) (cdr char))))
(define (test num char)
(if (null? num)
'("Done")
(list (find (car num) (test (cdr num) char)))))
This however gives me an error, which for the most part I understand what it is saying but I don't see what is wrong to create the error. Given the following simple test input, this is what I get
> (test '(2 1) '(a b c))
car: contract violation
expected: pair?
given: '()
Essentially the output should be '(b a) instead of the error obviously.
A little help and guidance for a new scheme user would be appreciated!
EDIT:
Here is the code that I was able to get running.
#lang racket
(define (find num char)
(cond ((empty? char) #f)
((= num 1) (car char))
(else (find (- num 1) (cdr char)))))
(define (project num char)
(if (empty? num)
'()
(cons (find (car num) char) (project (cdr num) char))))
The find procedure is mostly right (although it's basically reinventing the wheel and doing the same that list-ref does, but well...) just be careful, and don't forget to consider the case when the list is empty:
(define (find num char)
(cond ((empty? char) #f)
((= num 1) (car char))
(else (find (- num 1) (cdr char)))))
The project procedure, on the other hand, is not quite right. You should know by now how to write the recipe for iterating over a list and creating a new list as an answer. I'll give you some tips, fill-in the blanks:
(define (project num char)
(if <???> ; if num is empty
<???> ; then we're done, return the empty list
(cons ; otherwise cons
<???> ; the desired value, hint: use find
(project <???> char)))) ; and advance the recursion
That should do the trick:
(test '(2 1) '(a b c))
=> '(b a)
Better late than never:
(define (coalesce nums chars)
(map (lambda (num) (list-ref chars (- num 1))) nums))
With higher order functions
#lang racket
(define (find num chars)
(cond ((empty? chars) #f)
((= num 1) (car chars))
(else (find (- num 1) (cdr chars)))))
(define (project nums chars)
(let ((do-it (lambda (num) (find num chars))))
(map do-it nums)))
How would I recurse through nested lists?
For example, given: '((A 1 2) (B 3 4))
How would I add 2 to the second element in each nested sublist?
(defun get-p0 (points)
(loop for x from 0 to
(- (list-length points) 1) do
(+ 2 (cadr (nth x points)))
)
)
I'm not really sure why (get-p0 '((A 1 2) (B 3 4))) returns NIL.
I'd go with something like this:
(loop for (letter x y) in '((A 1 2) (B 3 4))
collect (list letter (+ 2 x) y))
The reason: it's shorter and you don't measure the length of the list in order to iterate over it (why would you do that?)
Since you ask for a recursive solution:
(defun get-p0 (lst &optional (n 0))
(if (null lst)
nil
(let ((elt1 (first lst)) (eltn (cdr lst)))
(if (listp elt1)
(cons (get-p0 elt1) (get-p0 eltn))
(cons (if (= n 1) (+ elt1 2) elt1) (get-p0 eltn (+ n 1)))))))
so
? (get-p0 '((A 1 2) (B 3 4)))
((A 3 2) (B 5 4))
and it recurses further down if necessary:
? (get-p0 '((A 0 2) ((B -4 4) (C 10 4))))
((A 2 2) ((B -2 4) (C 12 4)))
The way you put it, you can consider the problem as a basic recursion pattern: you go through a list using recursion or iteration (mapcar, reduce, etc.; dolist, loop, etc.) and apply a function to its entries. Here is a functional solution:
(defun get-p0 (points)
(mapcar #'add-2 points))
where the auxiliary function can be defined as follows:
(defun add-2 (lst)
"Add 2 to the 2nd item"
(let ((res '()))
(do ((l lst (cdr l))
(i 1 (1+ i)))
((null l) (nreverse res))
(push (if (= 2 i)
(+ 2 (car l))
(car l))
res))))
As written your 'loop' use does not return anything; thus NIL is returned. As is your code is simply iterating over x and computing something; that something isn't stored anywhere.
So, how to get your desired result? Assuming you are willing to modify each point in points, this should work:
(defun get-p0 (points)
(loop for x from 0 to (- (list-length points) 1) do
(let ((point (nth x points)))
(setf (cadr point) (+ 2 (cadr point)))))
points)