[Apelsinov]

Помогите с алгоритмом, не обязательно код, хотя бы на словах.
Пишу нумератор, хотелось бы включить в него несколько наиболее востребованных алгоритмов обхода точек.
Наиболее распространенный алгоритм не получается, это слева направо и сверху вниз, как буквы в тексте.
Из тех что уже есть (как пример):

Код:

[Выделить все]

 ;;;аргументы:
;;;lp - список точек '((x y z)...(xn yn zn))
;;;pt0 - некая точка, от которой ведется отсчет (например, крайняя левая верхняя)или просто первая точка
;;;***
(defun test1 (lp pt0 / new_lp)
;;;По удаленности от исходной точки
  (vl-sort lp (FUNCTION (lambda (i1 i2) (< (distance pt0 i1) (distance pt0 i2)))))
)
;;;***
(defun test2 (lp pt0 / new_lp)
;;;   по близости к каждой последующей точке получается такая змейка
  (while lp
    (setq new_lp (cons pt0 new_lp)
	  lp	 (cdr (vl-sort lp (FUNCTION (lambda (i1 i2) (< (distance pt0 i1) (distance pt0 i2))))))
	  pt0 (car lp))
  )
  (reverse new_lp)
)
;;;***
(defun test3 (lp pt0 / pt00 new_lp)
;;;Нечно среднее между test1 и test2
  (setq	pt0  (car lp)
	pt00 pt0
  )
    (while lp
    (setq new_lp (cons pt0 new_lp)
	  lp	 (cdr (vl-sort lp
			       (FUNCTION (lambda (i1 i2)
					   (< (+ (distance pt00 i1) (distance pt0 i1))
					      (+ (distance pt00 i2) (distance pt0 i2))
					   )
					 )
			       )
		      )
		 )
	  pt0 (car lp))
  )
  (reverse new_lp)
)
;;;***
(defun test4 (lp /)
;;;  Сортировка по Y
  (vl-sort lp (function (lambda (i1 i2) (> (cadr i1) (cadr i2)))))
)
;;;***
(defun test5 (lp /)
;;;  Сортировка по X
  (vl-sort lp (function (lambda (i1 i2) (> (car i1) (car i2)))))
)
;;;***
(defun test6 (lp /)
;;;  Сортировка по X/Y
  (vl-sort lp (function (lambda (i1 i2) (> (/(car i1)(cadr i1)) (/(car i2)(cadr i2))))))
)

[Олег (jr.)]

Привет

Код:

[Выделить все]

