Author Topic: (Challenge) Port `let' to Autolisp (Read 11126 times)

JohnK · « **on:** January 12, 2009, 11:51:53 AM »

Porting the lisp function `let' to Autolisp had me sitting there with my hands on my temples for a bit. It was a tough test of my list iteration skills.

[ http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-12.html#%_sec_1.3.2 ]

In case you cant visit the site at work here is the text from the site:

Quote

Using let to create local variables

Another use of lambda is in creating local variables. We often need
local variables in our procedures other than those that have been
bound as formal parameters. For example, suppose we wish to compute
the function

f(x,y) = x(1 +xy)^2 + y(1 - y) + (1 + xy) (1-y)

which we could also express as

a = 1 + xy
b = 1 - y
f(x,y) = xa^2 + yb + ab

In writing a procedure to compute f, we would like to include as local
variables not only x and y but also the names of intermediate
quantities like a and b. One way to accomplish this is to use an
auxiliary procedure to bind the local variables:

(define (f x y)
(define (f-helper a b)
(+ (* x (square a))
(* y b)
(* a b)))
(f-helper (+ 1 (* x y))
(- 1 y)))

Of course, we could use a lambda expression to specify an anonymous
procedure for binding our local variables. The body of f then becomes
a single call to that procedure:

(define (f x y)
((lambda (a b)
(+ (* x (square a))
(* y b)
(* a b)))
(+ 1 (* x y))
(- 1 y)))

This construct is so useful that there is a special form called let to
make its use more convenient. Using let, the f procedure could be
written as

(define (f x y)
(let ((a (+ 1 (* x y)))
(b (- 1 y)))
(+ (* x (square a))
(* y b)
(* a b))))

The general form of a let expression is

(let ((<var1> <exp1>)
(<var2> <exp2>)

(<varn> <expn>))
<body>)

which can be thought of as saying

let    <var1> have the value <exp1> and
   <var2> have the value <exp2> and

   <varn> have the value <expn>
in    <body>

The first part of the let expression is a list of name-expression
pairs. When the let is evaluated, each name is associated with the
value of the corresponding expression. The body of the let is
evaluated with these names bound as local variables. The way this
happens is that the let expression is interpreted as an alternate
syntax for

((lambda (<var1> ...<varn>)
<body>)
<exp1>

<expn>)

No new mechanism is required in the interpreter in order to provide
local variables. A let expression is simply syntactic sugar for the
underlying lambda application.

We can see from this equivalence that the scope of a variable
specified by a let expression is the body of the let. This implies
that:

* Let allows one to bind variables as locally as possible to where
* they are to be used. For example, if the value of x is 5, the
* value of the expression

(+ (let ((x 3))
(+ x (* x 10)))
x)

is 38. Here, the x in the body of the let is 3, so the value of
the let expression is 33. On the other hand, the x that is the
second argument to the outermost + is still 5.

* The variables' values are computed outside the let. This matters
* when the expressions that provide the values for the local
* variables depend upon variables having the same names as the
* local variables themselves. For example, if the value of x is 2,
* the expression

(let ((x 3)
(y (+ x 2)))
(* x y))

will have the value 12 because, inside the body of the let, x
will be 3 and y will be 4 (which is the outer x plus 2).

Sometimes we can use internal definitions to get the same effect as
with let. For example, we could have defined the procedure f above as

(define (f x y)
(define a (+ 1 (* x y)))
(define b (- 1 y))
(+ (* x (square a))
(* y b)
(* a b)))

We prefer, however, to use let in situations like this and to use
internal define only for internal procedures.

My results are:

FUNCTION: let <bindings> <body>
--------

Code: [Select]

(setq x 5)
(+ (let '((x 3))
        '(+ x (* x 10)))
 x)

==> 38

Code: [Select]

(setq x 2 y 4)
(let '((x 3)
       (y (+ x 2)))
     '(* x y))

==> 12

This was a lot of fun! Give it a try.

MP · « **Reply #1 on:** January 12, 2009, 01:22:40 PM »

Are you challenging us to define a let function? If so ...

Code: [Select]

(defun _Let ( bindings body )
    (eval
        (list
            (append '(lambda)
                (list (append (list '/) (mapcar 'car bindings)))    
                (mapcar
                   '(lambda (@) (list 'setq (car @) (cadr @)))
                    bindings
                )
                (list body)
            )    
        )       
    )
)

