I'm just playing around with scheme/lisp and was thinking about how I would right my own definition of average. I'm not sure how to do some things that I think are required though.
define a procedure that takes an arbitrary number of arguments
count those arguments
pass the argument list to (+) to sum them together
Does someone have an example of defining average? I don't seem to know enough about LISP to form a web search that gets back the results I'm looking for.
The definition would be a very simple one-liner, but without spoiling it, you should look into:
a "rest" argument -- this (define (foo . xs) ...xs...) defines foo as a function that takes any number of arguments and they're available as a list which will be the value of xs.
length returns the length of a list.
apply takes a function and a list of values and applies the function to these values.
When you get that, you can go for more:
see the foldl function to avoid applying a list on a potentially very big list (this can matter in some implementations where the length of the argument list is limited, but it wouldn't make much difference in Racket).
note that Racket has exact rationals, and you can use exact->inexact to make a more efficient floating-point version.
And the spoilers are:
(define (average . ns) (/ (apply + ns) (length ns)))
Make it require one argument: (define (average n . ns) (/ (apply + n ns) (add1 (length ns))))
Use foldl: (define (average n . ns) (/ (foldl + 0 (cons n ns)) (add1 (length ns))))
Make it use floating point: (define (average n . ns) (/ (foldl + 0.0 (cons n ns)) (add1 (length ns))))
In Common Lisp, it looks like you can do:
(defun average (&rest args)
(when args
(/ (apply #'+ args) (length args))))
although I have no idea if &rest is available on all implementations of Lisp. Reference here.
Putting that code into GNU CLISP results in:
[1]> (defun average (&rest args)
(when args
(/ (apply #'+ args) (length args))))
AVERAGE
[2]> (average 1 2 3 4 5 6)
7/2
which is 3.5 (correct).
Two versions in Common Lisp:
(defun average (items)
(destructuring-bind (l . s)
(reduce (lambda (c a)
(incf (car c))
(incf (cdr c) a)
c)
items
:initial-value (cons 0 0))
(/ s l)))
(defun average (items &aux (s 0) (l 0))
(dolist (i items (/ s l))
(incf s i)
(incf l)))
In Scheme, I prefer using a list instead of the "rest" argument because rest argument makes implementing procedures like the following difficult:
> (define (call-average . ns)
(average ns))
> (call-average 1 2 3) ;; => BANG!
Packing arbitrary number of arguments into a list allows you to perform any list operation on the arguments. You can do more with less syntax and confusion. Here is my Scheme version of average that take 'n' arguments:
(define (average the-list)
(let loop ((count 0) (sum 0) (args the-list))
(if (not (null? args))
(loop (add1 count) (+ sum (car args)) (cdr args))
(/ sum count))))
Here is the same procedure in Common Lisp:
(defun average (the-list)
(let ((count 0) (sum 0))
(dolist (n the-list)
(incf count)
(incf sum n))
(/ sum count)))
In Scheme R5RS:
(define (average . numbers)
(/ (apply + numbers) (length numbers)))
Related
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 am new in Lisp and i need some help.
I need to simplify next expressions:
from (+ (+ A B) C) to (+ A B C)
and from (- (- A B) C) to (- A B C).
If you could help me with one of them I'll understand how i need to do this to the next one.
Thanks a lot.
Assuming you have an input that matches this pattern, (+ e1 ... en), you want to recursively simplify all e1 to en, which gives you s1, ..., sn, and then extract all the si that start with a + to move their arguments one level up, to the simplified expression you are building.
An expression e matches the above pattern if (and (consp e) (eq '+ (car e))).
Then, all the ei are just given by the list that is (cdr e).
Consider the (+) case, how could you simplify it?
To apply a function f to a list of values, call (mapcar #'f list).
To split a list into two lists, based on a predicate p, you might use a loop:
(let ((sat nil) (unsat nil))
(dolist (x list (values sat unsat))
(if (funcall predicate x)
(push x sat)
(push x unsat))))
There is a purely functional way to write this, can you figure it out?
Here is a trivial simplifier written in Racket, with an implementation of a rather mindless simplifier for +. Note that this is not intended as anything serious: it's just what I typed in when I was thinking about this question.
This uses Racket's pattern matching, probably in a naïve way, to do some of the work.
(define/match (simplify expression)
;; simplifier driver
(((cons op args))
;; An operator with some arguments
;; Note that this assumes that the arguments to operators are always
;; expressions to simplify, so the recursive level can be here
(simplify-op op (map simplify args)))
((expr)
;; anything else
expr))
(define op-table (make-hash))
(define-syntax-rule (define-op-simplifier (op args) form ...)
;; Define a simplifier for op with arguments args
(hash-set! op-table 'op (λ (args) form ...)))
(define (simplify-op op args)
;; Note the slightly arcane fallback: you need to wrap it in a thunk
;; so hash-ref does not try to call it.
((hash-ref op-table op (thunk (λ (args) (cons op args)))) args))
(define-op-simplifier (+ exprs)
;; Simplify (+ ...) by flattening + in its arguments
(let loop ([ftail exprs]
[results '()])
(if (null? ftail)
`(+ ,#(reverse results))
(loop (rest ftail)
(match (first ftail)
[(cons '+ addends)
(append (reverse addends) results)]
[expr (cons expr results)])))))
It is possible to be more aggressive than this. For instance we can coalesce runs of literal numbers, so we can simplify (+ 1 2 3 a 4) to
(+ 6 a 4) (note it is not safe in general to further simplify this to (+ 10 a) unless all arithmetic is exact). Here is a function which does this coalescing for for + and *:
(define (coalesce-literal-numbers f elts)
;; coalesce runs of literal numbers for an operator f.
;; This relies on the fact that (f) returns a good identity for f
;; (so in particular it returns an exact number). Thisis true for Racket
;; and CL and I think any Lisp worth its salt.
;;
;; Note that it's important here that (eqv? 1 1.0) is false.
;;;
(define id (f))
(let loop ([tail elts]
[accum id]
[results '()])
(cond [(null? tail)
(if (not (eqv? accum id))
(reverse (cons accum results))
(reverse results))]
[(number? (first tail))
(loop (rest tail)
(f accum (first tail))
results)]
[(eqv? accum id)
(loop (rest tail)
accum
(cons (first tail) results))]
[else
(loop (rest tail)
id
(list* (first tail) accum results))])))
And here is a modified simplifier for + which uses this. As well as coalescing it notices that (+ x) can be simplified to x.
(define-op-simplifier (+ exprs)
;; Simplify (+ ...) by flattening + in its arguments
(let loop ([ftail exprs]
[results '()])
(if (null? ftail)
(let ([coalesced (coalesce-literal-numbers + (reverse results))])
(match coalesced
[(list something)
something]
[exprs
`(+ ,#exprs)]))
(loop (rest ftail)
(match (first ftail)
[(cons '+ addends)
(append (reverse addends) results)]
[expr (cons expr results)])))))
Here is an example of using this enhanced simplifier:
> (simplify 'a)
'a
> (simplify 1)
1
> (simplify '(+ 1 a))
'(+ 1 a)
> (simplify '(+ a (+ b c)))
'(+ a b c)
> (simplify '(+ 1 (+ 3 c) 4))
'(+ 4 c 4)
> (simplify '(+ 1 2 3))
6
For yet more value you can notice that the simplifier for * is really the same, and change things to this:
(define (simplify-arith-op op fn exprs)
(let loop ([ftail exprs]
[results '()])
(if (null? ftail)
(let ([coalesced (coalesce-literal-numbers fn (reverse results))])
(match coalesced
[(list something)
something]
['()
(fn)]
[exprs
`(,op ,#exprs)]))
(loop (rest ftail)
(match (first ftail)
[(cons the-op addends)
#:when (eqv? the-op op)
(append (reverse addends) results)]
[expr (cons expr results)])))))
(define-op-simplifier (+ exprs)
(simplify-arith-op '+ + exprs))
(define-op-simplifier (* exprs)
(simplify-arith-op '* * exprs))
And now
(simplify '(+ a (* 1 2 (+ 4 5)) (* 3 4) 6 (* b)))
'(+ a 36 b)
Which is reasonably neat.
You can go further than this, For instance when coalescing numbers for an operator you can simply elide sequences of the identity for that operator: (* 1 1 a 1 1 b) can be simplified to (* a b), not (* 1 a 1 b). It may seem silly to do that: who would ever write such an expression, but they can quite easily occur when simplifying complicated expressions.
There is a gist of an elaborated version of this code. It may still be buggy.
I have to write a simple program in Lisp that multiplies a polynomial by some factor. In this example, I want to multiply (x + 5) * 5x. The answer should be 5x^2 + 25x.
When I put in ((1 1) (5 0)) (5 1)) I should get (5 2) (25 1). However, I'm getting various errors ranging from undefined operator TERM in (TERM) and bad binding form. I'm a novice at Lisp and trying to return a list as shown above. Below is my short block of code:
(defun get-coef (term)
(car term))
(defun get-power (term)
(cadr term))
(defun make-term (coef power)
(cons coef power))
(defun poly-eval (poly factor)
(if (null poly) 0
(let ((term (car poly))
(let (coef ((* (get-coef(term)) (get-coef(factor)))))
(power ((+ (cadr(term)) (cadr(factor)))))
(make-term (coef power))
(poly-eval (cdr poly) factor))))))
Any help is appreciated!!
Several problems with your code:
You are using (fun (arg1 arg2)) syntax. It should be (fun arg1 arg2). For example, you write (make-term (coef power)) but it should be (make-term coef power).
Your bindings in let are all over the place. The correct syntax is
(let ((v1 e1)
(v2 e2)
(v3 e3))
e0)
i.e. all the bindings are in one list, and each binding is a list of two elements. Note that the expressions that the variables are bound to (e1 etc.) are not wrapped in any extra layers of parentheses.
make-term doesn't use the same representation as get-power. In get-power you use cadr so you need to make sure make-term puts the power in the right position.
Your poly-eval doesn't actually combine (make-term coef power) with the recursive call to (poly-eval (cdr poly) factor), so it gets lost. You should cons the "here"-result to the "there"-result.
Your poly-eval returns 0 instead of the empty list for empty polynomials.
All in all, your code can be fixed as
(defun get-coef (term)
(car term))
(defun get-power (term)
(cadr term))
(defun make-term (coef power)
(list coef power))
(defun poly-eval (poly factor)
(if (null poly) nil
(let ((term (car poly)))
(let
((coef (* (get-coef term) (get-coef factor)))
(power (+ (get-power term) (get-power factor))))
(cons (make-term coef power)
(poly-eval (cdr poly) factor))))))
giving e.g.
(poly-eval '((1 1) (5 0)) '(5 1))
resulting in
((5 2) (25 1))
Your make-term uses CONS but your get-power takes the CADR:
(defun get-power (term) (cadr term))
(defun make-term (coef power) (cons coef power))
You prolly wanted (list coef power).
(cons 'c 'p) returns (c . p), not (c p).
Now your get-power goes for CADR, the CAR of the CDR, but the CDR is 'p.
Your inputs are lists of coeff and power eg (5 1), so it seems the only problem is in your make-term.
Or you can turn around and be consistent with (( 5 . 1)(5 . 0) and then change get power to be (cdr term).
Another way:
(defun mult(term factor)
(list (* (first term) (first factor)) (+ (second term) (second factor))))
(defun polyeval(poly factor)
(cond
((null poly) nil)
(t (cons (mult (first poly) factor) (polyeval (rest poly) factor)))))
Note: first=car, rest=cdr, second=cadr
I've attempted to solve Euler Problem 2 with the following tail recursive functions:
(defun fib (num)
(labels ((fib-helper (num a b)
(cond ((or (zerop num)
(eql num 1))
a)
(t (fib-helper (decf num)
(+ a b)
a)))))
(fib-helper num 1 1)))
(defun sum-even-fib (max)
(labels ((helper (sum num)
(cond ((oddp num) (helper sum (decf num)))
((zerop num) sum)
(t (helper (+ sum (fib num))
(decf num))))))
(helper 0 max)))
Now, when I try to print the result using the function
(defun print-fib-sum (max dir file)
(with-open-file
(fib-sum-str
(make-pathname
:name file
:directory dir)
:direction :output)
(format fib-sum-str "~A~%" (sum-even-fib max))))
with a max value of 4000000, I get the error
("bignum overflow" "[Condition of type SYSTEM::SIMPLE-ARITHMETIC-ERROR]" nil)
from *slime-events*. Is there any other way to handle the number and print to the file?
First, a few small issues:
Use time instead of top.
Common Lisp standard does not require tail recursion optimization. While many implementation do it, not all of them optimize all cases (e.g., labels).
Your algorithm is quadratic in max because it computes the nth Fibonacci number separately for all indexes. You should make it linear instead.
You are computing the sum of even-indexed numbers, not even-valued numbers.
Now, the arithmetic error you are seeing: 4,000,000th Fibonacci number is pretty large - about 1.6^4M ~ 10^835951. Its length is about 2,776,968.
Are you sure your lisp can represent bignums this big?
So I've solved Euler #2 with the following tail recursive code:
(defun rev-sum-even-fib (max-val)
(labels ((helper (sum a b)
(cond ((oddp a)
(helper sum (+ a b) a))
((> a max-val)
sum)
(t
(helper (+ sum a) (+ a b) a)))))
(helper 0 1 0)))
Here, the algorithm is linear in max and evaluates in
(time (rev-sum-even-fib 4000000))
Real time: 3.4E-5 sec.
Run time: 0.0 sec.
Space: 0 Bytes
Where I've omitted the numerical answer for obvious reasons.
Since CL does not promise that it supports TCO (for example ABCL on the JVM does not support TCO - tail call optimization), it makes sense to write it portably as a loop:
(defun rev-sum-even-fib (max-val)
(loop for a = 1 then (+ a b) and b = 0 then a
until (> a max-val)
when (evenp a) sum a))
I am a LISP newbie.
To get the running sum of a list, I am writing like --
(setf sum 0.0)
(mapcar #'(lambda(x)
(setf sum (+ sum x)) sum) values))
For example, if you give '(1 2 3 4) as input, the above code returns '(1 3 6 10) as output and so forth.
Is it possible to do the same thing (in a more elegant way) without using the global variable sum ?
(loop for x in '(1 2 3 4) sum x into y collect y)
scanl is a oneliner:
(defun scanl (f init xs)
(loop for x in xs collect (setf init (funcall f init x))))
You could use loop, like this:
(defun running-sum (xs)
(loop with sum = 0
for x in xs
collect (setf sum (+ sum x))))
(running-sum '(1 2 3 4))
It's fundamentally the same thing, but it uses a local variable instead of a global one, and might be more clear.
Alternatively, you could define a recursive function, and a wrapper function:
(defun running-sum-recursive (xs)
(running-sum-recursive2 0 xs))
(defun running-sum-recursive2 (sum xs)
(if (eq xs nil)
nil
(let ((new-sum (+ sum (car xs))))
(cons new-sum (running-sum-recursive2 new-sum (cdr xs))))))
(running-sum-recursive '(1 2 3 4))
However this seems needlessly complicated to me when loop is available.
Note that in Haskell, you could do a running sum like this:
runningSum xs = scanl1 (+) xs
runningSum [1, 2, 3, 4]
The key here is the scanl1 function. It's possible that something similar exists in Lisp (and we've very nearly written it twice now), but I haven't used Lisp in a while.
Edit: After some searching, I don't think Common Lisp includes anything quite like scanl or scanl1, so here they are:
(defun scanl (f val xs)
(loop for x in xs
collect (setf val (funcall f val x))))
(defun scanl1 (f xs)
(cons (car xs)
(scanl f (car xs) (cdr xs))))
(scanl1 #'+ '(1 2 3 4))
Edit: Thanks to huaiyuan's answer for a suggestion about how the loops could be shortened.
Or you could use higher-order functions
(define (running-sum ls)
(cdr (reverse (foldl (lambda (y xs) (cons (+ (car xs) y) xs)) '(0) ls))))
Haskell does have a rich inventory of functions for list recursion, but we've got reduce at least. Here is an elementary (i. e. without the loop magic) functional solution:
(defun running-sum (lst)
(reverse (reduce (lambda (acc x)
(cons (+ (first acc) x) acc))
(rest lst)
:initial-value (list (first lst)))))
I'm using the head of the original list as the initial value and walk through the rest of the list adding sums at the head (because it's natural to add at the head), finally reversing the list thus obtained.
One can use reduce in most cases when there's a need to traverse a sequence accumulating a value.
Here is an elementary iterative solution using the push-nreverse idiom:
(defun running-sum (lst)
(let ((sums (list (first lst))))
(dolist (x (rest lst))
(push (+ x (first sums)) sums))
(nreverse sums)))
In Scheme I would calculate the sum of the list recursively using an accumulator. Like so:
; Computes a list of intermediary results of list summation
(define list-sum
(lambda (l)
(letrec ((recsum (lambda (lst acc acclst)
(if (pair? lst)
(recsum (cdr lst) (+ acc (car lst)) (cons acc acclst))
(cons acc acclst)))))
(recsum (cdr l) (car l) '()))))
Output:
> (list-sum '(1 2 3 4))
(10 6 3 1)
> (list-sum '(2 4 6 8 10))
(30 20 12 6 2)
>
The trick to recurse over a list is to take the first element/car off each time and pass the rest/cdr. You can keep intermediary results by using an extra parameter (called an accumulator) and pass the sum in that. I've used two accumulators above: one for the last sum and one for a list of all previous sums.
I've never done anything in LISP, so I can't tell if this translates directly to your dialect(?), but it's conceptually simple and I'm sure it's doable in LISP as well.
Do ask if something is not immediately clear. It's been a while since I've used this family of languages :)