Prev: Erik Naggum message archive (was: Reason to hate loop)
Next: controlling a pc from lisp code,
From: Francogrex on 28 Apr 2010 08:32
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))
From: Captain Obvious on 28 Apr 2010 09:06
??>> 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.

F> ok The actual function is not that complex but it calls other libaries
F> at some point. Here with all the setf it works ok but as such it's a
F> function full of "landmines".

I think a good way to write such things in a style similar to what you
already have it so have one huge LET* in your function.
E.g.

(defun OR-MUE (lst)
(let* (
(y1 (nth 0 lst))
(n1 ...)

(p_1u (if (= y1 n1)
1
(let ((F_u ...))
(/ F_u (+ 1 F_u)))) ; = p_1u
(p_1l (if (= y1 0)
0
(let ((F_l ...))
(/ 1 (+ 1 F_l)))) ; = p_1l

(p1_mue (* 0.5 (+ p_1l p_1u)))
...
(or_mue (/ p1_mue ...))

or_mue)))

I see a lot of repeating patterns in your code, if you have them
systematically, you can consider making macros or functions for them.

F> (if (= y1 n1) (setf p_1u 1)
F> (progn
F> (setf F_u (* (/ (+ y1 1) (- n1 y1)) (r "qf" 0.5 (* 2 (+ y1
F> 1)) (* 2 (- n1 y1)))))
F> (setf p_1u (/ F_u (+ 1 F_u)))))

You're in better position to write that macro, but just as an example, if
(if (= y1 n1) (setf p_1u 1) is supposed to mean that p_1u equal to 1 on
border,
we can write something like:

(compute-p
:border-condition (= y1 n1)
:border-value 1
:F (* (/ (+ y1 1) (- n1 y1)) (r "qf" 0.5 (* 2 (+ y1 1)) (* 2 (- n1
y1))))
:p (/ F (+ 1 F)))


From: Norbert_Paul on 28 Apr 2010 09:12
OK.

First step:
Where do you declare all these symbols you setf in the
function?
Are they special variables?

By the way. Note,
<code>
(progn (setf foo new-foo)
(setf bar new-bar))
</code>
is equivalent to
<code>
(setf foo new-foo
bar new-bar)
</code>
but less readable.

Norbert

From: Teemu Likonen on 28 Apr 2010 12:14
* 2010-04-28 05:29 (-0700), 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?

Your example wasn't very good at pointing out what things you were
asking help for. So I don't think you should blame others for not being
able to guess what parts you knew were wrong and what you perhaps didn't
know. Anyway, I hope someone can give you the advice you need.
From: Joshua Taylor on 28 Apr 2010 12:28
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
First  |  Prev  |  Next  |  Last
Pages: 1 2 3 4
Prev: Erik Naggum message archive (was: Reason to hate loop)
Next: controlling a pc from lisp code,