Topic: —={Challenge}=— Multi linear interpolation Lookup

[chlh_jd]

Hi all ,  Multi linear interpolation Lookup from A list is seem easy to Lisp for conslist , but do you sure ?
The assoc list structure :
A list =  ( ( Arg11 (Arg12 (Arg13 ... (Arg1n Value1j) ...)))
               ( Arg21 (Arg22 (Arg23 ... (Arg2n Value2j) ...)))
                ...
               (Argm1 (Argm2 (Argm3 ... (Argmn Valuemj) ...))))
Pal list =  (Argp1 Argp2 ... Argpn )
(Lookup Pal Lst )--> Result
The function is to get the result like following examples :
E.g.1

Code: [Select]

(setq lst '((0.5 13) (0.6 11) (0.7 9) (0.8 5) (0.9 3) (1.0 2))
      pal (list 0.55))
(Lookup pal lst)-->12.0
E.g.2

Code: [Select]

(setq lst
  '((0.5 (10 410) (15 390) (20 365))
    (0.6 (10 310) (15 300) (20 280) (25 270))
    (0.7 (10 250) (15 240) (20 225) (25 215) (30 205))
    (0.8 (10 200) (15 190) (20 180) (25 170) (30 165))
    (0.9 (10 160) (15 150) (20 145) (25 140) (30 130) (35 125))
    (1.0 (10 130) (15 125) (20 120) (25 115) (30 110) (35 105) (40 100)))
      pal (list 0.76 12.3)
      )
(Lookup pal lst)-->215.4
E.g.3

Code: [Select]

(setq
      pal (list 0.65 1.5 12.3)
      l '((0.5 (1 (10 400) (15 380) (20  360)) (2 (10 340) (15 320) ( 20 300)) (3 (10 280) (15 260) (20 240)))
    (0.6 (1 (10 340) (15 320) ( 20 300)) (2 (10 280) (15 260) (20 240)) (3 (10 220) (15 200) (20 180)))
    (0.7 (1 (10 280) (15 260) (20 240)) (2 (10 220) (15 200) (20 180)) (3 (10 160) (15 140) (20 120))))
      )
(Lookup pal l)-->270.8


[Stefan]

First release.
I've made tests on your samples only.

Code - Auto/Visual Lisp: [Select]

