Topic: list question

[Joe Burke]

(setq lst '((24.0 305.333 17.3333) (1.2 15.2667 0.866667)
            (4.8 61.0667 3.46667) (12.0 152.667 8.66667))
)

Notice, the second and third values in each sublist are proportional to the first value in each sublist.

I'm trying to write a test function which returns T if that's the case for all items within the list.

So far, I can't see the logic behind it. But I'm fairly sure it's there somewhere.

[CAB]

Maybe this?

Code: [Select]

(defun c:test ()
  (vl-every '(lambda (x / y z)
               (and
                 (if y
                   (equal y (/ (cadr x) (car x)) 1e-4)
                   (setq y (/ (cadr x) (car x)))
                 )
                 (if z
                   (equal z (/ (caddr x) (car x)) 1e-4)
                   (setq z (/ (caddr x) (car x)))
                 )
               )
             )
            lst
  )
)
Here is another variation:

Code: [Select]

(defun c:test (/ r1 r2)
  (setq r1 (/ (cadar lst) (caar lst)))
  (setq r2 (/ (caddar lst) (caar lst)))
  (vl-every '(lambda (x)
               (and (equal r1 (/ (cadr x) (car x)) 1e-4)
                    (equal r2 (/ (caddr x) (car x)) 1e-4)
               )
             )
            (cdr lst)
  )
)

[LE]

Hola Jose;

See if this does some job... if not it is ok....

Code: [Select]

(defun are-proportional  (lst / res)
  (setq res
         (apply
           'append
           (mapcar
             (function
               (lambda (sub)
                 (mapcar
                   (function (lambda (x) (setq i (car sub)) (- (/ x i) (fix (/ x i)))))
                   (cdr sub))))
             lst)))
  (vl-every (function (lambda (i) (equal (car res) i 0.0001))) (cdr res)))


_$ (are-proportional
  '((24.0 305.333 17.3333)
    (1.2 15.2667 0.866667)
    (4.8 61.0667 3.46667)
    (12.0 152.667 8.66667)))
T

_$ (are-proportional
  '((24.0 305.3246 17.3333)
    (1.2 15.2967 0.866667)
    (4.8 61.0667 3.46667)
    (12.0 152.667 8.66667)))
nil

The same function, without one of the vars...

Code: [Select]

(defun are-proportional  (lst / res)
  (setq res
         (apply
           'append
           (mapcar
             (function
               (lambda (sub)
                 (mapcar (function (lambda (x) (- (/ x (car sub)) (fix (/ x (car sub))))))
                         (cdr sub))))
             lst)))
  (vl-every (function (lambda (i) (equal (car res) i 0.0001))) (cdr res)))


[FengK]

this is probably ugly.

(setq lst1 '((24.0 305.333 17.3333)
        (1.2 15.2667 0.866667)
        (4.8 61.0667 3.46667)
        (12.0 152.667 8.66667)
       )
)

