Some time ago I've written some functions for composing images with higher
order functions, see http://www.frank-buss.de/lisp/texture.html
Now I've started to translate it to Haskell (with the help of some people
on #haskell on freenode) and for me it looks much nicer than in Lisp, see
below. Is it possible to improve the Lisp version, particularly to remove
all the lambdas and funcalls and add some currying?
-- unit circle
circle x y = sqrt(x*x + y*y) < 1
-- scale
scale factor f x y = f (x/factor) (y/factor)
-- translate
translate deltaX deltaY f x y = f (x-deltaX) (y-deltaY)
-- combine two functions with an operator to a new function
makeCombinator op f1 f2 x y = op (f1 x y) (f2 x y)
-- a ring and an example for "inline" usage of makeCombinator for xor
ring innerRadius outerRadius = makeCombinator (/=) innerCircle outerCircle
where innerCircle = scale innerRadius circle
outerCircle = scale outerRadius circle
-- makeCombinator can be used for defining a function as well
add f1 f2 = makeCombinator (||) f1 f2
-- render a function to a list of strings
render f = [[pixelToChar x y | x <- [0..39]] | y <- [0..39]]
where pixelToChar x y = if f x y then '*' else ' '
-- render a function and show it as ASCII
showImage f = putStrLn $ unlines $ render f
-- an example
theEye = add circle1 circle2 where
circle1 = translate 10 15 $ ring 5 6
circle2 = translate 15 15 $ ring 10 12
Usage: showImage theEye
*********
*************
*** ***
*** ***
** **
*** ***
********* **
**** ** **
*** ** **
** * **
** * **
** * **
** * **
** * **
*** ** **
**** ** **
********* **
*** ***
** **
*** ***
*** ***
*************
*********
--
Frank Buss, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
Frank Buss <··@frank-buss.de> writes:
> Is it possible to improve the Lisp version, particularly to remove
> all the lambdas and funcalls and add some currying?
>
> -- unit circle
> circle x y = sqrt(x*x + y*y) < 1
>
> -- scale
> scale factor f x y = f (x/factor) (y/factor)
>
> -- translate
> translate deltaX deltaY f x y = f (x-deltaX) (y-deltaY)
>
> -- combine two functions with an operator to a new function
> makeCombinator op f1 f2 x y = op (f1 x y) (f2 x y)
>
> -- a ring and an example for "inline" usage of makeCombinator for xor
> ring innerRadius outerRadius = makeCombinator (/=) innerCircle outerCircle
> where innerCircle = scale innerRadius circle
> outerCircle = scale outerRadius circle
>
> -- makeCombinator can be used for defining a function as well
> add f1 f2 = makeCombinator (||) f1 f2
>
> -- render a function to a list of strings
> render f = [[pixelToChar x y | x <- [0..39]] | y <- [0..39]]
> where pixelToChar x y = if f x y then '*' else ' '
>
> -- render a function and show it as ASCII
> showImage f = putStrLn $ unlines $ render f
>
> -- an example
> theEye = add circle1 circle2 where
> circle1 = translate 10 15 $ ring 5 6
> circle2 = translate 15 15 $ ring 10 12
>
> Usage: showImage theEye
>
>
>
> *********
> *************
> *** ***
> *** ***
> ** **
> *** ***
> ********* **
> **** ** **
> *** ** **
> ** * **
> ** * **
> ** * **
> ** * **
> ** * **
> *** ** **
> **** ** **
> ********* **
> *** ***
> ** **
> *** ***
> *** ***
> *************
> *********
>
After this general purpose preamble
(defmacro define-namespace (namespace operator)
`(defmacro ,namespace (names &body code)
(flet ((make-macro-def(name)
`(,name (&rest args) `(,',',operator ,',name ,@args))))
`(macrolet ,(mapcar #'make-macro-def names) ,@code))))
(define-namespace with-functions funcall)
(defmacro defcurry (name primary-lambda-list
secondary-lambda-list
&body code)
`(defun ,name ,primary-lambda-list
(lambda ,secondary-lambda-list ,@code)))
I continue by writing
(defun show-image (f)
(format t "~&~{~A~%~}" (render f)))
(defun render (f)
"Build list of strings to visualise f"
(loop for y below 40
collect (coerce (loop for x below 40
collect (if (funcall f x y)
#\*
#\Space))
'string)))
(defun circle (x y)
(< (+ (expt x 2)
(expt y 2))
1))
(defcurry scale (factor f)(x y)
(funcall f (/ x factor) (/ y factor)))
(defcurry translate (dx dy f)(x y)
(funcall f (- x dx) (- y dy)))
(defcurry combine (op f g)(x y)
(with-functions (op f g)
(op (f x y)(g x y))))
(defun ring (inner-radius outer-radius)
(combine (complement #'eql)
(scale inner-radius #'circle)
(scale outer-radius #'circle)))
(defun add (f g)
(combine (lambda(a b)(or a b)) f g))
(defun the-eye ()
(let ((pupil (translate 10 15 (ring 5 6)))
(ball (translate 15 15 (ring 10 12))))
(add pupil ball)))
and obtain
CL-USER> (show-image (the-eye))
*********
*************
*** ***
*** ***
** **
*** ***
********* **
**** ** **
*** ** **
** * **
** * **
** * **
** * **
** * **
*** ** **
**** ** **
********* **
*** ***
** **
*** ***
*** ***
*************
*********
Alan Crowe
Edinburgh
Scotland
On Aug 5, 9:11 am, Alan Crowe <····@cawtech.freeserve.co.uk> wrote:
> (defmacro define-namespace (namespace operator)
> `(defmacro ,namespace (names &body code)
> (flet ((make-macro-def(name)
> `(,name (&rest args) `(,',',operator ,',name ,@args))))
> `(macrolet ,(mapcar #'make-macro-def names) ,@code))))
>
> (define-namespace with-functions funcall)
Cute! But I note that you used `with-functions' only in one place;
and the expansion of `defcurry' is quite straightforward. So while
your prelude definitely makes the code prettier, it wouldn't have been
that bad without it (only changed definitions shown):
> (defun scale (factor f)
> (lambda (x y) (funcall f (/ x factor) (/ y factor))))
>
> (defun translate (dx dy f)
> (lambda (x y) (funcall f (- x dx) (- y dy))))
>
> (defun combine (op f g)
> (lambda (x y) (funcall op (funcall f x y) (funcall g x y))))
Again, I'm not taking issue with what you were trying to do with your
prelude -- just pointing out that high-level macrology was not
required to write acceptable code.
-- Scott
From: Edward Dodge
Subject: Re: how to make this more elegant in Lisp
Date:
Message-ID: <m2bqdlqkdp.fsf@gmail.com>
Scott Burson <········@gmail.com> writes:
> On Aug 5, 9:11 am, Alan Crowe <····@cawtech.freeserve.co.uk> wrote:
>
>> (defmacro define-namespace (namespace operator)
>> `(defmacro ,namespace (names &body code)
>> (flet ((make-macro-def(name)
>> `(,name (&rest args) `(,',',operator ,',name ,@args))))
>> `(macrolet ,(mapcar #'make-macro-def names) ,@code))))
>>
>> (define-namespace with-functions funcall)
>
> Cute! But I note that you used `with-functions' only in one place;
> and the expansion of `defcurry' is quite straightforward. So while
> your prelude definitely makes the code prettier, it wouldn't have been
> that bad without it (only changed definitions shown):
Perhaps you didn't get it, but this curry/de-lambda-fying step was part
of the original request:
Frank Buss <··@frank-buss.de> writes:
> Is it possible to improve the Lisp version, particularly to remove
> all the lambdas and funcalls and add some currying?
--
Edward Dodge
Scott Burson <········@gmail.com> writes:
> On Aug 5, 9:11 am, Alan Crowe <····@cawtech.freeserve.co.uk> wrote:
>
> > (defmacro define-namespace (namespace operator)
> > `(defmacro ,namespace (names &body code)
> > (flet ((make-macro-def(name)
> > `(,name (&rest args) `(,',',operator ,',name ,@args))))
> > `(macrolet ,(mapcar #'make-macro-def names) ,@code))))
> >
> > (define-namespace with-functions funcall)
>
> Cute! But I note that you used `with-functions' only in one place;
> and the expansion of `defcurry' is quite straightforward. So while
> your prelude definitely makes the code prettier, it wouldn't have been
> that bad without it (only changed definitions shown):
I think that define-namespace and defcurry are widely
useful. For example the inner loop of a matrix multiply for
a general ring looks like this
(setf acc
(funcall sum
acc
(funcall prod
(aref a i j)
(aref b j k))))
after
(define-namespace with-functions funcall)
(define-namespace with-arrays aref)
we can wrap this code to make it pretty
(with-functions (sum prod)
(with-arrays (a b c)
...
(setf acc (sum acc (prod (a i j) (b j k))))
...))
In general purpose code the funcall's and aref's are useful
pointers to what is going on, but once you get stuck into
particular application areas in which the fact the this is a
function and that is an array is already at the front of the
readers consciousness, the funcall's and the aref's clutter
more than they remind.
Alan Crowe
Edinburgh
Scotland
Alan Crowe wrote:
> After this general purpose preamble
>
> (defmacro define-namespace (namespace operator)
> `(defmacro ,namespace (names &body code)
> (flet ((make-macro-def(name)
> `(,name (&rest args) `(,',',operator ,',name ,@args))))
> `(macrolet ,(mapcar #'make-macro-def names) ,@code))))
>
> (define-namespace with-functions funcall)
>
> (defmacro defcurry (name primary-lambda-list
> secondary-lambda-list
> &body code)
> `(defun ,name ,primary-lambda-list
> (lambda ,secondary-lambda-list ,@code)))
thanks, that's much nicer than a na�ve Lisp translation. But it was just a
warmup, I've enhanced the Haskell version:
http://www.frank-buss.de/haskell/OlympicRings2.hs.txt
http://www.frank-buss.de/haskell/OlympicRings2.png
Maybe some interesting things to implement in Lisp: Currying for anonymous
functions, zip, the "." operator and the Lisp way how to do makeCombinator
and "foldr (.) id".
--
Frank Buss, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de