[Pontelimon]

Добрый день !

Я совсем недавно начал пытаться что-то сделать на Lisp так что прошу сильно не ругаться =)

Вот моя первый код, он должен выделять одно строчный текст, расположенный по оси Y < -75.

Код:

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

(defun vibor ( / )
  (setq nabor2 (ssadd))
  (setq nabor (ssget "_X" (list (cons 0 "TEXT") (cons 1 "*`.###"))))
  (if (null nabor)
      (progn
	(princ "\nНету подходящего текста. ")
	(princ)
      )
      (progn
	(setq i -1 kolichestvo_repeatov (sslength nabor))
	(repeat kolichestvo_repeatov
	  (setq i (1+ i))
	  (setq konkretniy_primitiv (entget (ssname nabor i)))
	  (setq koordinata_Y (caddr (assoc 10 konkretniy_primitiv)))
	  (if (koordinata_Y < -75)
	    (ssadd (konkretniy_primitiv) nabor2)
	    );end if
	    );end repeat
	  );end progn
    );end if
  (sssetfirst nil nabor2)
  (princ)
  );end defun

Но как Вы наверное уже догадались он не работает, почему ?

P.S. Очень прошу посмотреть что можно сделать именно в моем варианте решения данной задачи.

[Pontelimon]

Точно! Спасибо за пояснения ! Вроде работает =) а еще я модифицировал ряд своих кодов, вот например ищет минимальную Х координату из всех полилиний, посмотрите, может там что-то можно еще улучшить ?

