Скачать NANOCAD Pдгы 8.5
dwg.ru forum rss xml
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > LISP. Помогите оптимизировать алгоритм обработки списка

LISP. Помогите оптимизировать алгоритм обработки списка

Версия для печати
 
Ответ
Опции темы Поиск в этой теме
Непрочитано 19.05.2017, 14:03 | 1 #1
LISP. Помогите оптимизировать алгоритм обработки списка
Composter
 
Отопление и вентиляция
 
Москва
Регистрация: 31.10.2008
Сообщений: 354

Composter вне форума Вставить имя

Добрый день.Сделал очень просто аналог Overkill.
Код:
[Выделить все]
 (defun zd168 ( / ss1  ss2)
(princ "\n аналог overkill \n")
(setq ss1 (ssget))
(mapcar  
	'(lambda (z)   
		(mapcar  
			'(lambda (x)   
				(if (equal (remove_dxf_pair 5(remove_dxf_pair -1(entget z))) (remove_dxf_pair 5(remove_dxf_pair -1(entget x))))
					(if (not	(equal (entget z) (entget x)))
						(if	(< (cdr(assoc 5 (entget x))) (cdr(assoc 5 (entget z))))
							(setq ss2 (append ss2 (list(cdr(assoc -1 (entget x))))))
							(setq ss2 (append ss2 (list(cdr(assoc -1 (entget z))))))
						)
					)
				)	
			)       
		(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
		)
	)   
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
)
(setq ss2(_kpblc-list-dublicates-remove ss2))
(if	ss2
	(mapcar '(lambda (y)(entdel y))ss2)
)
(princ (strcat "\n удалено      "  (rtos(length ss2)2 0) "    объектов \n"))
(princ)
)
(defun C:zd168 ()(zd168))

; удаляет dxf пару по номеру
(defun remove_dxf_pair ( bit entget01 / )
(vl-remove-if(function (lambda(x)(equal (car x) bit)))entget01)
)


 (defun _kpblc-list-dublicates-remove (lst / result)
                                     ;|
*    Функция исключения дубликатов элементов списка 
*    Параметры вызова:
*	lst	обрабатываемый список
*    Возвращаемое значение: список без дубликатов соседних элементов
*    Примеры вызова:
(_kpblc-list-dublicates-remove '((0.0 0.0 0.0) (10.0 0.0 0.0) (10.0 0.0 0.0) (0.0 0.0 0.0)) nil)
((0.0 0.0 0.0) (10.0 0.0 0.0) (0.0 0.0 0.0))
|;
  (foreach x lst
    (if (not (member x result))
      (setq result (cons x result))
      ) ;_ end of if
    ) ;_ end of foreach
  (reverse result)
  ) ;_ end of defun

(defun _kpblc-list-dublicates-stay (lst / res)
                                   ;|
*    Оставляет дубликаты списка
|;
  (if (and lst (= (type lst) 'list))
    (progn
      (foreach item lst
        (if (member item (cdr (member item lst)))
          (setq res (cons item res))
          ) ;_ end of if
        ) ;_ end of foreach
      (setq res (_kpblc-list-dublicates-remove (reverse res)))
      ) ;_ end of progn
    ) ;_ end of if
  res
  )

так вот у меня получается список обрабатывается в 2 циклах и количество сравнений элементов растет в квадратичной зависимости от количества элементов. полчается если в списке 4 элемента то первый сравниватеся 1,2,3,4 ,второй также сравнивается с 1,2,3,4 и т.д. подскажите как сделать так чтобы первый элемент сравнивался с 2,3,4,второй элемент сравнивался с 3,4, а третий уже толко с 4 ?

Последний раз редактировалось Composter, 19.05.2017 в 14:26.
Просмотров: 1262
 
Непрочитано 22.05.2017, 17:54
#2
roaa

ОПС
 
Регистрация: 29.03.2012
Kazakhstan
Сообщений: 127


попробую ответить, но работает не совсем корректно.
Код:
[Выделить все]
 
(defun zd168 ( / ss1  ss2)
  (princ "\n аналог overkill \n")
  (setq ss1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget)))))
  (setq ss2 nil) 
  (mapcar 
   '(lambda (x)
      (if
        (and
          (not 
            (vl-member-if
             '(lambda (z)
                (and 
                  (not (equal (setq q (entget x))(setq w (entget z))))
                  (equal 
		                (remove_dxf_pair 5 (remove_dxf_pair -1 q))
	                  (remove_dxf_pair 5 (remove_dxf_pair -1 w))
		              )
	              )
	            )
	            ss2
	          )
	        )
	        (if	
	          (< (cdr (assoc 5 q)) (cdr (assoc 5 w)))
					  (setq ss2 (append ss2 (list (cdr (assoc -1 q)))))
					  (setq ss2 (append ss2 (list (cdr (assoc -1 w)))))
					)
	      )
	      (princ)
	    )	              
    )
    ss1
  )
  (if ss2 
    (progn 
      (mapcar '(lambda (y)(entdel y)) ss2)
      (princ (strcat "\n удалено      "  (itoa (length ss2)) "    объектов \n"))
    )
  )
  (princ)
)
(defun C:zd168 ()(zd168))

