From: Christian Hofer
Subject: g-adic development homework
Date:
Message-ID: <bqqisv$psh$1@online.de>
Hi there,
as a homework in my analysis-course we should write a g-adic development
algorithm (hope that's the English name) in a computer language of choice.
As I have so much homework to do that I do not have any time left to
continue learning Lisp otherwise at the moment, I naturally decided for
Lisp.
Now, I don't plan to cheat with the homework and it gives only an
infinitesimal bonus for the exam anyway. I would just be glad to have a
review from someone who knows Lisp. (My corrector already told me, he
doesn't...)
Especially I am not content with my test algorithm, which rebuilds a
float out of the g-adic development. Isn't there a more functional way
to do it?
The homework was defined as follows:
Be g a natural number >=2. For each non-negative real number a there are
unambiguous numbers a0 in N and a1, a2, a3,... in {0, 1, ..., g-1}
with a=a0+sum(an/g^n). Write a computer program that calculates a
general g-adic development to a defined position (i.e. a1,a2,...,an).
My solution is as follows:
(defun g-adic (g a n)
(multiple-value-bind (a_0 rest) (floor a)
(cons a_0 (g-adic<1 g rest n))))
(defun g-adic<1 (g a n)
(if (zerop n)
NIL
(multiple-value-bind (a_i rest) (floor (* a g))
(cons a_i (g-adic<1 g rest (1- n))))))
Now the test function, I am not glad about:
(defun sum-g-adic (g lst)
(let ((sum 0)
(g^i 1))
(dolist (a_i lst)
(incf sum (/ a_i g^i))
(setf g^i (* g g^i)))
(float sum)))
Thank you,
Christian
christian dot hofer at gmx dot de
From: Joe Marshall
Subject: Re: g-adic development homework
Date:
Message-ID: <fzfzt630.fsf@ccs.neu.edu>
Christian Hofer <·······@gmx.de> writes:
> I would just be glad to have
> a review from someone who knows Lisp. (My corrector already told me,
> he doesn't...)
> (defun g-adic (g a n)
> (multiple-value-bind (a_0 rest) (floor a)
> (cons a_0 (g-adic<1 g rest n))))
>
> (defun g-adic<1 (g a n)
> (if (zerop n)
> NIL
> (multiple-value-bind (a_i rest) (floor (* a g))
> (cons a_i (g-adic<1 g rest (1- n))))))
Instead of increasing the divisor at each step, you can decrease
the value of A.
(defun g-adic (number base)
(if (> base number)
(list number)
(multiple-value-bind (quotient remainder) (floor number base)
(cons remainder (g-adic quotient base)))))
> Especially I am not content with my test algorithm, which rebuilds a
> float out of the g-adic development. Isn't there a more functional way
> to do it?
Yes. Recall `Horner's rule' and use REDUCE
(defun sum-g-adic (g coefficients)
(reduce (lambda (coefficient accumulator)
(+ (* accumulator g) coefficient))
coefficients
:initial-value 0
:from-end t))
To limit the number of coefficients to N, (as per the original
problem), compute the full list then rebuild the first coefficient.
From: Christian Hofer
Subject: Re: g-adic development homework
Date:
Message-ID: <bqsems$e7f$1@online.de>
Joe Marshall schrieb:
>>Especially I am not content with my test algorithm, which rebuilds a
>>float out of the g-adic development. Isn't there a more functional way
>>to do it?
>
>
>
> Yes. Recall `Horner's rule' and use REDUCE
>
> (defun sum-g-adic (g coefficients)
> (reduce (lambda (coefficient accumulator)
> (+ (* accumulator g) coefficient))
> coefficients
> :initial-value 0
> :from-end t))
This is the solution I was looking for. Of course, for my needs, I have
to replace the (* accumulator g) by a (/ accumulator g).
Thank you for your answers!
Chris
Christian Hofer wrote:
> Hi there,
>
> as a homework in my analysis-course we should write a g-adic development
> algorithm (hope that's the English name) in a computer language of choice.
>
> As I have so much homework to do that I do not have any time left to
> continue learning Lisp otherwise at the moment, I naturally decided for
> Lisp.
>
> Now, I don't plan to cheat with the homework and it gives only an
> infinitesimal bonus for the exam anyway. I would just be glad to have a
> review from someone who knows Lisp. (My corrector already told me, he
> doesn't...)
>
> Especially I am not content with my test algorithm, which rebuilds a
> float out of the g-adic development. Isn't there a more functional way
> to do it?
>
> The homework was defined as follows:
> Be g a natural number >=2. For each non-negative real number a there are
> unambiguous numbers a0 in N and a1, a2, a3,... in {0, 1, ..., g-1} with
> a=a0+sum(an/g^n). Write a computer program that calculates a general
> g-adic development to a defined position (i.e. a1,a2,...,an).
>
> My solution is as follows:
>
> (defun g-adic (g a n)
> (multiple-value-bind (a_0 rest) (floor a)
> (cons a_0 (g-adic<1 g rest n))))
>
> (defun g-adic<1 (g a n)
> (if (zerop n)
> NIL
> (multiple-value-bind (a_i rest) (floor (* a g))
> (cons a_i (g-adic<1 g rest (1- n))))))
>
> Now the test function, I am not glad about:
>
> (defun sum-g-adic (g lst)
> (let ((sum 0)
> (g^i 1))
> (dolist (a_i lst)
> (incf sum (/ a_i g^i))
> (setf g^i (* g g^i)))
> (float sum)))
(defun sum-g-adic-l (g lst)
(float (loop for a_i in lst
for g^i = 1 then (* g g^i)
summing (/ a_i g^i))))
It's not any more functional under the hood, but it looks more
functional, and as Andre Agassi said, image is everything.
This works, too:
(defun sum-g-adic (g lst &optional (g^i 1)(accum 0.0))
(if lst
(sum-g-adic g (rest lst) (* g g^i) (+ accum (/ (car lst) g^i)))
accum))
kt
--
http://tilton-technology.com
Why Lisp? http://alu.cliki.net/RtL%20Highlight%20Film
Your Project Here! http://alu.cliki.net/Industry%20Application
From: Christian Hofer
Subject: Re: g-adic development homework
Date:
Message-ID: <bqset6$eis$1@online.de>
Kenny Tilton schrieb:
> Christian Hofer wrote:
>> Now the test function, I am not glad about:
>>
>> (defun sum-g-adic (g lst)
>> (let ((sum 0)
>> (g^i 1))
>> (dolist (a_i lst)
>> (incf sum (/ a_i g^i))
>> (setf g^i (* g g^i)))
>> (float sum)))
*snip*
> This works, too:
>
> (defun sum-g-adic (g lst &optional (g^i 1)(accum 0.0))
> (if lst
> (sum-g-adic g (rest lst) (* g g^i) (+ accum (/ (car lst) g^i)))
> accum))
This is really easy to read.
Is CL able to optimize the tail recursion here?
Chris
Christian Hofer <·······@gmx.de> writes:
> Kenny Tilton schrieb:
> > Christian Hofer wrote:
> >> Now the test function, I am not glad about:
> >>
> >> (defun sum-g-adic (g lst)
> >> (let ((sum 0)
> >> (g^i 1))
> >> (dolist (a_i lst)
> >> (incf sum (/ a_i g^i))
> >> (setf g^i (* g g^i)))
> >> (float sum)))
> *snip*
> > This works, too:
> > (defun sum-g-adic (g lst &optional (g^i 1)(accum 0.0))
> > (if lst
> > (sum-g-adic g (rest lst) (* g g^i) (+ accum (/ (car lst) g^i)))
> > accum))
>
> This is really easy to read.
> Is CL able to optimize the tail recursion here?
This is NOT mandated by Common-Lisp.
But the implementation named clisp does it:
(defun sum-g-adic (g lst &optional (g^i 1)(accum 0.0))
(if lst
(sum-g-adic g (rest lst) (* g g^i) (+ accum (/ (car lst) g^i)))
accum))
(disassemble 'sum-g-adic)
Disassembly of function SUM-G-ADIC
(CONST 0) = 1
(CONST 1) = 0.0
2 required arguments
2 optional arguments
No rest parameter
No keyword parameters
26 byte-code instructions:
0 L0
0 (JMPIFBOUNDP 2 L5)
3 (CONST 0) ; 1
4 (STORE 2)
5 L5
5 (JMPIFBOUNDP 1 L35)
8 (CONST 1) ; 0.0
9 (STORE 1)
10 (LOAD&JMPIFNOT 3 L38)
13 L13
13 (LOAD&PUSH 4)
14 (LOAD&CDR&PUSH 4)
16 (LOAD&PUSH 6)
17 (LOAD&PUSH 5)
18 (CALLSR&PUSH 2 56) ; *
21 (LOAD&PUSH 4)
22 (LOAD&CAR&PUSH 7)
24 (LOAD&PUSH 7)
25 (CALLSR&PUSH 1 57) ; /
28 (CALLSR&PUSH 2 54) ; +
31 (JMPTAIL 4 9 L0)
35 L35
35 (LOAD&JMPIF 3 L13)
38 L38
38 (LOAD 1)
39 (SKIP&RET 5)
#<COMPILED-CLOSURE SUM-G-ADIC>
--
__Pascal_Bourguignon__ . * * . * .* .
http://www.informatimago.com/ . * . .*
* . . /\ ). . *
Living free in Alaska or in Siberia, a . . / .\ . * .
grizzli's life expectancy is 35 years, .*. / * \ . .
but no more than 8 years in captivity. . /* o \ .
http://www.theadvocates.org/ * '''||''' .
SCO Spam-magnet: ··········@sco.com ******************
From: Joe Marshall
Subject: Re: g-adic development homework
Date:
Message-ID: <ad65or45.fsf@comcast.net>
Christian Hofer <·······@gmx.de> writes:
> Kenny Tilton schrieb:
>> Christian Hofer wrote:
>>> Now the test function, I am not glad about:
>>>
>>> (defun sum-g-adic (g lst)
>>> (let ((sum 0)
>>> (g^i 1))
>>> (dolist (a_i lst)
>>> (incf sum (/ a_i g^i))
>>> (setf g^i (* g g^i)))
>>> (float sum)))
> *snip*
>> This works, too:
>> (defun sum-g-adic (g lst &optional (g^i 1)(accum 0.0))
>> (if lst
>> (sum-g-adic g (rest lst) (* g g^i) (+ accum (/ (car lst) g^i)))
>> accum))
>
> This is really easy to read.
> Is CL able to optimize the tail recursion here?
Most of 'em can.
In Allegro, if you (declare (optimize (speed 1))) you should get tail recursion.
Alternatively you can just turn it on like this:
(setq compiler:tail-call-self-merge-switch t)
(setq compiler:tail-call-non-self-merge-switch t)
In Lispworks, (declare (optimize (debug 2))) should do it.
Alternatively, this just turns it on unconditionally everywhere in
lispworks:
(setq compiler::*debug-do-tail-merge-policy* 'true
compiler::*eliminate-tail-recursion-policy* 'true)
(compiler::update-policy-switches)
--
~jrm