Код:

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

 (defun c:oform ( /)
(setq nabor_x '())
(setq test (ssget "_X" '((0 . "LWPOLYLINE"))))
(setq i -1 povtor (sslength test))
(repeat povtor
(setq i (1+ i))
(setq primitiv (entget (ssname test i))) 
(mapcar '(lambda (x)(if(= (car x) 10)(setq krdx (cadr x)) x)) primitiv)
(setq nabor_x (append nabor_x (list krdx)))
)
(setq minx (apply 'min nabor_x))
)

[Дима_]

Сообщение от Pontelimon может там что-то можно еще улучшить ?

Ну как тебе сказать, всегда чего-то можно улучшить. Можно последовательные setq в один объеденить - можно append на cons поменять - но это мелочи - надо научится думать "по лисповски" вот тебе пример - скажу сразу, я его накатал только для того чтоб ты "мысль" ухватил - сам бы написал изначально по другому - в этом коде много "лишних" операций, но с моей точки зрения может подвести тебя к "правильной" логике:

Код:

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

 
(vl-load-com)
(apply 'min
  (mapcar 'cadr 
     (vl-remove-if-not '(lambda (x) (= (car x) 10))
         (apply 'append
            (mapcar 'entget
               (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_x" '((0 . "lwpolyline")))))))))))

[Disney]

Сообщение от Дима_ я его накатал только для того чтоб ты "мысль" ухватил - сам бы написал изначально по другому - в этом коде много "лишних" операций

покажи как.
Опять с рекурсией?

[Дима_]

Сообщение от Disney покажи как. Опять с рекурсией?

Ну попробуй сам - "прошагивай" по набору - с одним аргументом - (самой мальенькой координатой).
p.s. с практической точки зрения конечно имеет смысл сохранить список из набора, (да и функцию я бы естественно делал получающую список на входе), но если мы рассматриваем эту задачу в отдельности, то это лишняя операция - попробуй "вытягивать нужное" сразу из него (набора).
В вышеуказанной функции мы "пробегаем" по списку 7+количество полученных элементов раз (он правда 2 раза уменьшается) - уверяю достаточно 1-го.

[Disney]

Сообщение от Дима_ Ну попробуй сам

Попробовал, сократил пару "пробегов", но получилась фигня какая-то

Код:

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

 (defun test3 (/ rec-get_vert ssget_to_list rec-f)
  (defun rec-get_vert (lwp)
    (cond
      ((= (caar lwp) 10)
       (cons (cadar lwp) (rec-get_vert (cdr lwp)))
      )
      ((cdr lwp) (rec-get_vert (cdr lwp)))
    )
  )
  (defun ssget_to_list (ss)
    (vl-remove-if
      'listp
      (mapcar 'cadr (ssnamex ss))
    )
  )
  (defun rec-f (_list)
    (if	(cdr _list)
      (append (get_vert (entget (car _list))) (rec-f (cdr _list)))
      (get_vert (entget (car _list)))
    )
  )
  (apply 'min
	 (rec-f (ssget_to_list (ssget "_x" '((0 . "lwpolyline")))))
  )
)

Как показывают тесты:
test1 - функция Pontelimon #41
test2 - функция Дима_ #42
test3 - моя #45

1 полилиния

Команда: (benchmark '((test)(test2)(test3))) Elapsed milliseconds / relative speed for 2048 iteration(s): (TEST)......1373 / 1.15 <fastest> (TEST3).....1498 / 1.05 (TEST2).....1575 / 1.00 <slowest>

100 полилиний

Команда: (benchmark '((test)(test2)(test3))) Elapsed milliseconds / relative speed for 256 iteration(s): (TEST2).....1732 / 2.48 <fastest> (TEST)......2854 / 1.50 (TEST3).....4290 / 1.00 <slowest>

1000 полилиний

Команда: (benchmark '((test)(test2)(test3))) Elapsed milliseconds / relative speed for 32 iteration(s): (TEST2)......1982 / 5.74 <fastest> (TEST).......4228 / 2.69 (TEST3).....11373 / 1.00 <slowest>

[Дима_]

1. По поводу скорости - чем никогда не славился лисп - так это скоростью работы. Он хорош скоростью разработки (если писать на нем в лисп стиле). Почему я приемуществнно (везде где возможно) использую лямбды с рекурсиями - мне это дает широчайшие возможности по корректировке кода - в моей практике (лисп и не только) постоянно корректируется ТЗ - если программа написанна в строго функциональном стиле - переправить ее в 5 раз проще и быстрее чем императивную - функции ни как не зависимы - "подводных камней" совместимости данных нет - написал один раз функцию и забыл - работать будет вн зависимости из какого места (состояния) программы ты ее вызвал.
2. Любую рекурсивную функцию можно "развернуть" в цикл - она станет на 2-5% быстрей, но потерят "изменяемость" (хорошие лисп трансляторы делают это автоматом), но написать с нуля такую-же развернутую функцию вряд-ли получится (разная логика) - хотим мы того или нет - алгоритм в деталях будет разный в зависмости от стиля.
3. Ты сейчас "закрутил" в рекурсию логику итеративной программы - потому и результат "не ахти" (получил худшие качества с обоих методов) - забудь мою (и понтелимоновскую) версию попробуй написать с нуля - не оглядываясь на логику той программы - если уже "совсем не как" - могу "свой" вариант "накалякать" (мне это не сложно) - но если хочешь действительно осознать попробуй все таки сам - подскажу лишь, что все действие делается за 1 прогон.
з.ы. выйгрыш в скорости в рекурсивной программе - может быть только из-за более удачной реализации алгоритма (с моей точки зрения это достаточно часто).

[Disney]

Сообщение от Дима_ могу "свой" вариант "накалякать" (мне это не сложно)

Сдаюсь, выкладывай.

Сообщение от Дима_ но если хочешь действительно осознать попробуй все таки сам

ни чего страшного, всему своё время, когда-то я вообще больше года смотрел на описание функций работы со списками(типа mapcar, apply, ...), но так и не понимал, что они делают и как работают, потом почти столько же времени смотрел как их применяют в своих кодах другие, а однажды наконец и я стал ими пользоваться, это оказалось на столько удобно, что я радовался как ребёнок.

[Дима_]

Сообщение от Disney Сдаюсь, выкладывай.

Для "критиков" не читавших предварительные посты повторю:

p.s. с практической точки зрения конечно имеет смысл сохранить список из набора, (да и функцию я бы естественно делал получающую список на входе), но если мы рассматриваем эту задачу в отдельности...

Код:

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

 (defun test4 (ss)
  (if ss ((lambda (min-x f-rec)
            (f-rec (1- (sslength ss)) (min-x (entget (ssname ss 0)) nil)))
          (lambda (ent-lst min-value); mix-n
            (if ent-lst
                (min-x (cdr ent-lst)
                       (if (and (= (caar ent-lst) 10)
                                (or (< (cadar ent-lst) min-value);вот сюда я рекомндую обратить пристальное внимание
                                    (not min-value)));по "простой" логике проверка должна идти в обратном порядке, но попробуй понять в чем "фишка"
                           (cadar ent-lst)
                           min-value))
                min-value))
          (lambda (i min-value);f-rec
            (if (zerop i)
                min-value
                (f-rec (1- i) (min-x (entget (ssname ss i)) min-value)))))))

p.s. если еще будут вопросы - возможно отвечу не ранее чем через неделю (сегодня улетаю - командировка в Новосибирск - не знаю что там с инетом). Удачи.
p.p.s - глюк оформления кода в 8 строке - нет там певрой ";" - просто <

[Pontelimon]

Я еще хотел уточнить вот такой простой случай:

Код:

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

 (setq Y 0)
(SSSETFIRST nil (ssget "_F" '((0 Y)(10000 Y))'((0 . "LWPOLYLINE")(8 . "TR_UP"))))

Почему тут выходить ошибка : слишком много аргументов ?
причем если написать просто :

Код:

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

 (SSSETFIRST nil (ssget "_F" '((0 0)(10000 0))'((0 . "LWPOLYLINE")(8 . "TR_UP"))))

то работает.

[Do$]

Это неправильно:

Код:

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

'((0 Y)(10000 Y))

Это правильно:

Код:

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

(list (list 0 Y)(list 10000 Y))

Код:

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

_$ (setq Y 0)
0
_$ '((0 Y)(10000 Y))
((0 Y) (10000 Y))
_$ (list (list 0 Y)(list 10000 Y))
((0 0) (10000 0))
_$

[Pontelimon]

Сообщение от Do$ Это неправильно: Код: [Выделить все] '((0 Y)(10000 Y)) Это правильно: Код: [Выделить все] (list (list 0 Y)(list 10000 Y)) Код: [Выделить все] _$ (setq Y 0) 0 _$ '((0 Y)(10000 Y)) ((0 Y) (10000 Y)) _$ (list (list 0 Y)(list 10000 Y)) ((0 0) (10000 0)) _$

Do$, спасибо вам ! ошибку понял, все заработало =)

[Disney]

Сообщение от Дима_ Код: [Выделить все] (or (< (cadar ent-lst) min-value);вот сюда я рекомндую обратить пристальное внимание 09***********************************(not min-value)));по "простой" логике проверка должна идти в обратном порядке, но попробуй понять в чем "фишка"

Ну тут всё просто, логическая функция сравнения < при первом проходе не выдаст ошибку если бы даже оба аргумента были nil, зато нам не придёться проверять все последующие проходы min-value на nil
Теперь вопросы:

1. Для чего мы сокращали количество проходов, если это ни привело ни к ускорению программы, ни к понятности кода для широких масс?
2. Чем lambda лучше defun?
3. Выложи наконец-то чисто свой код, который бы ты написал для себя безо всяких образовательных целей

Сообщение от Дима_ в Новосибирск - не знаю что там с инетом

Всё очень даже не плохо:

• полное покрытие 3G,
• бесплатный Wi-Fi во всех приличных общественных местах,
• высокоскоростной кабельный в каждом доме и офисном здание.

Сообщение от Pontelimon Почему тут выходить ошибка : слишком много аргументов ?

Пока видео делал, Do$ уже любезно ответил, но раз сделал выложу.

[gomer]

Сообщение от Disney Чем lambda лучше defun?

лямбда - это временная дефун...

[Disney]

Сообщение от Disney лямбда - это временная дефун...

"Да это то понятно..."
Например вот:

Код:

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

 
(defun test1 (test / rec_1+)
  (defun rec_1+	(lst)
    (if	lst
      (cons (1+ (car lst))
	    (rec_1+ (cdr lst))
      )
    )
  )
  (rec_1+ test)
)


(defun test2 (test / rec_1+)
  (setq	rec_1+ (lambda (lst)
		 (if lst
		   (cons (1+ (car lst))
			 (rec_1+ (cdr lst))
		   )
		 )
	       )
  )
  (rec_1+ test)
)


(defun test3 (test)
  ((lambda (rec_1+ lst)
     (rec_1+ lst)
   )
    (lambda (lst)
      (if lst
	(cons (1+ (car lst))
	      (rec_1+ (cdr lst))
	)
      )
    )
    test
  )
)
(defun test4 (test)
  (mapcar '1+ test)
)


(defun rec-f (st end)
  (if (<= st end)
    (cons st (rec-f (1+ st) end))
  )
)

во всех случаях(кроме test4) количество локальных переменных одинаковое.
ну и анализ быстродействия, хотя Дима_ уверяет, что это не показатель.
Не скомпилированный LSP

Код:

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

Команда: (setq test (rec-f 0 5))
(0 1 2 3 4 5)
Команда: (benchmark '((test1 test)(test2 test)(test3 test)(test4 test)))
Elapsed milliseconds / relative speed for 32768 iteration(s):

    (TEST2 TEST).....1326 / 1.12 <fastest>
    (TEST3 TEST).....1341 / 1.11
    (TEST1 TEST).....1373 / 1.08
    (TEST4 TEST).....1482 / 1.00 <slowest>

Команда: (setq test (rec-f 0 100))
(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 
55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 
81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100)
Команда: (benchmark '((test1 test)(test2 test)(test3 test)(test4 test)))
Elapsed milliseconds / relative speed for 32768 iteration(s):

    (TEST4 TEST).....1716 / 3.09 <fastest>
    (TEST2 TEST).....5226 / 1.01
    (TEST3 TEST).....5258 / 1.01
    (TEST1 TEST).....5304 / 1.00 <slowest>

Скомпилированный VLX

Код:

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

Команда: (setq test (rec-f 0 5))
(0 1 2 3 4 5)

Команда: (benchmark '((test1 test)(test2 test)(test3 test)(test4 test)))
Elapsed milliseconds / relative speed for 32768 iteration(s):

    (TEST2 TEST).....1232 / 1.25 <fastest>
    (TEST3 TEST).....1232 / 1.25
    (TEST1 TEST).....1248 / 1.24
    (TEST4 TEST).....1544 / 1.00 <slowest>

Команда: (setq test(rec-f 0 100))
(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 
55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 
81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100)

Команда: (benchmark '((test1 test)(test2 test)(test3 test)(test4 test)))
Elapsed milliseconds / relative speed for 32768 iteration(s):

    (TEST4 TEST).....1903 / 1.58 <fastest>
    (TEST2 TEST).....2979 / 1.01
    (TEST3 TEST).....2995 / 1.01
    (TEST1 TEST).....3011 / 1.00 <slowest>

Сообщение от gomer дефун

дифан

[gomer]

Сообщение от Disney Например вот:

А если так?

Код:

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

 (defun test2 (lst)
  (if lst 
    (cons (1+ (car lst))
          (test2 (cdr lst))
    )
  )
)

или так

Код:

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

 (mapcar '1+ '(0 1 2 3 4 5))

Disney, вы можете проверить и эти варианты???

[Disney]

Сообщение от gomer Disney, ты можешь проверить и эти варианты???

добавил mapcar

[Pontelimon]

Сообщение от Disney Пока видео делал, Do$ уже любезно ответил, но раз сделал выложу.

Спасибо за видео, все очень доходчиво объяснено.

Я бы хотел уточнить еще 1 свою функцию(срабатывает 9 раз из 10), хотелось бы добиться 100% работоспособности, есть такой вот код :

Код:

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

 (defun c:test2 ( / )
  
(setq minx 658)
(setq truba_up_sprava (ssget "_F" (list (list (+ minx 4) 0)(list (+ minx 4) 10000))'((0 . "LWPOLYLINE")(8 . "TR_UP"))))
(setq primitiv (entget (ssname truba_up_sprava 0)))
(entmod (mapcar '(lambda (x) (if(and (= (car x) 10) (= (+ minx 4) (cadr x))) (cons 10 (mapcar '- (cdr x) '(0.5 0))) x)) primitiv))
  
)

И для наглядности чертеж с полилинией на которую этот код почему-то не действует.

А должен он удлинить полилинию налево по оси Х на 0.5

[TararykovDG]

Сообщение от Pontelimon И для наглядности чертеж с полилинией на которую этот код почему-то не действует. А должен он удлинить полилинию налево по оси Х на 0.5

Не смог открыть приложенный чертеж (видимо он сохранен в версии позднее 2008), но рискну предположить, что "тамошняя" полилиния не попадает в набор формируемый строкой

Код:

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

 
(setq truba_up_sprava (ssget "_F" (list (list (+ minx 4) 0)(list (+ minx 4) 10000))'((0 . "LWPOLYLINE")(8 . "TR_UP"))))

и в общем-то такая конструкция будет срабатывать не 9 раз из 10, а может и все 10 раз не сработать, так при формировании набора с помощью методов "_F" тому подобных ("W", "WP", "C" и т. д.) корректность возвращаемого набора зависит от нескольких дополнительных факторов: границ видимость (т. е. если ваш примитив (полиниия) находяться вне видимой части экрана, то он может и не попасть в набор), можно перед ssget'ом зуммировать экран соответсвующем образом, но это мягко говоря будет плохо выгладет (когда во время выполнения программы экран начнет дергаться), лучше выбрать все полилинии на каком-то слое (ssget "_X" (list (cons 0 "LWPOLYLINE") (cons 8 "TR_UP"))) , а потом по дополнительным проверкам оставить нужную вам или вообще по-другому получать нужный примитив с чертежа

[Pontelimon]

На мой взгляд линия попадает в набор, но может я ошибаюсь. В любом случае спасибо за совет, я обязательно учту это.

Пересохранил файл для 2007 акада.

[TararykovDG]

Посмотрел файл. Дело вот в чем, при проверке

Код:

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

 
(= (+ minx 4) (cadr x))

для первой координаты получаем (= 662 662.0) что возвращает nil, так оно и есть. Можно даже срвнить (= 662.0 662.0) и в некоторых случаях получить nil (не равны)

Нужно сравнивать так

Код:

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

 
(equal (+ minx 4) (cadr x) 0.001) ; или вместо 0.001 подставть свою точность