(setq ss (ssget '((0 . "text"))))
(setq ents (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq pt_list (mapcar '(lambda(x)(cons (cdr (assoc 10 (entget x)))(cdr (assoc 1 (entget x)))))ents))

(setq	pt_list	(vl-sort pt_list
			 '(lambda (a b)
			    (> (cadr (car a)) (cadr (car b))))
			 )
	)

  (setq	pt_list	(reverse (vl-sort pt_list
			 '(lambda (a b)
			    (cond
			      ((= (cadr (car a)) (cadr (car b)))
			       (> (car (car a)) (car (car b))))
			      (> (cadr (car a)) (cadr (car b)))))
			 )
	)
	)

[Li6-D]

Наверное нужен еще один аргумент - точность (tol) по координате y, в пределах которой точки списка lp, будут считаться находящимися на одной высоте.
Эти точки дальше можно отсортировать по x. Даже если точность задана, это не гарантирует однозначности. Все зависит способа выбора полосы высотой tol: можно начинать с точек с наименьшими координатами y, или наоборот с наибольшими. Способов выбора таких полос может быть бесконечно много. Поэтому результат будет отличаться.

[Елпанов Евгений]

Довольно востребованный алгоритм - минимальный пробег для линии, соединяющей все точки.
Еще эта задача известна, как задача Коммивояжера.

[zamtmn]

Наверное нужен еще один аргумент - точность (tol) по координате y, в пределах которой точки списка lp, будут считаться находящимися на одной высоте.

Скорее не точность по Y, а расстояние между точками - чтоб у нумерации небыло большого разброса и рядом стоящие точки имели близкие номера

Довольно востребованный алгоритм - минимальный пробег для линии, соединяющей все точки.

Еще востребованней алгоритм станет при наличии трассы (трасс) по которым можно бегать соядиняя точки, а не просто по минимальному расстоянию

[Li6-D]

Задача разбивки множества точек на горизонтальные полоски, несмотря на простоту формулировки, довольно сложна.
Я распознаю в ней задачу распознавания
Вот простейший случай 2-х точек: (setq lp '((0 0 0) (10 0.01 0))).
Если считать это одной полоской с двумя точками, то "естественная" нумерация справа налево и сверху вниз, сохранит порядок в lp.
А если это 2 полоски по 1-ой точке, то после сортировки получится так: ((10 0.01 0) (0 0 0)).
Даже для двух точек могут быть такие заморочки, а что будет для тысяч точек?

[zamtmn]

Задача разбивки множества точек на горизонтальные полоски, несмотря на простоту формулировки, довольно сложна.

Я бы решал двоичным разбиением пространства по y(игрик) до высоты полоски <= tol, если в качестве секущей прямой брать среднее арифметическое y(игрик) точек в полосе - получится разбиение хорошо отражающее пространственную структуру конкретного набора точек

[Victor]

Нумерует первый атрибут блока в выбраном направлении.
Идея. Алгоритм всё равно не вспомню.

[sbi]

Сообщение от Елпанов Евгений Довольно востребованный алгоритм - минимальный пробег для линии, соединяющей все точки. Еще эта задача известна, как задача Коммивояжера.

И нерешаемая в общем случае без применения терии вероятности.

[Дима_]

Сообщение от sbi И нерешаемая в общем случае без применения терии вероятности.

Еще как решаемая - "бутафорсом" как минимум.

[Елпанов Евгений]

Сообщение от sbi И нерешаемая в общем случае без применения терии вероятности.

Зачем же так...
Эта задача, относится к университетским, т.е ее любят задавать различные преподы во всем мире. Для решения придумано большое количество алгоритмов, позволяющих найти достаточно хорошее решение с заранее известной погрешностью относительно абсолютного решения.

ps. одно из моих решений, можно посмотреть на болоте...

[Олег (jr.)]

Сообщение от Елпанов Евгений ps. одно из моих решений, можно посмотреть на болоте...

Присоединяюсь
5+

[sbi]

И нерешаемая в общем случае ( приближенно- да, но это из другой области,)Математикой только пахнет.

[Li6-D]

Строгая сортировка точек в естественном порядке справа налево и сверху вниз, как нужно по теме.
Это просто квинтэссенция кода из сообщения №2 Олега (jr.)

Код:

[Выделить все]

(defun test7 (lp)
;;Сортировка по Y, а при равенстве Y - по X
  (vl-sort lp
   '(lambda (a b / dy)
      (if (zerop (setq dy (- (cadr b) (cadr a))))
        (> (car b) (car a))
        (minusp dy)
) ) ) )

Не строгая сортировка, допускающая возрастание на величину tol координаты Y точек в отсортированном списке, о чем я писал выше.

Код:

[Выделить все]

(defun test8 (lp tol / cluster y y+ lp1 lpN)
;;Нахождение в списке точек lp "полос" высотой tol,
;;внутри которых координата Y точек будет считаться постоянной.
;;Сортировка точек lp по координате Y "полос", затем по X.
  (defun cluster (METRICS LN tol / margLN i extri L margx extrLN)
  ;;Функция cluster для каждого элемента списка LN вычисляет с помощью выражения
  ;;METRICS число - "критерий". Затем функция ищет "скопления" - наибольшее количество 
  ;;элементов LN, разность между "критериями" которых не превышает величины tol.
  ;;Возвращается список, первый элемент которого - количество элементов в каждом "скоплении",
  ;;остальные - элементы списка LN, являющиеся началом "скоплений" (имеющие наименьший
  ;;"критерий" в своём "скоплении") и расположенные в порядке возрастания "критерия".
    (setq LN (mapcar 'cons (mapcar METRICS LN) LN)
          LN (vl-sort LN '(lambda (x y) (< (car x) (car y))))
          tol (abs tol)
          margLN LN
          i 0
          extri 0
    )
    (while margLN
      (setq L (car LN) LN (cdr LN) margx (+ (car L) tol) L (cdr L))
      (while (and (<= (caar margLN) margx) margLN) (setq i (1+ i) margLN (cdr margLN)))
      (cond 
        ((< i extri))
        ((> i extri) (setq extrLN (list L) extri i))
        ((setq extrLN (cons L extrLN)))
      )
      (setq i (1- i))
    )
    (cons extri (reverse extrLN))
  ) ;end cluster
  (while lp
    (setq y (cadadr (cluster 'cadr lp tol))
          y+ (+ y tol)
          lp (vl-remove-if '(lambda (p) (if (<= y (cadr p) y+) (setq lp1 (cons p lp1)))) lp)
          lpN (cons (cons y (vl-sort lp1 '(lambda (a b) (< (car a) (car b))))) lpN)
          lp1 nil
  ) )
  (apply 'append (mapcar 'cdr (vl-sort lpN '(lambda (a b) (> (car a) (car b))))))
)

[Олег (jr.)]

Сообщение от Li6-D Это просто квинтэссенция кода из сообщения №2 Олега (jr.)

Папрашу не выражацца!
Полиграфыч