Topic: Аlgorithm to separate the list of polygons

[remoteworker]

Hi all..
My first posting in theswamp.
Could someone pointing me to the right direction or help the algorithm.

CHALLENGE:
is a description of polygons in a list:
((a-1 (v-1 ... v-n)) ... (a-n (v-1n ... v-nn)))
where:
a-n - n polygon
(v-1n ... v-nn) - list of vertices belonging to a polygon n

help with the algorithm for the separation of the input list of polygons into groups according to the following conditions:
1. "isolated" group (a-325 a-625 a-302)
2. "one vertex" (communicate through a single vertex) group (a-1 a-2 a-10 a-15 a-92 a-6 a-42 a-21) (a-156 a-174 a-198)
(see Figure a.jpg)
example:
INPUT:
(a-1 (v-1 v-4 v-5 v-6))
(a-2 (v-1 v-2 v-3 v-4))
(a-10 (v-2 v-20 v-10 v-3))
(a-15 (v-20 v-21 v-9 v-10))
(a-92 (v-21 v-91 v-50 v-15 v-14 v-8 v-9))
(a-6 (v-8 v-14 v-13 v-7))
(a-42 (v-7 v-13 v-12))
(a-21 (v-5 v-7 v-12 v-11 v-6))
(a-156 (v-50 v-102 v-72 v-73))
(a-174 (v-102 v-162 v-37 v-72))
(a-198 (v-162 v-35 v-36 v-37))
(a-325 (v-973 v-974 v-975 v-976))
(a-625 (v-973 v-977 v-974))
(a-302 (v-974 v-977 v-978 v-975))
OUTPUT:
((a-1 a-2 a-10 a-15 a-92 a-6 a-42 a-21) (a-156 a-174 a-198) (a-325 a-625 a-302))

[Kerry]

I'd suggest that you provide some sample data ... several sets at least, to test against.

An algorithm to satisfy your requirements will not be simple.

added:
I imagine that your lists will be actually quoted symbols to represent the vertex points, NOT actual points ??


ps
Welcome to the swamp

pps
 Is this your homework or an actual practical problem. ?

[CAB]

Welcome to the swamp Johnny.

[Lee Mac]

Forgive me if I have looked at this the wrong way, but it seems to me that you just need one function to compare elements in two lists and check for common points in each list, then, if the lists share > 1 point they are in a group, = 1 they are two groups (as in second example), and 0 points means an isolated group.

Just my 2 cents

Lee

Possible comparision function?

Code: [Select]

(defun common_list (lst1 lst2 / i x)
  (setq i 0)
 
  (while (setq x (car lst1))
    (if (vl-position x lst2)
      (setq i (1+ i)))
    (setq lst1 (cdr lst1)))
 
  i)


[gile]

Hi,

Something like this ?

Code: [Select]

(defun common (l1 l2)
  (if l1
    (if (vl-position (car l1) l2)
      (cons (car l1) (common (cdr l1) l2))
      (common (cdr l1) l2)
    )
  )
)