T.Willey · « **Reply #2 on:** January 12, 2009, 01:30:38 PM »

The second condition kind of threw me, but here is one way. Maybe I can come up with a more elegant way once my mind starts working better.

Code: [Select]

(defun Let ( varList funToDo / oValList nValList Results )
    
    (foreach i varList
        (setq oValList (cons (eval (car i)) oValList))
        (setq nValList (cons (eval (cadr i)) nValList))
    )
    (setq cnt (1- (length nValList)))
    (foreach i varList
        (set (car i) (nth cnt nValList))
        (setq cnt (1- cnt))
    )
    (setq Results (eval funToDo))
    (mapcar
        '(lambda (a b)
            (set (car a) b)
        )
        varList
        (reverse oValList)
    )
    Results
)

JohnK · « **Reply #3 on:** January 12, 2009, 01:55:52 PM »

Now that people are posting versions; here is my version.

The multiple bindings part got me. I was stumped for about a good half an hour till i finally got something i could understand on the screen. And at least a half an hour just trying to understand the function `let' itself! *lol*

I found this whole procedure a lot of fun!

Code: [Select]

(defun let ( bindings body / replace )
  ;; let
  ;; evaluate process with localized variables.
  ;;
  ;; Ported to AutoLisp By: John (Se7en) K
  ;;                        01.12.08
  ;; 
  ;; Explination of Let:
  ;; [ http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-12.html#%_sec_1.3.2 ]
  ;;
  ;; Synopsis: let <bindings> <body>
  ;;
  ;;  (let '((a (+ 1 (* x y)))
  ;;         (b (- 1 y)))
  ;;     '(+ (* x (square a))
  ;;         (* y b)
  ;;         (* a b)))
  ;;  ~~>
  ;;  ((LAMBDA nil (+ (* X (SQUARE (+ 1 (* X Y))))
  ;;  		(* Y (- 1 Y))
  ;;  		(* (+ 1 (* X Y)) (- 1 Y)))))
  ;;
  ;;  ==> Evaluated value
  ;;
  ;; EX:
  ;;  (setq x 5)
  ;;  (+ (let '((x 3))
  ;;          '(+ x (* x 10)))
  ;;   x)
  ;;  
  ;;  ==> 38
  ;;  
  ;; EX2: 
  ;;  (setq x 2 y 5)
  ;;  (let '((x 3)
  ;;         (y (+ x 2)))
  ;;       '(* x y))
  ;;  
  ;;  ==> 12
  ;;
          (defun replace (a b x)
            (if (atom x)
              (if (not (eq a x)) x b)
              (cons (replace a b (car x))
                    (replace a b (cdr x)))))
  (mapcar
    '(lambda ( x )
       (setq body (replace (car x) (cadr x) body))
       )
    bindings)

  (eval (list (list 'lambda '() body)))
)

ElpanovEvgeniy · « **Reply #4 on:** January 12, 2009, 01:58:30 PM »

Code: [Select]

(defun let-e (a b)
 (eval (list 'defun 'tmp (mapcar 'car a) b))
 (eval (cons tmp (mapcar 'cadr a)))
) ;_  defun

test:

Code: [Select]

(let-e '((x 3)) '(+ x (* x 10)))
;;==> 33

(setq x 5)
(+ (let-e '((x 3)) '(+ x (* x 10))) x)
;;==> 38

(setq x 2 y 4)
(let-e '((x 3) (y (+ x 2))) '(* x y))
;;==> 12

MP · « **Reply #5 on:** January 12, 2009, 02:04:53 PM »

Very nice Evgeniy, might want to make tmp a local.

ElpanovEvgeniy · « **Reply #6 on:** January 12, 2009, 02:08:01 PM »

Quote from: MP on January 12, 2009, 02:04:53 PM

Very nice Evgeniy, might want to make tmp a local.

Yes, it has turned out not accurately...
I am corrected:

Code: [Select]

(defun let-e (a b / f)
 (eval (list 'defun 'f (mapcar 'car a) b))
 (eval (cons f (mapcar 'cadr a)))
)

ElpanovEvgeniy · « **Reply #7 on:** January 12, 2009, 02:13:21 PM »

Variant 2
(lambda)

Code: [Select]

(defun let-e1 (a b)
 (eval (cons (eval (list 'lambda (mapcar 'car a) b)) (mapcar 'cadr a)))
)

T.Willey · « **Reply #8 on:** January 12, 2009, 02:25:06 PM »

Quote from: ElpanovEvgeniy on January 12, 2009, 02:13:21 PM

Variant 2
(lambda)

Code: [Select]
(defun let-e1 (a b) (eval (cons (eval (list 'lambda (mapcar 'car a) b)) (mapcar 'cadr a))) )

This is what I was trying to do Evgeniy, but I couldn't think of it this morning. And now looking at it, I'm not sure I could have. Thanks for showing me how my mind wanted to do it.

JohnK · « **Reply #9 on:** January 12, 2009, 02:39:01 PM »

*lol*

I had almost the same thought Evgeniy but i could not get it working.

My failed attempt.

Quote

(eval
(cons (append (list 'lambda (mapcar 'car bindings)) body)
(mapcar 'cadr bindings)))

Very cool Evgeniyl!!

Quote from: ElpanovEvgeniy on January 12, 2009, 02:13:21 PM

Variant 2
(lambda)

Code: [Select]
(defun let-e1 (a b) (eval (cons (eval (list 'lambda (mapcar 'car a) b)) (mapcar 'cadr a))) )

gile · « **Reply #10 on:** January 12, 2009, 02:40:24 PM »

Hi,

a litlle too late...

Code: [Select]

(defun let (bindings body)
  (eval
    (cons
      (list 'lambda (mapcar 'car bindings) body)
      (mapcar 'cadr bindings)
    )
  )
)

ElpanovEvgeniy · « **Reply #11 on:** January 12, 2009, 02:51:37 PM »

Quote from: gile on January 12, 2009, 02:40:24 PM

Hi,

a litlle too late...

Code: [Select]
(defun let (bindings body) (eval (cons (list 'lambda (mapcar 'car bindings) body) (mapcar 'cadr bindings) ) ) )

You managed to clean one eval!

Code: [Select]

(defun let(a b)
 (eval (cons (list 'lambda (mapcar 'car a) b) (mapcar 'cadr a)))
)

MP · « **Reply #12 on:** January 12, 2009, 03:49:59 PM »

Dam Gile, that's verbatim the last one I did. I wasted 20 minutes when I could have just looked at your posting.

Nicely done sir.

kdub_nz · « **Reply #13 on:** January 12, 2009, 07:06:39 PM »

I recall seeing a LET function in AutoLISP as part a CASE statement .. written by Tony T if I recall correctly.

Goes back a few years now though, so may be difficult to find ... unless Tony happens by and still has a copy

T.Willey · « **Reply #14 on:** January 12, 2009, 07:11:00 PM »

Quote from: kdub@wdt on January 12, 2009, 07:06:39 PM

I recall seeing a LET function in AutoLISP as part a CASE statement .. written by Tony T if I recall correctly.

Goes back a few years now though, so may be difficult to find ... unless Tony happens by and still has a copy

Correct. Just searched for it, and found it here

[ http://autocad.xarch.at/code/tanzillo/case.lsp ]

Code: [Select]

; CASE.LSP  Copyright  1991  Tony Tanzillo  All Rights Reserved
;
; (case <value> <cases> )
;
; Emulates the Common LISP (case) function.
;
; Select expressions to evaluate using a matching key value.
;
; Expanded syntax:
;
;    (case <value> '( ( <test value1> <result expr>...)
;                     ( <test value2> <result expr>...)
;                     ( <test valueN> <result expr>...)
;                   )
;    )
;
; <testvalueN> is the selection key for the expressions that proceed it.
; It can be an atom or a list.  If <value> is equal to a <testvalue> or
; is a member of a <testvalue>, then all expressions which proceed the
; matching <testvalue> will in-turn be evaluated, and the result of the
; last result expression will be returned by (case).
;
; The test value of each case matches the <value> argument if it is EQUAL
; to <value>, or if the test value is a list which <value> is a MEMBER of.
;
; If a clause whose test value matches <value> has no proceeding result
; expressions, then CASE returns the test value.
;
; The symbol T can be used as the test value in the last clause to cause
; it to act as a 'default' clause, and the result expressions which follow
; it will be evaluated if no preceeding test value matches <value>.
;
; EQUAL tests take precedence over MEMBER tests.  Or, if one test value is
; EQUAL to <value> and another test value is a list that <value> is a MEMBER
; of, then the result expressions of the test value which is EQUAL to <value>
; take precedence and is selected.
;
; Example:
;
;    [convert the value of an integer into some string]
;
;    (setq num 3)
;
;    (setq digit (case num '(  (1 "one")
;                              (2 "two")
;                              (3 "three")  ; <- num = 3, case selects this
;                              (4 "four")
;                              ((5 6 7 8) "Num is > 3 and < 9")
;                              (t "Greater than eight.") )))
;
;
;    Returns: "three"

  (defun case (value cases / clause)
     (cond (  (setq clause (assoc value cases))
              (do-clause clause))
           (t (case-aux cases)))
  )

  (defun case-aux (cases)
     (cond (  (not cases) nil)
           (  (or (and (listp (caar cases))
                       (member value (caar cases)))
                  (and (not (cdr cases))
                       (equal t (caar cases))))
              (do-clause (car cases)))
           (t (case-aux (cdr cases)))))


  (defun do-clause (clause)
     (let nil (cond (  (cdr clause))
                    (t (list (quote (car clause)))))))

;  (let <bindings> <body> )
;
;  (let '( [(<sym> <expr>)]...)
;       '( <expr>...)
;  )
;
;  Emulates the Common LISP (let) function.
;
;  Perform evaluation of expressions with local bindings.
;
;  <bindings> is a list of symbols and associated value expressions
;  which produce the values each symbol is assigned within the local
;  enviroment of the evaluation of the let <body>.
;
;  <body> is a list of expressions to be evaluated within the scope
;  of the local bindings.
;
;  Example:
;
;     Command: (setq x 1)
;     1
;     Command: (setq y 2)
;     2
;     Command: (let '((x 10) (y 20))                           ; bindings
;                   '(  (princ "\nLocal values of X and Y: ")  ; body
;                       (prin1 x)
;                       (prin1 y)
;                       (princ)
;                    )
;              )
;     Local values of X and Y: 10 20
;     20
;     Command: (print x)
;     1
;     Command: (print y)
;     2
;     Command:

[color=red]  (defun let (bindings body)
     (eval (cons (append (list 'lambda (mapcar 'car bindings)) body)
                 (mapcar 'cadr bindings)))
  )[/color]

News:

Author Topic: (Challenge) Port `let' to Autolisp (Read 11126 times)

JohnK

(Challenge) Port `let' to Autolisp

MP

Re: (Challenge) Port `let' to Autolisp

T.Willey

Re: (Challenge) Port `let' to Autolisp

JohnK

Re: (Challenge) Port `let' to Autolisp

ElpanovEvgeniy

Re: (Challenge) Port `let' to Autolisp

MP

Re: (Challenge) Port `let' to Autolisp

ElpanovEvgeniy

Re: (Challenge) Port `let' to Autolisp

ElpanovEvgeniy

Re: (Challenge) Port `let' to Autolisp

T.Willey

Re: (Challenge) Port `let' to Autolisp

JohnK

Re: (Challenge) Port `let' to Autolisp

gile

Re: (Challenge) Port `let' to Autolisp

ElpanovEvgeniy

Re: (Challenge) Port `let' to Autolisp

MP

Re: (Challenge) Port `let' to Autolisp

kdub_nz

Re: (Challenge) Port `let' to Autolisp

T.Willey

Re: (Challenge) Port `let' to Autolisp