Последний раз редактировалось roaa, 22.05.2017 в 19:16.
roaa вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 06.06.2017, 14:28
#3
Composter

Отопление и вентиляция
 
Регистрация: 31.10.2008
Москва
Сообщений: 354


я почему то думал что список для mapcar/foreach не меняется в процессе обработки. в итоге попоробовалл несколько вариантов получлось быстрее всего через циклы и car . Добавил исключение ручек в динамическом блоке. Убрал одну проверку, заменил ее сортировкой. Вот последний вариант может кому пригодиться
Код:
[Выделить все]
 (defun zd1685 ( / ss1  ss2 ss200 ss3 ss4 zzz1 zzz2)
(setq zzz1 (getvar "DATE"))
(princ "\n аналог overkill \n")
(setq 	ss1 	(ssget) 
		ss1 	(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
		ss1		(vl-remove-if-not (FUNCTION (LAMBDA (x)(assoc 8(entget x))))ss1)
		ss1 	(vl-sort ss1 '(lambda(c d)(< (cdr(assoc 5 (entget c))) (cdr(assoc 5 (entget d))) )))
		ss3		(cdr ss1)
		ss1		(reverse(cdr(reverse ss1)))
		ss4		ss3
)
(while (car ss1)
	(while (car ss4)
		(if (equal (remove_dxf_pair2 '(-1 5)(entget (car ss1))) (remove_dxf_pair2 '(-1 5)(entget (car ss4))))
			(setq ss2 (append ss2 (list(car ss4))))
		)
		(setq ss4 (cdr ss4))
	)
	(foreach x ss2 (setq ss3 (vl-remove x ss3)))
	(foreach x ss2 (setq ss1 (vl-remove x ss1)))
	(setq 	ss1 	(cdr ss1)
			ss3		(cdr ss3)
			ss4		ss3
			ss200	(append ss200 ss2)
			ss2		nil
	)
)
(if	ss200	
		(progn
				(setq ss200(_kpblc-list-dublicates-remove ss200))
				(mapcar '(lambda (y)(entdel y))ss200)
				(princ (strcat "\n удалено      "  (rtos(length ss200)2 0) "    объектов \n"))
		)
		(princ (strcat "\n нет      дубликатов \n"))
)
(setq zzz2 (getvar "DATE"))
(* 86400.0(- zzz2 zzz1))
)
(defun C:zd1685 ()(zd1685))

; удаляет dxf пару по номеру
(defun remove_dxf_pair2 ( bitlist01 entget01 / )
(vl-remove-if(function (lambda(x)(member (car x) bitlist01)))entget01)
)


(defun _kpblc-list-dublicates-remove (lst / result)
                                     ;|
*    Функция исключения дубликатов элементов списка 
*    Параметры вызова:
*	lst	обрабатываемый список
*    Возвращаемое значение: список без дубликатов соседних элементов
*    Примеры вызова:
(_kpblc-list-dublicates-remove '((0.0 0.0 0.0) (10.0 0.0 0.0) (10.0 0.0 0.0) (0.0 0.0 0.0)) nil)
((0.0 0.0 0.0) (10.0 0.0 0.0) (0.0 0.0 0.0))
|;
  (foreach x lst
    (if (not (member x result))
      (setq result (cons x result))
      ) ;_ end of if
    ) ;_ end of foreach
  (reverse result)
  ) ;_ end of defun

(defun _kpblc-list-dublicates-stay (lst / res)
                                   ;|
*    Оставляет дубликаты списка
|;
  (if (and lst (= (type lst) 'list))
    (progn
      (foreach item lst
        (if (member item (cdr (member item lst)))
          (setq res (cons item res))
          ) ;_ end of if
        ) ;_ end of foreach
      (setq res (_kpblc-list-dublicates-remove (reverse res)))
      ) ;_ end of progn
    ) ;_ end of if
  res
  )
Composter вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > LISP. Помогите оптимизировать алгоритм обработки списка

 VetCAD++
Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помогите с пояснительной запиской по разделам ГСВ, ВК, ОВ, как сделать у кого есть пример помогите Shamilchik Поиск литературы, чертежей, моделей и прочих материалов 2 11.07.2015 20:04
Алгоритм брезенхема для 4 осей vova_kansk Программирование 5 16.07.2014 11:28
АЛГОРИТМ БРЕЗЕНХЕМА ПОМОГИТЕ leetoo Программирование 2 11.01.2013 20:28
Реверсивное получение списка по ключу WhiteShark Программирование 9 18.10.2012 20:44
Ошибка при зумировании листа. Алгоритм печати в модели и в листе Rask Программирование 8 30.08.2012 13:54

|| Главная || Каталог САПР || Тендеры || Публикации || Объявления || Биржа труда || Download || Галерея ||
|| Библиотека || Кунсткамера || Каталог предприятий || Контакты || Файлообменник || Блоги ||