1. (defun border (a b)
2.   ((lambda (p) (list (car p) (cadr p))) (vl-sort b '(lambda (x y) (< (abs (- a (car  x))) (abs (- a (car  y)))))))
3.   )
4.  
5. (defun ph:lookup (n l / a)
6.   (setq a (border (car n) l))
7.   (if (cdr n)
8.    (cadr (inters (list (car n) 0.0)
9.                   (list (car n) 1.0)
10.                   (list (caar  a) (ph:lookup (cdr n) (cdar  a)))
11.                   (list (caadr a) (ph:lookup (cdr n) (cdadr a)))
12.                   nil
13.                   )
14.           )
15.     (cadr (inters (list (car n) 0.0)
16.                   (list (car n) 1.0)
17.                   (car a)
18.                   (cadr a) nil))
19.     )
20.   )

[bruno_vdh]

Hello,
A variation ...

Code: [Select]

(defun Lookup (n l)
  (if (<= (caar l) (car n) (caadr l))
    (if (cdr n)
      (cadr (inters (list (car n) 0.0)
                    (list (car n) 1.0)
                    (list (caar l) (Lookup (cdr n) (cdar l)))
                    (list (caadr l) (Lookup (cdr n) (cdadr l)))
                    nil
            )
      )
      (cadr (inters (list (car n) 0.0) (list (car n) 1.0) (car l) (cadr l) nil))
    )
    (Lookup n (cdr l))
  )
)Regards

[bruno_vdh]

Another version that avoids stack overflow

Code: [Select]

(defun Lookup (n l)
  (cond ((null (cdr l)) nil)
        ((<= (caar l) (car n) (caadr l))
         (if (cdr n)
           ((lambda (a b)
              (if (and a b)
                (cadr (inters (list (car n) 0.0) (list (car n) 1.0) (list (caar l) a) (list (caadr l) b) nil))
              )
            )
             (Lookup (cdr n) (cdar l))
             (Lookup (cdr n) (cdadr l))
           )
           (cadr (inters (list (car n) 0.0) (list (car n) 1.0) (car l) (cadr l) nil))
         )
        )
        ((Lookup n (cdr l)))
  )
)Regards

[chlh_jd]

First release.
I've made tests on your samples only.

Code - Auto/Visual Lisp: [Select]

1. (defun border (a b)
2.   ((lambda (p) (list (car p) (cadr p))) (vl-sort b '(lambda (x y) (< (abs (- a (car  x))) (abs (- a (car  y)))))))
3.   )
4.  
5. (defun ph:lookup (n l / a)
6.   (setq a (border (car n) l))
7.   (if (cdr n)
8.    (cadr (inters (list (car n) 0.0)
9.                   (list (car n) 1.0)
10.                   (list (caar  a) (ph:lookup (cdr n) (cdar  a)))
11.                   (list (caadr a) (ph:lookup (cdr n) (cdadr a)))
12.                   nil
13.                   )
14.           )
15.     (cadr (inters (list (car n) 0.0)
16.                   (list (car n) 1.0)
17.                   (car a)
18.                   (cadr a) nil))
19.     )
20.   )

Oh very cool for using inters function , Stefan
I found you are very good at Numerical analysis 

Hello,
A variation ...

Code: [Select]

(defun Lookup (n l)
  (if (<= (caar l) (car n) (caadr l))
    (if (cdr n)
      (cadr (inters (list (car n) 0.0)
                    (list (car n) 1.0)
                    (list (caar l) (Lookup (cdr n) (cdar l)))
                    (list (caadr l) (Lookup (cdr n) (cdadr l)))
                    nil
            )
      )
      (cadr (inters (list (car n) 0.0) (list (car n) 1.0) (car l) (cadr l) nil))
    )
    (Lookup n (cdr l))
  )
)Regards

Hi  bruno_vdh ,  your's cool too.

when I test with following params

Code: [Select]

(setq
      pal (list 0.4 1.5 12.3)
      l '((0.5 (1 (10 400) (15 380) (20  360)) (2 (10 340) (15 320) ( 20 300)) (3 (10 280) (15 260) (20 240)))
    (0.6 (1 (10 340) (15 320) ( 20 300)) (2 (10 280) (15 260) (20 240)) (3 (10 220) (15 200) (20 180)))
    (0.7 (1 (10 280) (15 260) (20 240)) (2 (10 220) (15 200) (20 180)) (3 (10 160) (15 140) (20 120))))
      )
(ph:lookup pal l)-->420.8 , first Arg 0.4 beyond the domain , so it must return nil .
Bruno_vdh's will not return result .

Thank you two guys .

[chlh_jd]

Hi  bruno_vdh , thank you for revit the post .
After I post my reply ,  I found you has fix this bug .

[Stefan]

Thank you chlh_jd

I knew it will fail in "out of range" case..
Try this one.

Code - Auto/Visual Lisp: [Select]

1. (defun ph:lookup1 (n l / a)
2.   (if
3.     (setq a (2memb (car n) l))
4.     (interp (float (car n))
5.             (caar a)
6.             (if (cdr n) (ph:lookup1 (cdr n) (cdar a)) (cadar a))
7.             (caadr a)
8.             (if (cdr n) (ph:lookup1 (cdr n) (cdadr a)) (cadadr a))
9.     )
10.   )
11. )
12.  
13. (defun interp (x a b c d)
14.   (if
15.     (and x a b c d)
16.     (+ b (/ (* (- x a) (- d b)) (- c a)))
17.     )
18.   )
19.  
20. (defun 2memb (a b)
21.   (if (cdr b)
22.     (if
23.       (or
24.         (<= (caar b) a (caadr b))
25.         (>= (caar b) a (caadr b))
26.         )
27.       (list (car b) (cadr b))
28.       (2memb a (cdr b))
29.       )
30.     )
31. )

Code: [Select]

(setq
      p1 (list 0.4  1.5 12.3)
      p2 (list 0.62 3.5 12.3)
      p3 (list 0.62 1.5 22.3)
      p4 (list 0.62 1.5 12.3)
      l '((0.5 (1 (10 400) (15 380) (20  360)) (2 (10 340) (15 320) ( 20 300)) (3 (10 280) (15 260) (20 240)))
    (0.6 (1 (10 340) (15 320) ( 20 300)) (2 (10 280) (15 260) (20 240)) (3 (10 220) (15 200) (20 180)))
    (0.7 (1 (10 280) (15 260) (20 240)) (2 (10 220) (15 200) (20 180)) (3 (10 160) (15 140) (20 120))))
      )
_$ (ph:lookup1 p1 l)
nil
_$ (ph:lookup1 p2 l)
nil
_$ (ph:lookup1 p3 l)
nil
_$ (ph:lookup1 p4 l)
288.8
EDIT1: Minor changes in main function.
EDIT2: Fixed for integers only in input

[chlh_jd]

Thanks Stefan for fix this bug 

[chlh_jd]

When sometimes lost some parameters , will brake routine , I think it must return NIL .
E.g.

Code: [Select]

(setq
      p (list 0.4  1.5 )   
      l '((0.5 (1 (10 400) (15 380) (20  360)) (2 (10 340) (15 320) ( 20 300)) (3 (10 280) (15 260) (20 240)))
    (0.6 (1 (10 340) (15 320) ( 20 300)) (2 (10 280) (15 260) (20 240)) (3 (10 220) (15 200) (20 180)))
    (0.7 (1 (10 280) (15 260) (20 240)) (2 (10 220) (15 200) (20 180)) (3 (10 160) (15 140) (20 120))))
      )
(ph:lookup1 p l)
(lookup p l)

[chlh_jd]

After learn Stefan's function , rewrite my old codes .

Code: [Select]

(defun ss:lookup  (n l /  b c r)
  ;; learn from Stefan's function , rewrite my old function 
  ;|(setq l (vl-sort l (function (lambda (a b) (< (car a) (car b))))));_here must be added , we don't know a dimension of the Nd-list is descending . |;
  (if (and (numberp (car n))
   (vl-consp l)
   (cadar l)
   (<= (caar l) (car n) (car (last l)))
   (setq l (mapcar (function (lambda (i)
       (nth i l))) (f2 (car n) (mapcar (function car) l))))
    ;_ if loops goon one by one , when the given list is superlarge will take long time to get the suit items .
            ;_because the given list is sort by first item of every terms , so here can use Dichotomy to reduce computation .
   )
    (progn     
      (setq b (car l)
    c (cadr l))
      (if (<= (car b) (car n) (car c))
(cond
  ((not (cadr b));_1st term is no 2nd item , quit routine
   nil)
  ((= (car n) (car b));_1st term's 1st item = para 
   (if (numberp (cadr b))
     (setq r (cadr b));_2nd item is number
     (setq r (f (cdr n) (cdr b)));_inter next recursion
     )
   )
  ((and (cadr c) (= (car n) (car c)));_2nd term's 1st item = para
   (if (numberp (cadr c))
     (setq r (cadr c));_2nd item is number
     (setq r (f (cdr n) (cdr c)));_inter next recursion
     ))
  ((and (cadr b) (cadr c) (< (car b) (car n) (car c)));_para between 1st_term's 1st item  and 2nd_term's 1st item
   (if (and (numberp (cadr b)) (numberp (cadr c)));_2nd item is number
     (setq
       r (f1 (car n) (car b) (cadr b) (car c) (cadr c)))
     (if (and (vl-consp (cadr b)) (vl-consp (cadr c)));_the 2 terms's 2nd item is a list
       (setq r (f1 (car n)
   (car b)
   (ss:lookup (cdr n) (cdr b))
   (car c)
   (ss:lookup (cdr n) (cdr c))))        
       )))
  ))
      )
    )
  )


[chlh_jd]

Code: [Select]

(defun creat_lookup_lst (N / a i al bl ml)
  (setq a (* N N)
i N)
  (repeat N
    (setq al (cons i al)
  i (1- i)))
  (setq bl (mapcar (function (lambda (a)
       (* 0.1 a)))
   al))
  (repeat (* N N)
    (setq mL (cons (setq a (1- a)) ml)))
  (mapcar (function (lambda (i a)
       (cons i (mapcar (function (lambda (i b)
(list i b)))
       al
       a))))
   bl
   (list-comp ml n))
  )
(defun list-comp (a b / mid rslt)
    (repeat (/ (length a) b)
      (setq mid nil)
      (repeat b
(setq mid (cons (car a) mid)
      a   (cdr a)
)
      )
      (setq rslt (cons (reverse mid) rslt))
    )
  (if a (reverse (cons a rslt))
    (reverse rslt))
  )

(setq l (creat_lookup_lst 1000)
      p (list 57.6 875.3))     

(QuickBench (mapcar '(lambda (f) (list f 'p 'l )) (list ph:lookup1 ss:lookup bv:lookup)))
QuickBench function see here http://www.theswamp.org/index.php?action=dlattach;topic=42091.0;attach=22832
result
_$
Benchmarking ... done for 4096 iterations. Sorted from fastest.
Statement                                Increment  Time(ms) Normalize  Relative
--------------------------------------------------------------------------------
(#<USUBR @000000003f3e7098 SS:LOOKUP...)      4096      1730      1730     18.77
(#<USUBR @0000000032484fc0 BV:LOOKUP...)       256      1777     28432      1.14
(#<USUBR @0000000032484ea8 PH:LOOKUP...)       128      1015     32480      1.00
--------------------------------------------------------------------------------
_$