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