(defun test (lst / grp mlst result)
  (while lst
    (setq grp  (list (caar lst))
          mlst (list (cadar lst))
          lst  (cdr lst)
    )
    (foreach l lst
      (if (vl-some '(lambda (x) (< 1 (length (common x (cadr l))))) mlst)
        (setq grp  (cons (car l) grp)
              mlst (cons (cadr l) mlst)
              lst  (vl-remove l lst)
        )
      )
    )
    (setq result (cons grp result))
  )
)

[Lee Mac]

nice one Gile 

[remoteworker]

Thanks, Lee Mac, gile!!!

[remoteworker]

Similar problems
CHALLENGE:
is a description of lines in a list:
((l-1 (v-1 v-2)) ... (l-n (v-1n ... v-nn)))
where:
l-n - line n
(v-1n ... v-nn) - list of vertices belonging to the line n

requires an algorithm for the separation of the input list of lines into groups of "continuous" lines (see Figure l.jpg)
 
example:
INPUT:
(l-1 (v-13 v-14))
(l-2 (v-12 v-13))
(l-3 (v-11 v-12))
(l-4 (v-6 v-11))
(l-5 (v-1 v-6))
(l-6 (v-1 v-2))
(l-7 (v-2 v-20))
(l-8 (v-20 v-21))
(l-20 (v-50 v-102))
(l-21 (v-102 v-162))
(l-22 (v-162 v-35))
(l-23 (v-35 v-36))
(l-24 (v-36 v-37))
(l-25 (v-37 v-72))
(l-26 (v-72 v-73))
(l-27 (v-73 v-50))
(l-30 (v-978 v-977))
(l-31 (v-975 v-978))
(l-32 (v-976 v-975))
(l-33 (v-973 v-976))

OUTPUT:
((l-1 l-2 l-3 l-4 l-5 l-6 l-7 l-8) (l-20 l-21 l-22 l-23 l-24 l-25 l-26 l -27) (l-30 l-31 l-32 l-33))

[Lee Mac]

Well, this is just a case of looking for groups that share a point. 

[CAB]

This is starting to look like Homework.

[Lee Mac]

This is starting to look like Homework.

My thoughts exactly... 

[Kerry]

This is starting to look like Homework.

My thoughts exactly... 

I seem to recall asking that question (and others) and not getting an answer

[remoteworker]

;;; -----------------------------------------------------------------------
(defun common (l1 l2)
  (if l1
    (if   (vl-position (car l1) l2)
      (cons (car l1) (common (cdr l1) l2))
      (common (cdr l1) l2)
    )
  )
)
;;; -----------------------------------------------------------------------

;;; -----------------------------------------------------------------------
(defun test (lst / grp mlst result)
  (while lst
    (setq grp  (list (caar lst))
     mlst (list (cadar lst))
     lst  (cdr lst)
    )
    (foreach l lst
      (if (vl-some '(lambda (x) (< 1 (length (common x (cadr l)))))
         mlst
     )
   (setq grp  (cons (car l) grp)
         mlst (cons (cadr l) mlst)
         lst  (vl-remove l lst)
   )
      )
    )
    (setq result (cons grp result))
  )
)
;;; -----------------------------------------------------------------------
(defun c:tst ()
;;; -----------------------------------------------------------------------
  (setq   lst (list (list   "a-17043"
         (list "v-17566" "v-17515" "v-17487" "v-17485")
        )
        (list   "a-17044"
         (list "v-17515" "v-17488" "v-17486" "v-17487")
        )
        (list   "a-17045"
         (list "v-17488" "v-17517" "v-21457" "v-17486")
        )
        (list   "a-17046"
         (list "v-17485" "v-17487" "v-21530" "v-21528")
        )
        (list   "a-17047"
         (list "v-17487" "v-17486" "v-17490" "v-21530")
        )
        (list   "a-17048"
         (list "v-17486" "v-21457" "v-17489" "v-17490")
        )
        (list   "a-17067"
         (list "v-17557" "v-17508" "v-17513" "v-17511")
        )
        (list   "a-17068"
         (list "v-17508" "v-17510" "v-17512" "v-17513")
        )
        (list   "a-17069"
         (list "v-17510" "v-17514" "v-17516" "v-17512")
        )
        (list   "a-17070"
         (list "v-17511" "v-17513" "v-17515" "v-17566")
        )
        (list   "a-17071"
         (list "v-17513" "v-17512" "v-17488" "v-17515")
        )
        (list   "a-17072"
         (list "v-17512" "v-17516" "v-17517" "v-17488")
        )
        (list   "a-17113"
         (list "v-17555" "v-17556" "v-17558" "v-17554")
        )
        (list   "a-17114"
         (list "v-17556" "v-17557" "v-17511" "v-17558")
        )
        (list   "a-17119"
         (list "v-17554" "v-17558" "v-17567" "v-17565")
        )
        (list   "a-17120"
         (list "v-17558" "v-17511" "v-17566" "v-17567")
        )
        (list   "a-17157"
         (list "v-17635" "v-17602" "v-17606" "v-17638")
        )
        (list   "a-17158"
         (list "v-17602" "v-17607" "v-17609" "v-17606")
        )
        (list   "a-17163"
         (list "v-17638" "v-17606" "v-17613" "v-17621")
        )
        (list   "a-17164"
         (list "v-17606" "v-17609" "v-17612" "v-17613")
        )
        (list   "a-17169"
         (list "v-21447" "v-17620" "v-17622" "v-21453")
        )
        (list   "a-17170"
         (list "v-17620" "v-17621" "v-17624" "v-17622")
        )
        (list   "a-17171"
         (list "v-21453" "v-17622" "v-21523" "v-17623")
        )
        (list   "a-17172"
         (list "v-17622" "v-17624" "v-17625" "v-21523")
        )
        (list   "a-17185"
         (list "v-21435" "v-17634" "v-17637" "v-17636")
        )
        (list   "a-17186"
         (list "v-17634" "v-17635" "v-17638" "v-17637")
        )
        (list   "a-17187"
         (list "v-17636" "v-17637" "v-17620" "v-21447")
        )
        (list   "a-17188"
         (list "v-17637" "v-17638" "v-17621" "v-17620")
        )
       )
  )
;;; -----------------------------------------------------------------------
  (princ)
  (setq a0 (test lst))
)

;;; -----------------------------------------------------------------------
return:
;;; -----------------------------------------------------------------------
(("a-17185")
  ("a-17187" "a-17172" "a-17171" "a-17170" "a-17169")
  ("a-17188" "a-17186" "a-17164" "a-17163" "a-17158" "a-17157")
  ("a-17119" "a-17113")
  ("a-17114" "a-17069" "a-17068" "a-17067")
  ("a-17120" "a-17072" "a-17071" "a-17070" "a-17048" "a-17047" "a-17046" "a-17045" "a-17044" "a-17043")
)
;;; -----------------------------------------------------------------------
should be:
;;; -----------------------------------------------------------------------
(("a-17157" "a-17158" "a-17163" "a-17164" "a-17169" "a-17170" "a-17171" "a-17172" "a-17185" "a-17186" "a-17187" "a-17188")
("a-17043" "a-17044" "a-17045" "a-17046" "a-17047" "a-17048" "a-17067" "a-17068" "a-17069" "a-17070" "a-17071" "a-17072" "a-17113" "a-17114" "a-17119" "a-17120")