Prev: Erik Naggum message archive (was: Reason to hate loop)
Next: controlling a pc from lisp code,
From: Joshua Taylor on 28 Apr 2010 12:37
On 2010.04.28 12:28 PM, Joshua Taylor wrote:
> On 2010.04.28 8:32 AM, Francogrex wrote:
>> On Apr 27, 4:37 pm, Norbert_Paul<norbertpauls_spam...(a)yahoo.com>
>> wrote:
>>> Maybe it would be helpful if you posted your original
>>> "function which is more complex", maybe even together with
>>> what you expect it to do.
>>
>> ok The actual function is not that complex but it calls other libaries
>> at some point. Here with all the setf it works ok but as such it's a
>> function full of "landmines".
>>
>> load "c:/emacs/zscripts/C-EMBED/rcl.fas")
>> (in-package :rcl)
>> (r-init)
>>
>> (defun OR-MUE (lst)
>> (setf y1 (nth 0 lst) n1 (nth 1 lst) y2 (nth 2 lst) n2 (nth 3 lst))
>>
>> (if (= y1 n1) (setf p_1u 1)
>> (progn
>> (setf F_u (* (/ (+ y1 1) (- n1 y1)) (r "qf" 0.5 (* 2 (+ y1
>> 1)) (* 2 (- n1 y1)))))
>> (setf p_1u (/ F_u (+ 1 F_u)))))
>>
>> (if (= y1 0) (setf p_1l 0)
>> (progn
>> (setf F_l (* (/ (+ (- n1 y1) 1) y1) (r "qf" 0.5 (* 2 (+ (- n1
>> y1) 1)) (* 2 y1))))
>> (setf p_1l (/ 1 (+ 1 F_l)))))
>>
>> (setf p1_mue (* 0.5 (+ p_1l p_1u)))
>>
>> (if (= y2 n2) (setf p_2u 1)
>> (progn
>> (setf F_u (* (/ (+ y2 1) (- n2 y2)) (r "qf" 0.5 (* 2 (+ y2
>> 1)) (* 2 (- n2 y2)))))
>> (setf p_2u (/ F_u (+ 1 F_u)))))
>> (if (= y2 0) (setf p_2l 0)
>> (progn
>> (setf F_l (* (/ (+ (- n2 y2) 1) y2) (r "qf" 0.5 (* 2 (+ (- n2
>> y2) 1)) (* 2 y2))))
>> (setf p_2l (/ 1 (+ 1 F_l)))))
>>
>> (setf p2_mue (* 0.5 (+ p_2l p_2u)))
>>
>> (setf or_mue (/ (* p1_mue (- 1 p2_mue)) (* p2_mue (- 1 p1_mue)))))
>>
>>
>> ;;(OR-MUE (list 4 14 0 11))
>
> If all those variables really shouldn't be bound via LET, how about the
> following:
>
> (defun OR-MUE (lst)
> (multiple-value-setq (y1 n1 y2 n2) (values-list lst))
>
> (cond
> ((= y1 0) ; or (zerop y1)
> (setf p_1l 0))
> ((= y1 n1)
> (setf p_1u 1))
> ((setf F_u (* (/ (+ y1 1)
> (- n1 y1))
> (r "qf" 0.5
> (* 2 (+ y1 1))
> (* 2 (- n1 y1))))
> p_1u (/ F_u (+ 1 F_u))
> F_l (* (/ (+ (- n1 y1) 1) y1)
> (r "qf" 0.5
> (* 2 (+ (- n1 y1) 1))
> (* 2 y1)))
> p_1l (/ 1 (+ 1 F_l)))))
>
> (cond
> ((= y2 0) ; (or (zerop y2))
> (setf p_2l 0))
> ((= y2 n2)
> (setf p_2u 1))
> ((setf F_u (* (/ (+ y2 1) (- n2 y2))
> (r "qf" 0.5
> (* 2 (+ y2 1))
> (* 2 (- n2 y2))))
> p_2u (/ F_u (+ 1 F_u))
> F_l (* (/ (+ (- n2 y2) 1) y2)
> (r "qf" 0.5
> (* 2 (+ (- n2 y2) 1))
> (* 2 y2)))
> p_2l (/ 1 (+ 1 F_l)))))
>
> (setf p1_mue (* 0.5 (+ p_1l p_1u))
> p2_mue (* 0.5 (+ p_2l p_2u))
> or_mue (/ (* p1_mue (- 1 p2_mue))
> (* p2_mue (- 1 p1_mue)))))
>
>
> If these can be local variables, you can do something like the following
> (which also pulls out some common computations). Your original code had
> paths that didn't set all the p_nx value, so you probably had some
> useful non-local values in those variables. Even so, the following could
> still be a useful starting point if you replace the NILs with default
> values and use some MULTIPLE-VALUE-SETQs (or (SETF VALUES)) rather than
> DESTRUCTURING-BIND and MULTIPLE-VALUE-BINDs.
>
>
> (defun OR-MUE (lst)
> (flet ((F_u (y n &aux (1+y (1+ y)) (d (- n y)))
> (* (/ 1+y d)
> (r "qf" 0.5
> (* 2 1+y)
> (* 2 d))))
> (F_l (y n &aux (d+1 (1+ (- n y)))
> (* (/ d+1 y)
> (r "qf" 0.5
> (* 2 d+1)
> (* 2 y)))))
> (ps (y n)
> "Return p_nu, p_nl as multiple values."
> (cond
> ((= y 0)
> (values nil 0)) ; probably shouldn't have nil here
> ((= y n)
> (values 1 nil))
> ((let ((F_u (F_u y n))
> (F_l (F_l y n)))
> (values (/ F_u (1+ F_u))
> (/ (1+ F_l))))))))
> (destructuring-bind (y1 n1 y2 n2) lst
> (multiple-value-bind (p_1u p_1l) (ps y1 n1)
> (multiple-value-bind (p_2u p_2l) (ps y2 n2)
> (let ((p1_mue (* 0.5 (+ p_1l p_1u)))
> (p2_mue (* 0.5 (+ p_2l p_2u))))
> (/ (* p1_mue (1- p2_mue))
> (* p2_mue (1- p1_mue)))))))
>
>
> //JT

The second code block should have been what follows, using LABELS rather
than FLET (since ps uses F_u and F_1), and with t as the test-form of
the last COND clause, since in COND's default cases it only returns the
primary value of the test-form.

(defun OR-MUE (lst)
(labels ((F_u (y n &aux (1+y (1+ y)) (d (- n y)))
(* (/ 1+y d)
(r "qf" 0.5
(* 2 1+y)
(* 2 d))))
(F_l (y n &aux (d+1 (1+ (- n y)))
(* (/ d+1 y)
(r "qf" 0.5
(* 2 d+1)
(* 2 y)))))
(ps (y n)
"return as multiple values p_nu, p_nl"
(cond
((= y 0)
(values nil 0)) ; probably shouldn't have nil here
((= y n)
(values 1 nil))
(t
(let ((F_u (F_u y n))
(F_l (F_l y n)))
(values (/ F_u (1+ F_u))
(/ (1+ F_l))))))))
(destructuring-bind (y1 n1 y2 n2) lst
(multiple-value-bind (p_1u p_1l) (ps y1 n1)
(multiple-value-bind (p_2u p_2l) (ps y2 n2)
(let ((p1_mue (* 0.5 (+ p_1l p_1u)))
(p2_mue (* 0.5 (+ p_2l p_2u))))
(/ (* p1_mue (1- p2_mue))
(* p2_mue (1- p1_mue)))))))))


//JT
From: His kennyness on 28 Apr 2010 13:03
Francogrex wrote:
> On Apr 28, 12:15 am, Tim X <t...(a)nospam.dev.null> wrote:
>> The second issue exposed by this simplificaiton is that I doubt you
>> actually understand let, let*, scope and value binding. If you did, you
>> would have realised your simplified example doesn't work.
>
> Did you seriously think that I didn't know in advance that my
> "useless" example doesn't work? Why do you think I called it useless
> and asked the question then?

Because you knew the crappy example would make it impossible to answer
your question? What the hell were you thinking? Oh, I know, what I said
before: you had already decided that the problem was too many lets,
meaning you decided what we should know about the poblem and you decided
what we should work on and what we should offer.

Contact Merriam-Webster: your picture next to "obtuse" needs updating.
From: His kennyness on 28 Apr 2010 13:05
Francogrex wrote:
> On Apr 27, 4:37 pm, Norbert_Paul <norbertpauls_spam...(a)yahoo.com>
> wrote:
>> Maybe it would be helpful if you posted your original
>> "function which is more complex", maybe even together with
>> what you expect it to do.
>
> ok The actual function is not that complex but it calls other libaries
> at some point. Here with all the setf it works ok but as such it's a
> function full of "landmines".
>
> load "c:/emacs/zscripts/C-EMBED/rcl.fas")
> (in-package :rcl)
> (r-init)
>
> (defun OR-MUE (lst)
> (setf y1 (nth 0 lst) n1 (nth 1 lst) y2 (nth 2 lst) n2 (nth 3 lst))

Can you say "destructuring-bind"? Sher ya can.

Otherwise, don't feel bad: having to prime four (?) globals given four
parameters will never look elegant.

kzo

>
> (if (= y1 n1) (setf p_1u 1)
> (progn
> (setf F_u (* (/ (+ y1 1) (- n1 y1)) (r "qf" 0.5 (* 2 (+ y1
> 1)) (* 2 (- n1 y1)))))
> (setf p_1u (/ F_u (+ 1 F_u)))))
>
> (if (= y1 0) (setf p_1l 0)
> (progn
> (setf F_l (* (/ (+ (- n1 y1) 1) y1) (r "qf" 0.5 (* 2 (+ (- n1
> y1) 1)) (* 2 y1))))
> (setf p_1l (/ 1 (+ 1 F_l)))))
>
> (setf p1_mue (* 0.5 (+ p_1l p_1u)))
>
> (if (= y2 n2) (setf p_2u 1)
> (progn
> (setf F_u (* (/ (+ y2 1) (- n2 y2)) (r "qf" 0.5 (* 2 (+ y2
> 1)) (* 2 (- n2 y2)))))
> (setf p_2u (/ F_u (+ 1 F_u)))))
> (if (= y2 0) (setf p_2l 0)
> (progn
> (setf F_l (* (/ (+ (- n2 y2) 1) y2) (r "qf" 0.5 (* 2 (+ (- n2
> y2) 1)) (* 2 y2))))
> (setf p_2l (/ 1 (+ 1 F_l)))))
>
> (setf p2_mue (* 0.5 (+ p_2l p_2u)))
>
> (setf or_mue (/ (* p1_mue (- 1 p2_mue)) (* p2_mue (- 1 p1_mue)))))
>
>
> ;;(OR-MUE (list 4 14 0 11))
From: Tim X on 29 Apr 2010 04:06
Francogrex <franco(a)grex.org> writes:

> On Apr 28, 12:15 am, Tim X <t...(a)nospam.dev.null> wrote:
>> The second issue exposed by this simplificaiton is that I doubt you
>> actually understand let, let*, scope and value binding. If you did, you
>> would have realised your simplified example doesn't work.
>
> Did you seriously think that I didn't know in advance that my
> "useless" example doesn't work? Why do you think I called it useless
> and asked the question then?


I assumed you called it useless because even if it worked it did nothing
and was useless. The point is your example was more than useless - it
was completely broken and would not have worked *at all* without
throwing reference to unbound symbol errors.

Your question was about how to get rid of/reduce embedded let forms.
However, your example indicates you don't even understand how let forms
worke. If you didn't understand something that simple,
you are unlikely to understand how to get rid of embedded let forms.

If you do understand how let works then you could have created an
example which actually /works/ for no more effort and people would not
have been distracted by errors in your example and would have addressed
your actual question, assuming of course the question you asked did
reflect what you wanted to know.

If your exampoe was just something you dumped out in a hurry, indicating
you couldn't even put in the effort to provide a clear and concise
example of what you were referring to, then why should anyone else try
to put in the effort to help you.

The quality of responses you get are usually a reflection of the quality
and effort you put into forming the question.

--
tcross (at) rapttech dot com dot au
First  |  Prev  | 
Pages: 1 2 3 4
Prev: Erik Naggum message archive (was: Reason to hate loop)
Next: controlling a pc from lisp code,