(setq lst2 (mapcar (function (lambda (l)
                (list (/ (car l) (cadr l))
                 (/ (cadr l) (caddr l))
                )
              )
         )
         lst1
      )
)
(setq lst3 (mapcar 'car lst2)
      lst4 (mapcar 'cadr lst2)
)

(setq fuzz 1e-4)
(and (equal (apply 'max lst3) (apply 'min lst3) fuzz)
     (equal (apply 'max lst4) (apply 'min lst4) fuzz)
)

[gile]

Hi

Here's my way

Code: [Select]

(defun test (lst fuzz / prop)
  (if (cdr lst)
    (and
      (setq prop (/ (caar lst) (caadr lst)))
      (equal prop (/ (cadar lst) (cadadr lst)) fuzz)
      (equal prop (/ (caddar lst) (caddr (cadr lst))) fuzz)
      (test (cdr lst) fuzz)
    )
    T
  )
)

[LE]

Hi

Here's my way

Code: [Select]

(defun test (lst fuzz / prop)
  (if (cdr lst)
    (and
      (setq prop (/ (caar lst) (caadr lst)))
      (equal prop (/ (cadar lst) (cadadr lst)) fuzz)
      (equal prop (/ (caddar lst) (caddr (cadr lst))) fuzz)
      (test (cdr lst) fuzz)
    )
    T
  )
)

c'est bon, Gile...

I see, you are fan of recursion

[LE]

this is probably ugly.

(setq lst1 '((24.0 305.333 17.3333)
        (1.2 15.2667 0.866667)
        (4.8 61.0667 3.46667)
        (12.0 152.667 8.66667)
       )
)

(setq lst2 (mapcar (function (lambda (l)
                (list (/ (car l) (cadr l))
                 (/ (cadr l) (caddr l))
                )
              )
         )
         lst1
      )
)
(setq lst3 (mapcar 'car lst2)
      lst4 (mapcar 'cadr lst2)
)

(setq fuzz 1e-4)
(and (equal (apply 'max lst3) (apply 'min lst3) fuzz)
     (equal (apply 'max lst4) (apply 'min lst4) fuzz)
)

Ugly?.... that's looks good

[gile]

c'est bon, Gile...

I see, you are fan of recursion

Gracias Luis, esta la elegancia francesa 

Most of the the time it's the first thing coming to my mind, and it often allows a more concise code (even it runs slower with long lists...)

Here's the same translated in iterative form

Code: [Select]

(defun test2 (lst fuzz / loop prop)
  (setq loop T)
  (while (and loop (cdr lst))
    (setq prop (/ (caar lst) (caadr lst)))
    (if (and
  (equal prop (/ (cadar lst) (cadadr lst)) fuzz)
  (equal prop (/ (caddar lst) (caddr (cadr lst))) fuzz)
)
      (setq lst (cdr lst))
      (setq loop nil)
    )
  )
  loop
)

[Joe Burke]

I feel like such an idiot. I forgot I posted this topic. Duh...

Anyway, thanks for all the interesting suggestions.

What I did was similar to Luis' solution using divide. Later I ran into the fact the first value in each sublist might be zero which causes a divide by zero error. That's where I left it, without a way around that problem.

[gile]

Hi Joe,

Is it a points list (2 or 3 items in each sublist) ?
And want you evaluate if all points are colinear ?
In this case, I had this little routine :

Code: [Select]

(defun linearp (lst)
  (or
    (null (cddr lst))
    (if (null (inters (car lst) (cadr lst) (car lst) (caddr lst)))
     (linearp (cdr lst))
    )
  )
)
_$ (linearp '((24.0 305.333 17.3333)
      (1.2 15.2667 0.866667)
      (4.8 61.0667 3.46667)
      (12.0 152.667 8.66667)
     )
)
T

[Joe Burke]

Hi Joe,

Is it a points list (2 or 3 items in each sublist) ?
And want you evaluate if all points are colinear ?
In this case, I had this little routine :

Hi gile,

The values in each sub-list roughly represent the bounding box of an annotative mtext object. One sub-list for each annotative scale. They are proportional to each other when the bounding box (handles) have not been changed for one or more scales independent of the others. That's what I'm trying to test for.

I think I found a way to avoid the divide by zero error.

Thanks anyway 

[CAB]

Perhaps I don't understand, but if you are testing a group of bounding boxes for ratios could
you compare the width to height ratios?
(setq ratio (/ (distance p1 p2) (distance p2 p3)))

[ElpanovEvgeniy]

Other a way..

Code: [Select]

(defun test-1 (lst)
 (setq lst (vl-sort lst '(lambda (a b) (<= (car a) (car b)))))
 (equal (distance (car lst) (last lst)) (apply '+ (mapcar 'distance lst (cdr lst))) 1e-3)
) ;_  defun

[CAB]

Good to see you Evgeniy, I hope all is well.

[ElpanovEvgeniy]

Good to see you Evgeniy, I hope all is well.

  You still remember me? 

Code: [Select]

(defun area-polygon (lst)
 (/ (apply (function +)
           (mapcar (function (lambda (a b) (* (+ (car a) (car b)) (- (cadr a) (cadr b)))))
                   (cons (last lst) lst)
                   lst
           ) ;_  mapcar
    ) ;_  apply
    -2.
 ) ;_  -
) ;_  defun
(defun test-2 (lst)
 (and (equal 0. (area-polygon lst) 0.01) (equal 0. (area-polygon (mapcar 'cdr lst)) 0.01))
) ;_  defun

[ElpanovEvgeniy]

>CAB
It is a lot of work and not enough free time...

[ElpanovEvgeniy]

Has forgotten to explain...
(equal 0. (area-polygon lst) 0.01)
0.01 = (sqrt 1e-4)

[ElpanovEvgeniy]

Code: [Select]

(defun test-2.1 (lst)
 (equal
  0.
  (apply (function +)
         (mapcar (function (lambda (a b)
                            (+ (* (+ (car a) (car b)) (- (cadr a) (cadr b)))
                               (* (+ (cadr a) (cadr b)) (- (caddr a) (caddr b)))
                               (* (+ (caddr a) (caddr b)) (- (car a) (car b)))
                            ) ;_  +
                           ) ;_  lambda
                 ) ;_  function
                 (cons (last lst) lst)
                 lst
         ) ;_  mapcar
  ) ;_  apply
  0.01
 ) ;_  equal
) ;_  defun

[gile]

Joe,

I think the way I gave works because proportinality is a linear function.

But here's another purpose, asumming lst is a list of pairs ((minpt1 maxpt1) (minpt2 maxpt2) ... (minptn maxptn)).
If each bounding box is proportionnal, each of their their diagonals are parallel.

Code: [Select]

(defun test (lst)
  (vl-every
    '(lambda (pair)
       (null (inters (caar lst) (cadar lst) (car pair) (cadr pair))
       )
     )
    (cdr lst)
  )
)

Hi, Evgeniy, glad to read you again

[CAB]

Hard to forget a Giant. 

[ElpanovEvgeniy]

The version with use of a vector of a normal...

Code: [Select]

(defun v_norm_2v (v1 v2)
 ;; By ElpanovEvgeniy
 ;; Vector normal
 ((lambda (a b)
   (mapcar (function (lambda (a1 b1 a2 b2) (- (* a1 b1) (* a2 b2)))) a (cdr b) b (cdr a))
  ) ;_  lambda
  (list (cadr v1) (caddr v1) (car v1) (cadr v1))
  (list (cadr v2) (caddr v2) (car v2) (cadr v2))
 ) ;_  lambda
) ;_  defun
(defun test-3 (lst)
 (vl-every '(lambda (x) (equal 0. x 0.01))
           (apply 'append (mapcar 'v_norm_2v lst (cdr lst)))
 ) ;_  vl-every
) ;_  defun

[Joe Burke]

Joe,

I think the way I gave works because proportinality is a linear function.

But here's another purpose, asumming lst is a list of pairs ((minpt1 maxpt1) (minpt2 maxpt2) ... (minptn maxptn)).
If each bounding box is proportionnal, each of their their diagonals are parallel.

Code: [Select]

(defun test (lst)
  (vl-every
    '(lambda (pair)
       (null (inters (caar lst) (cadar lst) (car pair) (cadr pair))
       )
     )
    (cdr lst)
  )
)

Hi, Evgeniy, glad to read you again

gile,

That looks like a perfect solution!

Of course I'm wondering why I didn't see it.

I think there is a need for a fuzz factor. I'll have to study Evgeniy's code, which seems to allow that.

Thanks guys.

[Joe Burke]

Perhaps I don't understand, but if you are testing a group of bounding boxes for ratios could
you compare the width to height ratios?
(setq ratio (/ (distance p1 p2) (distance p2 p3)))

Alan,

Yes, that might be another way to aproach the issue.

Thanks

[ElpanovEvgeniy]

gile,

That looks like a perfect solution!

Of course I'm wondering why I didn't see it.

I completely agree. This best decision from all shown.
My decisions, only show other ideas...

Code: [Select]

(defun area_triangle_geron (d1 d2 d3 / d)
 ;; By ElpanovEvgeniy
 ;; area triangle, Geron
 (setq d (* (+ d1 d2 d3) 0.5))
 (sqrt (abs (* d (- d d1) (- d d2) (- d d3))))
)
(defun test-4 (lst)
 (vl-every
  '(lambda (a) (equal a 0. 0.01))
  (mapcar
   '(lambda (a b c) (area_triangle_geron (distance a b) (distance a c) (distance b c)))
   (cons (last lst) lst)
   lst
   (reverse (cons (car lst) (reverse (cdr lst))))
  ) ;_  mapcar
 ) ;_  vl-every
) ;_  defun

[ElpanovEvgeniy]

The version with use of a vector of a normal...

Code: [Select]

(defun v_norm_2v (v1 v2)
 ;; By ElpanovEvgeniy
 ;; Vector normal
 ((lambda (a b)
   (mapcar (function (lambda (a1 b1 a2 b2) (- (* a1 b1) (* a2 b2)))) a (cdr b) b (cdr a))
  ) ;_  lambda
  (list (cadr v1) (caddr v1) (car v1) (cadr v1))
  (list (cadr v2) (caddr v2) (car v2) (cadr v2))
 ) ;_  lambda
) ;_  defun
(defun test-3 (lst)
 (vl-every '(lambda (x) (equal 0. x 0.01))
           (apply 'append (mapcar 'v_norm_2v lst (cdr lst)))
 ) ;_  vl-every
) ;_  defun

This version approaches only for the list of vectors... 
If it to use for the list of the points laying on an any straight line it is necessary to make changes and to result all points in a vector!

Code: [Select]

(defun test-3.1 (lst)
 (vl-every '(lambda (x) (equal 0. x 0.01))
           (apply 'append
                  ((lambda (lst) (mapcar 'v_norm_2v lst (cdr lst)))
                   (mapcar '(lambda (a b) (mapcar '- a b)) lst (cdr lst))
                  )
           ) ;_  apply
 ) ;_  vl-every
) ;_  defun

[gile]

gile,

That looks like a perfect solution!

First, thanks.

But I think it's not really perfect.
It will work if all points are in the same plane but ((0 0 0) (1 1 0)) and ((0 1 1) (1 0 1)) have no intersection but aren't parallel.

Another purpose using single unit vectors, more, this one allows a fuzz.

Always with a list of pairs like ((minpt1 maxpt1) (minpt2 maxpt2) ... (minptn maxptn))

Code: [Select]

;;; VEC1 Returns the single unit vector from p1 to p2

(defun vec1 (p1 p2 / d)
  (if (not (zerop (setq d (distance p1 p2))))
    (mapcar '(lambda (x1 x2) (/ (- x2 x1) d)) p1 p2)
  )
)

(defun test (lst / vec)
  (and
    (setq vec (vec1 (caar lst) (cadar lst)))
    (vl-every
      '(lambda (pair)
(equal vec (vec1 (car pair) (cadr pair)) 1e-9)
       )
      (cdr lst)
    )
  )
)

[Joe Burke]

Thanks gile and Evgeniy.