clos и деревья - нужна подсказка
Не могу разобраться с квадрантными деревьями на лиспе, переписываю код с питона.
Суть проблемы такова:
Есть многоуровневое дерево, добавляю листья всегда в самый нижний уровень, если по пути есть пропущенные
вершины они создаются. Для создания использую рекурсивный метод, каждый раз передавая в него текущую вершину, начиная с корня и значение для листа,
на втором вызове получаю узел, который сам себе child и parent и ухожу в бесконечную рекурсию.
Общее впечатление: где-то не дочитал про clos, но что конкретно...
Код длинный, поэтому даю ссылку github.
Если для понимания нужен исходник на питоне, или трейс самой функции выложу.
Суть проблемы такова:
Есть многоуровневое дерево, добавляю листья всегда в самый нижний уровень, если по пути есть пропущенные
вершины они создаются. Для создания использую рекурсивный метод, каждый раз передавая в него текущую вершину, начиная с корня и значение для листа,
на втором вызове получаю узел, который сам себе child и parent и ухожу в бесконечную рекурсию.
Общее впечатление: где-то не дочитал про clos, но что конкретно...
Код длинный, поэтому даю ссылку github.
Если для понимания нужен исходник на питоне, или трейс самой функции выложу.
[#]
Если чисто по clos, то такие замечания:
1) Не нужно делать slot-value, вместо этого нужно слотам назначать accessor или reader,
2) Не нужно print-element - уже есть общий print-object,
3) create-tree тоже не нужен - нужно определять общий метод initialize-instance.
Т.е. как-то так:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package #:cl-vectorizer)
(defconstant +orients+ '(nw ne sw se))
(defconstant +white-color+ 0)
(defconstant +black-color+ 1)
;;;; qtree node
(defclass qtree-node ()
((size :reader size-of :initarg :size)
(level :reader level-of :initarg :level)
(label :accessor label-of :initarg :label :initform 0)
(childs :accessor childs-of :initarg :childs :initform nil)
(parent :reader parent-of :initarg :parent :initform nil)
(color :accessor color-of :initarg :color :initform nil)
(orient :accessor orient-of :initarg :orient :initform (first +orients+))
(path :accessor path-of :initarg :path :initform nil)
(density :accessor density-of :initarg :density :initform nil))
(:documentation "Quadtree base element."))
(defmethod print-object ((node qtree-node) stream)
(print-unreadable-object (node stream :type t)
(format stream "SIZE: ~A, LEVEL: ~A, LABEL: ~A, PARENT: ~A, CHILDS: ~A"
(size-of node)
(level-of node)
(label-of node)
(parent-of node)
(childs-of node))))
;;; qtree
(defclass qtree ()
((image-hash :accessor image-hash-of :initarg :image-hash :initform nil)
(size :accessor size-of :initarg :size :initform nil)
(root :accessor root-of :initarg :root :initform nil))
(:documentation "Quadtree class."))
(defmethod initialize-instance :after ((qtree qtree) &key image-hash width height)
(labels ((calculate-tree-size (value &optional (size 2))
(if (> value size)
(calculate-tree-size value (* 2 size))
size)))
(let* ((size (calculate-tree-size (max width height)))
(root (make-instance 'qtree-node :size size :level 1)))
(setf (image-hash-of qtree) image-hash)
(setf (size-of qtree) size)
(setf (root-of qtree) root))))
(defgeneric dump-tree (tree filename) (:documentation "Dump tree to a file."))
(defgeneric get-leaf (tree path) (:documentation "Get tree element by path."))
(defgeneric add-black-pixel (root pixel) (:documentation "Add black pixel to quadtree."))
;; ну и это уже после:
;; (defun make-qt ...
;; (loop for point being the hash-key of image-hash do
;; (add-black-pixel (slot-value qtree-instance 'root-element) point))
Вот ну и форматировать исходник нужно, а табы использовать - нельзя :)
add-black-pixel - не распарсил...
1) Не нужно делать slot-value, вместо этого нужно слотам назначать accessor или reader,
2) Не нужно print-element - уже есть общий print-object,
3) create-tree тоже не нужен - нужно определять общий метод initialize-instance.
Т.е. как-то так:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package #:cl-vectorizer)
(defconstant +orients+ '(nw ne sw se))
(defconstant +white-color+ 0)
(defconstant +black-color+ 1)
;;;; qtree node
(defclass qtree-node ()
((size :reader size-of :initarg :size)
(level :reader level-of :initarg :level)
(label :accessor label-of :initarg :label :initform 0)
(childs :accessor childs-of :initarg :childs :initform nil)
(parent :reader parent-of :initarg :parent :initform nil)
(color :accessor color-of :initarg :color :initform nil)
(orient :accessor orient-of :initarg :orient :initform (first +orients+))
(path :accessor path-of :initarg :path :initform nil)
(density :accessor density-of :initarg :density :initform nil))
(:documentation "Quadtree base element."))
(defmethod print-object ((node qtree-node) stream)
(print-unreadable-object (node stream :type t)
(format stream "SIZE: ~A, LEVEL: ~A, LABEL: ~A, PARENT: ~A, CHILDS: ~A"
(size-of node)
(level-of node)
(label-of node)
(parent-of node)
(childs-of node))))
;;; qtree
(defclass qtree ()
((image-hash :accessor image-hash-of :initarg :image-hash :initform nil)
(size :accessor size-of :initarg :size :initform nil)
(root :accessor root-of :initarg :root :initform nil))
(:documentation "Quadtree class."))
(defmethod initialize-instance :after ((qtree qtree) &key image-hash width height)
(labels ((calculate-tree-size (value &optional (size 2))
(if (> value size)
(calculate-tree-size value (* 2 size))
size)))
(let* ((size (calculate-tree-size (max width height)))
(root (make-instance 'qtree-node :size size :level 1)))
(setf (image-hash-of qtree) image-hash)
(setf (size-of qtree) size)
(setf (root-of qtree) root))))
(defgeneric dump-tree (tree filename) (:documentation "Dump tree to a file."))
(defgeneric get-leaf (tree path) (:documentation "Get tree element by path."))
(defgeneric add-black-pixel (root pixel) (:documentation "Add black pixel to quadtree."))
;; ну и это уже после:
;; (defun make-qt ...
;; (loop for point being the hash-key of image-hash do
;; (add-black-pixel (slot-value qtree-instance 'root-element) point))
Вот ну и форматировать исходник нужно, а табы использовать - нельзя :)
add-black-pixel - не распарсил...
[#] Ответ на комментарий от treep 23.07.2010 17:24
вот трассировка
Ошибка возникает перед вторым рекрусивным вызовом, который и приводит к бесконечной рекурсии, посему там стоит
конструкция (редактор мне не дает вставить больше одного блока кода, поэтому ссылками даю).
Причина ошибки и непонимания чуть выше -- этот код который должен выполнятся при каждом спуске по новому ноду, но после первого же спуска
он не выполняется (на трассировке нет create child! во втором вызове).
Теперь по замечаниям
1)Пока ждал ответа попробовал конструкцию with-slots, ничего не изменилось. Рефакторить дальше в эту сторону пока не хочется, потому что
есть желание устранить существующие ошибки прежде чем вносить новые =)
2) Этот говнокод никак не влияет на функциональность, но за print-object спасибо, буду использовать.
3) Это вообще УГ, но тоже не влияет принципиально на функциональность, я не гуру лиспа, мало опыта, поэтому пока делаю "чтоб работало" только потом рефакторинг, если код востребован.
Форматирует исходник emacs меня пока все устраивало, а в чем проблема с табами?
init node childs
[qtree element] #size: 256 level: 1 label: 0 parent: NIL childs: (NIL
NIL
NIL
NIL)
Root childs: (NIL NIL NIL NIL)
Add new pixel, level 1 (8 30) size: 256
create child!
[qtree element] #size: 128 level: 2 label: 0 parent: # childs: NIL
----------------------------------------
init node childs
[qtree element] #size: 128 level: 2 label: 0 parent: # childs: (#
NIL
NIL
NIL)
Root childs: (#NIL NIL NIL)
Add new pixel, level 2 (8 30) size: 128
[qtree element] #size: 128 level: 2 label: 0 parent: # childs: (#
NIL
NIL
NIL)
unhandled SIMPLE-ERROR: WTF?!! root = new-root
Ошибка возникает перед вторым рекрусивным вызовом, который и приводит к бесконечной рекурсии, посему там стоит
конструкция (редактор мне не дает вставить больше одного блока кода, поэтому ссылками даю).
Причина ошибки и непонимания чуть выше -- этот код который должен выполнятся при каждом спуске по новому ноду, но после первого же спуска
он не выполняется (на трассировке нет create child! во втором вызове).
Теперь по замечаниям
1)Пока ждал ответа попробовал конструкцию with-slots, ничего не изменилось. Рефакторить дальше в эту сторону пока не хочется, потому что
есть желание устранить существующие ошибки прежде чем вносить новые =)
2) Этот говнокод никак не влияет на функциональность, но за print-object спасибо, буду использовать.
3) Это вообще УГ, но тоже не влияет принципиально на функциональность, я не гуру лиспа, мало опыта, поэтому пока делаю "чтоб работало" только потом рефакторинг, если код востребован.
Форматирует исходник emacs меня пока все устраивало, а в чем проблема с табами?
[#] Ответ на комментарий от selead 23.07.2010 17:55
Трассировка таки не вставилась по человечески
init node childs
[qtree element] #<QTREE-ELEMENT {10035632A1}> size: 256 level: 1 label: 0 parent: NIL childs: (NIL
NIL
NIL
NIL)
Root childs: (NIL NIL NIL NIL)
Add new pixel, level 1 (8 30) size: 256
create child!
[qtree element] #<QTREE-ELEMENT {100371C871}> size: 128 level: 2 label: 0 parent: #<QTREE-ELEMENT
{10035632A1}> childs: NIL
----------------------------------------
init node childs
[qtree element] #<QTREE-ELEMENT {100371C871}> size: 128 level: 2 label: 0 parent: #<QTREE-ELEMENT
{10035632A1}> childs: (#<QTREE-ELEMENT
{100371C871}>
NIL
NIL
NIL)
Root childs: (#<QTREE-ELEMENT {100371C871}> NIL NIL NIL)
Add new pixel, level 2 (8 30) size: 128
[qtree element] #<QTREE-ELEMENT {100371C871}> size: 128 level: 2 label: 0 parent: #<QTREE-ELEMENT
{10035632A1}> childs: (#<QTREE-ELEMENT
{100371C871}>
NIL
NIL
NIL)
unhandled SIMPLE-ERROR: WTF?!! root = new-root
[qtree element] #<QTREE-ELEMENT {10035632A1}> size: 256 level: 1 label: 0 parent: NIL childs: (NIL
NIL
NIL
NIL)
Root childs: (NIL NIL NIL NIL)
Add new pixel, level 1 (8 30) size: 256
create child!
[qtree element] #<QTREE-ELEMENT {100371C871}> size: 128 level: 2 label: 0 parent: #<QTREE-ELEMENT
{10035632A1}> childs: NIL
----------------------------------------
init node childs
[qtree element] #<QTREE-ELEMENT {100371C871}> size: 128 level: 2 label: 0 parent: #<QTREE-ELEMENT
{10035632A1}> childs: (#<QTREE-ELEMENT
{100371C871}>
NIL
NIL
NIL)
Root childs: (#<QTREE-ELEMENT {100371C871}> NIL NIL NIL)
Add new pixel, level 2 (8 30) size: 128
[qtree element] #<QTREE-ELEMENT {100371C871}> size: 128 level: 2 label: 0 parent: #<QTREE-ELEMENT
{10035632A1}> childs: (#<QTREE-ELEMENT
{100371C871}>
NIL
NIL
NIL)
unhandled SIMPLE-ERROR: WTF?!! root = new-root
[#] Ответ на комментарий от selead 23.07.2010 17:58
> Трассировка таки не вставилась по человечески
А как вставлял? В смысле это техническая сбой в работе форума?
[#] Ответ на комментарий от archimag 23.07.2010 18:02
Подумал что раз это трассировка а не код, надо выбрать none, разницу c basic lisp можно посмотреть сравнив два поста.
Кстати, после нажатия препросмотр невозможно вставить другой код - при нажатии кнопки появляется окно препросмотра которое
не исчезает до перезагрузки страницы.
клиент: Mozilla/5.0 (Macintosh; U; Intel Mac OS X 10.6; ru; rv:1.9.2.7) Gecko/20100713 Firefox/3.6.7
только что проверил еще раз, ситуация повторилась, так что можно расценивать как сбой )
Кстати, после нажатия препросмотр невозможно вставить другой код - при нажатии кнопки появляется окно препросмотра которое
не исчезает до перезагрузки страницы.
клиент: Mozilla/5.0 (Macintosh; U; Intel Mac OS X 10.6; ru; rv:1.9.2.7) Gecko/20100713 Firefox/3.6.7
только что проверил еще раз, ситуация повторилась, так что можно расценивать как сбой )
[#] Ответ на комментарий от selead 23.07.2010 18:29
Угу, по крайней мере один косяк увидел, спасибо, посмотрю что не так.
[#] Ответ на комментарий от selead 23.07.2010 17:55
Короче там и правда в clos была проблема, вот рабочий (с точки зрения завершимости clos методов - не знаю что у тебя там за картинки такие) код:
http://lisper.ru/apps/format/148
А вот замечания по существу:
1) Если делать print дерева у которого есть и слот "предок" и слот "дети", то нельзя печатать их одновременно (иначе будет бесконечная рекурсия - дети будут печатать предков, а те детей и т.д.)
2) Нельзя делать
нужно сначала сформировать список и потом сделать
4) Ещё там кое-какие мелкие изменения.
5) А для сохранения класса в файл могу посоветовать либу cl-store.
http://lisper.ru/apps/format/148
А вот замечания по существу:
1) Если делать print дерева у которого есть и слот "предок" и слот "дети", то нельзя печатать их одновременно (иначе будет бесконечная рекурсия - дети будут печатать предков, а те детей и т.д.)
2) Нельзя делать
нужно сначала сформировать список и потом сделать
(setf (childs-of root) (my-make-list ...))
3) qtree нужно, очевидно, наследовать от qtree-element а не дублировать слоты.4) Ещё там кое-какие мелкие изменения.
5) А для сохранения класса в файл могу посоветовать либу cl-store.
[#] Ответ на комментарий от selead 23.07.2010 17:55
>> Форматирует исходник emacs меня пока все устраивало, а в чем проблема с
табами?
Такие же проблемы что и при
при том что в CL повсеместно такое форматирование - вот табы никто и не использует. Сделай в emacs:
Такие же проблемы что и при
some_c_function (char *a,
char *b,
char *c)
{
...
}
char *b,
char *c)
{
...
}
при том что в CL повсеместно такое форматирование - вот табы никто и не использует. Сделай в emacs:
(setq-default indent-tabs-mode nil)
а если ещё в файлах писать
;;;; -*- indent-tabs-mode: nil -*-
то табы не возникнут при всём желании :)
а если ещё в файлах писать
;;;; -*- indent-tabs-mode: nil -*-
то табы не возникнут при всём желании :)
[#] Ответ на комментарий от treep 23.07.2010 22:30
Дело сдвинулось с мертвой точки благодаря функции
, но хочется разобраться почему нужно использовать подобные функции вместо того чтобы вставлять в нужное через setf,
как это у меня сделано например в питоне, ведь фактически получается childs это список указателей, так почему тогда нельзя подменить в нем
только один элемент?
деревья у меня большие несколько тысяч вершин, поэтому спрашиваю не только из любопытства, но и для повышения производительности, (declare ...) тоже подойдет,
если поможет.
за тюнинг emacs отдельное человеческое спасибо!
(defun my-make-list (size index value &key initial-element)
`(,@(make-list index :initial-element initial-element)
,value
,@(make-list (- size index 1) :initial-element initial-element)))
`(,@(make-list index :initial-element initial-element)
,value
,@(make-list (- size index 1) :initial-element initial-element)))
, но хочется разобраться почему нужно использовать подобные функции вместо того чтобы вставлять в нужное через setf,
как это у меня сделано например в питоне, ведь фактически получается childs это список указателей, так почему тогда нельзя подменить в нем
только один элемент?
деревья у меня большие несколько тысяч вершин, поэтому спрашиваю не только из любопытства, но и для повышения производительности, (declare ...) тоже подойдет,
если поможет.
за тюнинг emacs отдельное человеческое спасибо!
[#] Ответ на комментарий от selead 24.07.2010 01:42
Это я ошибся (не знал про nth) - на самом деле можно делать:
Вот add-pixel, который опять перестал работать:
Присоединяюсь к вопросу, что за ерунда?
Если не использовать слот parent, то всё равно то же самое.
(setf (nth index (accessor-of instance)) value)
но нельзя
(let ((slot (nth index (accessor-of instance))))
(setf slot value))
Но нужно точно знать, что возвращаемое значение "сетэфабельно" - как в случае с car/cdr/... или nth.но нельзя
(let ((slot (nth index (accessor-of instance))))
(setf slot value))
Вот add-pixel, который опять перестал работать:
(defmethod add-pixel ((node qtree-node) x y &optional (color +black-color+))
(flet ((calculate-index (x y half-size)
(cond ((and (< x half-size) (< y half-size)) (values 0 x y))
((and (>= x half-size) (< y half-size)) (values 1 (- half-size x) y))
((and (< x half-size) (>= y half-size)) (values 2 x (- half-size y)))
(t (values 3 (- half-size x) (- half-size y))))))
(if (= 1 (size-of node))
(setf (color-of node) color)
(let ((half-size (/ (size-of node) 2)))
(multiple-value-bind (index x y) (calculate-index x y half-size)
(when (null (nth index (childs-of node)))
(setf (nth index (childs-of node))
(make-instance 'qtree-node
:size half-size
:level (1+ (level-of node))
:parent node
:color +white-color+
:orient index)))
(when (first (childs-of node))
(format t "node: ~A~%" (childs-of node))
(format t "first: ~A~%" (childs-of (first (childs-of node))))
(when (equal node (first (childs-of node)))
(error "WTF?!! node = new-node"))
(setf (first (childs-of node))
(add-pixel (first (childs-of node)) x y color))))))
node))
(flet ((calculate-index (x y half-size)
(cond ((and (< x half-size) (< y half-size)) (values 0 x y))
((and (>= x half-size) (< y half-size)) (values 1 (- half-size x) y))
((and (< x half-size) (>= y half-size)) (values 2 x (- half-size y)))
(t (values 3 (- half-size x) (- half-size y))))))
(if (= 1 (size-of node))
(setf (color-of node) color)
(let ((half-size (/ (size-of node) 2)))
(multiple-value-bind (index x y) (calculate-index x y half-size)
(when (null (nth index (childs-of node)))
(setf (nth index (childs-of node))
(make-instance 'qtree-node
:size half-size
:level (1+ (level-of node))
:parent node
:color +white-color+
:orient index)))
(when (first (childs-of node))
(format t "node: ~A~%" (childs-of node))
(format t "first: ~A~%" (childs-of (first (childs-of node))))
(when (equal node (first (childs-of node)))
(error "WTF?!! node = new-node"))
(setf (first (childs-of node))
(add-pixel (first (childs-of node)) x y color))))))
node))
Присоединяюсь к вопросу, что за ерунда?
(childs-of (make-instance 'qtree-node :size 64))
(NIL NIL NIL NIL)
(add-pixel (make-instance 'qtree-node :size 64) 1 2)
ERROR
(childs-of (make-instance 'qtree-node :size 64))
(#<QTREE-NODE SIZE: 32, LEVEL: 2, LABEL: 0> NIL NIL NIL)
(NIL NIL NIL NIL)
(add-pixel (make-instance 'qtree-node :size 64) 1 2)
ERROR
(childs-of (make-instance 'qtree-node :size 64))
(#<QTREE-NODE SIZE: 32, LEVEL: 2, LABEL: 0> NIL NIL NIL)
Если не использовать слот parent, то всё равно то же самое.
[#] Ответ на комментарий от treep 24.07.2010 20:00
У меня самого было много ошибок, основные исправил,
проблема была в том что my-make-list работает совсем не так как я ожидал:
функция создает список из элементов и вставляет один на заданное место,
при этом если исходный список уже существует - он полностью уничтожается;
когда у меня получилось дерево, где на каждом уровне по одной вершине, притом что я добавлял в него >100к точек,
это слегка обескуражило, но задачу решил с помощью банального кода поставил вместо my-make-list :
Из существенных ошибок – в коде перепутал местами значения и получал отрицательные координаты точек, правильный add-black-pixel должен выглядеть так:
Что касается самих классов, то не согласен наследовать дерево от узла - это логически неверно, к тому же дереву достаточно 3 слота,
а вот методы уже можно переопределять как заблагорассудиться (например так , кстати по этой ссылке весь обновленный код не вошедший в пост=) ).
Так что проблема фактически решена, но есть еще один смежный вопрос:
Позаимствовал идею у treep'a
мой оригинальный код был такой
однако не слишком ли большой расход памяти оно за собой влечет, какое ваше мнение?
Для справки, одно из построенных деревьев имеет 211690 узлов и 139095 из них имеют значение дочерних '(nil nil nil nil).
P.S. теперь вставка работает как надо, спасибо.
проблема была в том что my-make-list работает совсем не так как я ожидал:
функция создает список из элементов и вставляет один на заданное место,
при этом если исходный список уже существует - он полностью уничтожается;
когда у меня получилось дерево, где на каждом уровне по одной вершине, притом что я добавлял в него >100к точек,
это слегка обескуражило, но задачу решил с помощью банального кода поставил вместо my-make-list :
(defun update-list (list index new-value)
(let ((new-list (copy-list list)))
(setf (nth index new-list) new-value)
new-list))
(let ((new-list (copy-list list)))
(setf (nth index new-list) new-value)
new-list))
Из существенных ошибок – в коде перепутал местами значения и получал отрицательные координаты точек, правильный add-black-pixel должен выглядеть так:
(defmethod add-black-pixel ((root qtree-node) x y)
(with-slots (size childs level color) root
(cond
((= 1 size) ; hit the bottom
(progn
(setf color +black-color+)))
(t
(let ((half-size (/ size 2))
(index 3)
new-root)
(cond
((and ; nw - first half
(< x half-size)
(< y half-size))
(setf index 0))
((and ; ne - second half
(>= x half-size)
(< y half-size))
(setf index 1)
(setf x (- x half-size)))
((and ; sw - third half
(< x half-size)
(>= y half-size))
(setf index 2)
(setf y (- y half-size)))
(t ; se fourth half, index already set in let
(setf x (- x half-size))
(setf y (- y half-size))))
(when (null (nth index childs))
(let ((child (make-instance 'qtree-node
:size half-size
:level (1+ level)
:parent root
:color +white-color+
:orient index)))
(setf childs (update-list childs index child))))
(setf new-root (nth index childs))
(when (equal root new-root) (error "WTF!!!!?"))
(add-black-pixel new-root x y))))))
(with-slots (size childs level color) root
(cond
((= 1 size) ; hit the bottom
(progn
(setf color +black-color+)))
(t
(let ((half-size (/ size 2))
(index 3)
new-root)
(cond
((and ; nw - first half
(< x half-size)
(< y half-size))
(setf index 0))
((and ; ne - second half
(>= x half-size)
(< y half-size))
(setf index 1)
(setf x (- x half-size)))
((and ; sw - third half
(< x half-size)
(>= y half-size))
(setf index 2)
(setf y (- y half-size)))
(t ; se fourth half, index already set in let
(setf x (- x half-size))
(setf y (- y half-size))))
(when (null (nth index childs))
(let ((child (make-instance 'qtree-node
:size half-size
:level (1+ level)
:parent root
:color +white-color+
:orient index)))
(setf childs (update-list childs index child))))
(setf new-root (nth index childs))
(when (equal root new-root) (error "WTF!!!!?"))
(add-black-pixel new-root x y))))))
Что касается самих классов, то не согласен наследовать дерево от узла - это логически неверно, к тому же дереву достаточно 3 слота,
а вот методы уже можно переопределять как заблагорассудиться (например так , кстати по этой ссылке весь обновленный код не вошедший в пост=) ).
Так что проблема фактически решена, но есть еще один смежный вопрос:
Позаимствовал идею у treep'a
мой оригинальный код был такой
(childs :initarg :childs :initform nil)
и 4 пустые вершины добавлялись при первой вставке в нижележащий узел, т.о. решение treep'a выглядит более элегантно,однако не слишком ли большой расход памяти оно за собой влечет, какое ваше мнение?
Для справки, одно из построенных деревьев имеет 211690 узлов и 139095 из них имеют значение дочерних '(nil nil nil nil).
P.S. теперь вставка работает как надо, спасибо.
[#] Ответ на комментарий от selead 24.07.2010 23:46
Отлично )
>> однако не слишком ли большой расход памяти оно за собой влечет, какое ваше мнение?
Я думаю, что это не критично (не критично количество листов по отношению ко всему дереву, и не критичен размер списка '(nil nil nil nil))
>> Что касается самих классов, то не согласен наследовать дерево от узла - это логически неверно, к тому же дереву достаточно 3 слота,
Ничего не поделать - нужно наследовать и всё тут :) И вообще весь код надо переписать.
>> однако не слишком ли большой расход памяти оно за собой влечет, какое ваше мнение?
Я думаю, что это не критично (не критично количество листов по отношению ко всему дереву, и не критичен размер списка '(nil nil nil nil))
>> Что касается самих классов, то не согласен наследовать дерево от узла - это логически неверно, к тому же дереву достаточно 3 слота,
Ничего не поделать - нужно наследовать и всё тут :) И вообще весь код надо переписать.
[#] Ответ на комментарий от treep 25.07.2010 00:44
К слову, в первом приближении наследование нужно понимать как 1) агрегацию слотов (а у тебя они дублируется) 2) Наследование методов предка. В данном случае дерево это qtree-node (и все tree-like операции нужно делать с ним), а qtree это просто добавление слота image-hash и методов, которым этот слот нужен.
[#] Ответ на комментарий от treep 25.07.2010 00:47
> 1) агрегацию слотов (а у тебя они дублируется)
у меня дублируется 1 слот (size) но семантически он имеет другое значение поэтому слоты не дублируются фактически, к тому же тащить лишние слоты
не то чтобы накладно, но как-то неверно imho, потому что дерево это дерево а узел это узел
> 2) Наследование методов предка
Методы то разные, у дерева обход и построение (в квадрантных деревьях баланс неплохо сохраняется сам по себе, сортировка не нужна),
а у листьев и узлов – получение и запись данных в самих узлах.
>И вообще весь код надо переписать.
код работает, хоть и не совсем правильно, но все же быстрее чем на питоне, так что моя цель достигнута,
если совсем нестерпимо станет, можно форкнуть и показать как надо ;)
>Я думаю, что это не критично (не критично количество листов по отношению ко всему дереву, и не критичен размер списка '(nil nil nil nil))
переформулирую вопрос, если я в слоте храню nil или '(nil nil nil nil)), то фактически получается что хранится указатель на значение или само значение?
потому что если указатель то наверно все-равно, хотя возможно (не уверен) что если сделать '(nil nil nil nil)) константой, и сохранять ее, расход памяти будет меньше,
а вот если хранится значение, то получается в 4 раза больше чем должно быть (по этой причине, в частности я не храню пусть от корня к вершине, хотя он мне нужен,
а вычисляю его по необходимости, ибо с путями дерево слишком жирное получается), следовательно для моего примера разница будет в 410к лишних "ячеек" памяти,
что жирно!
у меня дублируется 1 слот (size) но семантически он имеет другое значение поэтому слоты не дублируются фактически, к тому же тащить лишние слоты
не то чтобы накладно, но как-то неверно imho, потому что дерево это дерево а узел это узел
> 2) Наследование методов предка
Методы то разные, у дерева обход и построение (в квадрантных деревьях баланс неплохо сохраняется сам по себе, сортировка не нужна),
а у листьев и узлов – получение и запись данных в самих узлах.
>И вообще весь код надо переписать.
код работает, хоть и не совсем правильно, но все же быстрее чем на питоне, так что моя цель достигнута,
если совсем нестерпимо станет, можно форкнуть и показать как надо ;)
>Я думаю, что это не критично (не критично количество листов по отношению ко всему дереву, и не критичен размер списка '(nil nil nil nil))
переформулирую вопрос, если я в слоте храню nil или '(nil nil nil nil)), то фактически получается что хранится указатель на значение или само значение?
потому что если указатель то наверно все-равно, хотя возможно (не уверен) что если сделать '(nil nil nil nil)) константой, и сохранять ее, расход памяти будет меньше,
а вот если хранится значение, то получается в 4 раза больше чем должно быть (по этой причине, в частности я не храню пусть от корня к вершине, хотя он мне нужен,
а вычисляю его по необходимости, ибо с путями дерево слишком жирное получается), следовательно для моего примера разница будет в 410к лишних "ячеек" памяти,
что жирно!
[#] Ответ на комментарий от selead 25.07.2010 04:31
>> переформулирую вопрос, если я в слоте храню nil или '(nil nil nil
nil)), то фактически получается что хранится указатель на значение или
само значение?
Указатель на значение, уникальное для каждой инстанции. Так что и в правду - лучше ввести константу +empty-childs+ = '(nil nil nil nil). И если выделяются действительно большие деревья, то можно использовать функцию (room) чтобы смотреть на состояние рантайма, ну и инспектор классов из slime.
Насчёт стилистики - прост работает это конечно хорошо, но ты ведь не стал переделывать код согласно тем советам и примерам которые я привел. Почему?
Указатель на значение, уникальное для каждой инстанции. Так что и в правду - лучше ввести константу +empty-childs+ = '(nil nil nil nil). И если выделяются действительно большие деревья, то можно использовать функцию (room) чтобы смотреть на состояние рантайма, ну и инспектор классов из slime.
Насчёт стилистики - прост работает это конечно хорошо, но ты ведь не стал переделывать код согласно тем советам и примерам которые я привел. Почему?
[#] Ответ на комментарий от selead 25.07.2010 04:31
>> если совсем нестерпимо станет, можно форкнуть и показать как надо ;)
Предлагаешь вооружится перочинным ножичком и начать охоту на негодно написанный код ?) Боюсь, много придётся форкать. К тому же, я не уверен пока, что сам способен писать хороший код ;)
Предлагаешь вооружится перочинным ножичком и начать охоту на негодно написанный код ?) Боюсь, много придётся форкать. К тому же, я не уверен пока, что сам способен писать хороший код ;)
[#] Ответ на комментарий от selead 25.07.2010 04:31
Писать '(nil nil nil nil) в:
(childs :accessor childs-of :initarg :childs :initform '(nil nil nil nil))
плохо, так как лисп-система (sbcl), при прочтении программы выделит для неё
память и любой вызов setf c (child-of node) будет модифицировать одну и ту
же область памяти. Именно поэтому, в посте treep'a после ошибочного вызова
(add-pixel (make-instance 'qtree-node :size 64) 1 2)
ERROR
Повторный вызов:
(childs-of (make-instance 'qtree-node :size 64))
вместо '(nil nil nil nil) возвращал неожиданное значение:
(#<QTREE-NODE SIZE: 32, LEVEL: 2, LABEL: 0> NIL NIL NIL)
И именно поэтому рекурсивный вызов add-pixel возвращает ошибку. Т.е.
(child-of node) = (child-of (first (child-of node)))
Чтобы было понятней: значение :initform в слоте childs - '(nil nil nil nil)
считывается один раз при определении класса и далее, каждый создаваемый объект
получает указатель на одно и тоже место в оперативной памяти.
copy-list понятно дело решает проблему:
(childs :accessor childs-of :initarg :childs :initform (copy-list '(nil nil nil nil)))
(childs :accessor childs-of :initarg :childs :initform '(nil nil nil nil))
плохо, так как лисп-система (sbcl), при прочтении программы выделит для неё
память и любой вызов setf c (child-of node) будет модифицировать одну и ту
же область памяти. Именно поэтому, в посте treep'a после ошибочного вызова
(add-pixel (make-instance 'qtree-node :size 64) 1 2)
ERROR
Повторный вызов:
(childs-of (make-instance 'qtree-node :size 64))
вместо '(nil nil nil nil) возвращал неожиданное значение:
(#<QTREE-NODE SIZE: 32, LEVEL: 2, LABEL: 0> NIL NIL NIL)
И именно поэтому рекурсивный вызов add-pixel возвращает ошибку. Т.е.
(child-of node) = (child-of (first (child-of node)))
Чтобы было понятней: значение :initform в слоте childs - '(nil nil nil nil)
считывается один раз при определении класса и далее, каждый создаваемый объект
получает указатель на одно и тоже место в оперативной памяти.
copy-list понятно дело решает проблему:
(childs :accessor childs-of :initarg :childs :initform (copy-list '(nil nil nil nil)))
[#] Ответ на комментарий от treep 25.07.2010 18:23
Наверное, не косяк а фича ;)
Ведь гибко же: если надо, пускай разделяют один и тот же объект, если нет - можно подходить с точки зрения реактивных ячеек, типа такого:
cells'ы могут быть генераторами и т.д.
Ведь гибко же: если надо, пускай разделяют один и тот же объект, если нет - можно подходить с точки зрения реактивных ячеек, типа такого:
cells'ы могут быть генераторами и т.д.
[#] Ответ на комментарий от treep 25.07.2010 17:45
>Насчёт стилистики - прост работает это конечно хорошо, но ты ведь не
стал переделывать код согласно тем советам и примерам которые я привел.
Почему?
Неправда. Посмотри еще раз код в репо я переделал практически все, кроме :accessor и :reader,
их не переделал потому что вместо этого использую конструкцию with-slots, и у меня это не единственный файл в библиотеке где нет :accessor и :reader а перелопачивать весь код тупо нет времени
но если найду что with-slots хуже :accessor и иже с ним - то конечно переделаю как время появится, к тому же (субъективно), конструкция foo-of слишком напоминает свойства которые надо определять чтобы тупо установить и считать значение переменной (потому как я не проверяю переменные для слотов перед установкой), слишком много имплементарщины (опять же субъективно).
А еще обязательно в ближайшем времени посмотрю room.
Код конечно можно не форкать, я сам бы не стал, а подискутировать - пожалуйста =)
Неправда. Посмотри еще раз код в репо я переделал практически все, кроме :accessor и :reader,
их не переделал потому что вместо этого использую конструкцию with-slots, и у меня это не единственный файл в библиотеке где нет :accessor и :reader а перелопачивать весь код тупо нет времени
но если найду что with-slots хуже :accessor и иже с ним - то конечно переделаю как время появится, к тому же (субъективно), конструкция foo-of слишком напоминает свойства которые надо определять чтобы тупо установить и считать значение переменной (потому как я не проверяю переменные для слотов перед установкой), слишком много имплементарщины (опять же субъективно).
А еще обязательно в ближайшем времени посмотрю room.
Код конечно можно не форкать, я сам бы не стал, а подискутировать - пожалуйста =)
[#] Ответ на комментарий от LinkFly 25.07.2010 18:10
> copy-list понятно дело решает проблему:
> (childs :accessor childs-of :initarg :childs :initform (copy-list '(nil nil nil nil)))
вот его то я и искал, но только копировать нужно при обращении на запись а не на чтение, что и сделано при установке слота
Теперь, когда я знаю как проверить проведу тесты о опишу результаты в одном из следующих каментов
> (childs :accessor childs-of :initarg :childs :initform (copy-list '(nil nil nil nil)))
вот его то я и искал, но только копировать нужно при обращении на запись а не на чтение, что и сделано при установке слота
(defun update-list (list index new-value)
"Update one element of list (with `index`) with `new-value`. Create a copy of list and
then update it."
(let ((new-list (copy-list list)))
(setf (nth index new-list) new-value)
new-list))
"Update one element of list (with `index`) with `new-value`. Create a copy of list and
then update it."
(let ((new-list (copy-list list)))
(setf (nth index new-list) new-value)
new-list))
(setf childs (update-list childs index child))))
Теперь, когда я знаю как проверить проведу тесты о опишу результаты в одном из следующих каментов
[#] Ответ на комментарий от Ander Skirnir 25.07.2010 19:40
да я бы тоже согласился с фичей, но в моем случае напрашивается или константа или одна разделяемая ячейка памяти.
сами константы как-то немного странно работают при переустановке пакета в sbcl, я читал ссылки которые он выдает,
но не понял что к чему, поэтому использую константы по-минимуму до прихода просветления)
сами константы как-то немного странно работают при переустановке пакета в sbcl, я читал ссылки которые он выдает,
но не понял что к чему, поэтому использую константы по-минимуму до прихода просветления)
[#] Ответ на комментарий от Ander Skirnir 25.07.2010 19:40
Только я там в (demacro cell ...) еще одни скобки вокруг лямбды забыл.
[#] Ответ на комментарий от selead 25.07.2010 19:41
>> Посмотри еще раз код в репо
Там всё так же, я посмотрел. Если говорить только о файле qtree.lisp, то я предлагаю вот что:
1) Список +orients+ должен быть списком keywords а не просто symbols:
2) make-qt не должна быть в начале файла - либо в конце, либо в другом файле. Она использует создание класса qtree, который определён ниже, а в CL принято писать от низкоуровневых вещей к вещам более высокого уровня. Кроме того, сокращать qtree как qt (в let или ещё где-то) - плохо, нужно писать по большей мере подробные имена (тут - просто qtree), даже в let.
3) В строках документации упоминания аргументов пишут БОЛЬШИМИ буквами:
4) Опять ты вводишь generic+method для print-qtree-node, тогда как всегда для каждого класса нужно вводить метод print-object (соответствующий generic есть, он стандартен). И generic+method для print-tree тоже - print-object, же.
5) create-tree - как я говорил, достаточно использовать стандартный initialize-instance
6) Какая-то путаница в именах - root и node, нужно везде писать node.
7) eval-func - вовсе не eval, просто f, fun или function (скорее всего второе).
8) Нужно выделить loop из initialize-instance в отдельный метод feel.
^ твой первый вариант я сначала написал так http://lisper.ru/apps/format/148
9) Куски cond-ов или dolist-ов внутри методов в которых несколько раз совершается setf - сбивают с толку. Вообще функции которые выполняют свою работу путём постоянного переприсваивания своих аргументов - это плохо. Как пример - вот в посте add-pixel написан без этого (там можно даже увидеть матрицу индексов в calculate-index, а, согласись, когда она видна вероятность что-то в ней перепутать мала).
Кстати, (size-of qtree) = (size-of (root-node-of qtree)) или нет?
Но я, конечно, не настаиваю, особо спорить тут не о чем. А вот векторизатор это в любом случае хорошо :)
Там всё так же, я посмотрел. Если говорить только о файле qtree.lisp, то я предлагаю вот что:
1) Список +orients+ должен быть списком keywords а не просто symbols:
keywords это такие константные символы в CL, сравнение которых проходит особенно эффективно (это сравнение указателей).(defvar +orients+ '(:nw :ne :sw :se))
2) make-qt не должна быть в начале файла - либо в конце, либо в другом файле. Она использует создание класса qtree, который определён ниже, а в CL принято писать от низкоуровневых вещей к вещам более высокого уровня. Кроме того, сокращать qtree как qt (в let или ещё где-то) - плохо, нужно писать по большей мере подробные имена (тут - просто qtree), даже в let.
3) В строках документации упоминания аргументов пишут БОЛЬШИМИ буквами:
"Make a quadtree of image from INPUT-FILE and save it to OUTPUT-FILE."опять таки, сокращения infile/outfile выглядят странно - пиши английские фразы через чёрточку :) т.е. input-file, output-file. Например, когда emacs подсказывает аргументы функций (особенно &key) ты можешь заметить что их имена - это полные английский слова/фразы. То же самое про w, h, ht, qt в блоке let.4) Опять ты вводишь generic+method для print-qtree-node, тогда как всегда для каждого класса нужно вводить метод print-object (соответствующий generic есть, он стандартен). И generic+method для print-tree тоже - print-object, же.
5) create-tree - как я говорил, достаточно использовать стандартный initialize-instance
6) Какая-то путаница в именах - root и node, нужно везде писать node.
7) eval-func - вовсе не eval, просто f, fun или function (скорее всего второе).
8) Нужно выделить loop из initialize-instance в отдельный метод feel.
^ твой первый вариант я сначала написал так http://lisper.ru/apps/format/148
9) Куски cond-ов или dolist-ов внутри методов в которых несколько раз совершается setf - сбивают с толку. Вообще функции которые выполняют свою работу путём постоянного переприсваивания своих аргументов - это плохо. Как пример - вот в посте add-pixel написан без этого (там можно даже увидеть матрицу индексов в calculate-index, а, согласись, когда она видна вероятность что-то в ней перепутать мала).
Кстати, (size-of qtree) = (size-of (root-node-of qtree)) или нет?
Но я, конечно, не настаиваю, особо спорить тут не о чем. А вот векторизатор это в любом случае хорошо :)
[#] Ответ на комментарий от treep 25.07.2010 20:37
Предложения принимаются, но раз уж рефакторить, то и я пройдусь по пунктам, с вашего позволения)
1) Не знал, вообще планировал это закоментировать, потому что в коде использую цифры 0-3
2) Согласен, но это рабочий момент, код не в master'e а в форке пока что
3) Спасибо, вспомнил
4) Это вообще просто попробовал как работает, clos изучаю параллельно с написанием кода, тоже не будет в master
5) Изменил вчера, пока что в локальном репо
6) Старался использовать node там где операции над qtree-node и root там где операции над деревом,
не очень удачный выбор, но %-5 все исправит в конечном счете
7) Как назвать функцию которая вычисляется над каждым узлом ?
по мне eval-func более очевидно чем f, fun или function
8) тут пожалуйста поподробнее, название feel у меня не вызывает никаких ассоциаций,
страница http://lisper.ru/apps/format/148 тоже не дает исчерпывающей документации насчет того что это должно быть.
9) это как-то связано с макросом MULTIPLE-VALUE-BIND ? Вообще cond и when стараюсь всегда использовать вместо if,
возможно для кого-то это не настолько очевидно как if, но мне такой код поддерживать много проще; по большому счету
можно объединить с п 8) и просить более подробных объяснений
>Кстати, (size-of qtree) = (size-of (root-node-of qtree)) или нет?
размер дерева равен размеру его корневого узла, но размер дерева это абсолютная величина, а размер узла относительная.
1) Не знал, вообще планировал это закоментировать, потому что в коде использую цифры 0-3
2) Согласен, но это рабочий момент, код не в master'e а в форке пока что
3) Спасибо, вспомнил
4) Это вообще просто попробовал как работает, clos изучаю параллельно с написанием кода, тоже не будет в master
5) Изменил вчера, пока что в локальном репо
6) Старался использовать node там где операции над qtree-node и root там где операции над деревом,
не очень удачный выбор, но %-5 все исправит в конечном счете
7) Как назвать функцию которая вычисляется над каждым узлом ?
по мне eval-func более очевидно чем f, fun или function
8) тут пожалуйста поподробнее, название feel у меня не вызывает никаких ассоциаций,
страница http://lisper.ru/apps/format/148 тоже не дает исчерпывающей документации насчет того что это должно быть.
9) это как-то связано с макросом MULTIPLE-VALUE-BIND ? Вообще cond и when стараюсь всегда использовать вместо if,
возможно для кого-то это не настолько очевидно как if, но мне такой код поддерживать много проще; по большому счету
можно объединить с п 8) и просить более подробных объяснений
>Кстати, (size-of qtree) = (size-of (root-node-of qtree)) или нет?
размер дерева равен размеру его корневого узла, но размер дерева это абсолютная величина, а размер узла относительная.
[#] Ответ на комментарий от selead 25.07.2010 21:25
>> 7) Как назвать функцию которая вычисляется над каждым узлом ? по мне eval-func более очевидно чем f, fun или function
В ФВП (функциях высшего порядка) все зовут их fun (от function) для map-подобных преобразований и pred (от predicate) для filter-подобных. Слово eval тут выглядит очень странно )
>> 8)
Ты создаещь qtree-node описываешь что-то в initialize-instanse, а далее в loop ты его, как я понял, закрашиваешь - вот это закрашивание можно выделить в отдельный метод, так как оно работает, по сути, со слотом image-hash (qtree) тогда как остальные операции initialize-instanse выполняются для слотов qtree-node.
>> это как-то связано с макросом MULTIPLE-VALUE-BIND ?
calculate-index - чистая функция, там нет присваивания, а возвращаются сразу три значения (values), MULTIPLE-VALUE-BIND просто берёт и связывает эти три значения. Т.е. вместо того чтобы придумать три переменных и в cond думать и присваивать им значения мы сразу возвращаем по три значения из четырёх (по количеству сторон света ;) ветвей cond.
>> Вообще cond и when стараюсь всегда использовать вместо if,
Это противоречит "be consistence"
* Если достаточно when или unless (одна ветвь) - тогда их
* Если две ветви - if, и только
* Если много ветвей по произвольным условиям - cond
* Если "переключатель" по значению - case
* Если "переключатель" по типу - typecase
Вот что можно по этому поводу почитать - http://www.cs.umd.edu/~nau/cmsc421/norvig-lisp-style.pdf
В ФВП (функциях высшего порядка) все зовут их fun (от function) для map-подобных преобразований и pred (от predicate) для filter-подобных. Слово eval тут выглядит очень странно )
>> 8)
Ты создаещь qtree-node описываешь что-то в initialize-instanse, а далее в loop ты его, как я понял, закрашиваешь - вот это закрашивание можно выделить в отдельный метод, так как оно работает, по сути, со слотом image-hash (qtree) тогда как остальные операции initialize-instanse выполняются для слотов qtree-node.
>> это как-то связано с макросом MULTIPLE-VALUE-BIND ?
calculate-index - чистая функция, там нет присваивания, а возвращаются сразу три значения (values), MULTIPLE-VALUE-BIND просто берёт и связывает эти три значения. Т.е. вместо того чтобы придумать три переменных и в cond думать и присваивать им значения мы сразу возвращаем по три значения из четырёх (по количеству сторон света ;) ветвей cond.
>> Вообще cond и when стараюсь всегда использовать вместо if,
Это противоречит "be consistence"
* Если достаточно when или unless (одна ветвь) - тогда их
* Если две ветви - if, и только
* Если много ветвей по произвольным условиям - cond
* Если "переключатель" по значению - case
* Если "переключатель" по типу - typecase
Вот что можно по этому поводу почитать - http://www.cs.umd.edu/~nau/cmsc421/norvig-lisp-style.pdf
[#] Ответ на комментарий от treep 25.07.2010 21:52
Насчёт if/when/и т.д. - среди них все макросы, кроме if. Если исходить из логики примитивизма, то нужно пользовать только if (только set вместо setq и setf), но в СL на то и выдумали столько макросов и функций (часто незначительно отличающихся), чтобы применять в каждой ситуации самый подходящий.
[#] Ответ на комментарий от treep 25.07.2010 21:56
Кстати, set же только для одного частного случая (symbol-value). Каждое сетфабельное место имеет свою функцию-сеттер, например: aset, setelt, setnth, rplaca, rplacd...
Без setnth, конечно, можно было бы и обойтись через rplaca, но мне кажется, они его там просто хитро соптимизировали.
Из гиперспеки:
The function set is deprecated.
set cannot change the value of a lexical variable.
Без setnth, конечно, можно было бы и обойтись через rplaca, но мне кажется, они его там просто хитро соптимизировали.
Из гиперспеки:
The function set is deprecated.
set cannot change the value of a lexical variable.
[#] Ответ на комментарий от selead 25.07.2010 19:47
Протестировал с константой и без
Напомню что была идея заменить пустые 4 дочерних узла константой, чтобы было меньше памяти и эффективнее работало,
провел несколько тестов, но результаты по времени очень похожи (каждый раз перед построением дерева запускается imagemagick, так что доли секунды
можно списать на задержки его запуска)
Статистика по дереву
Общее количество узлов : 211689
Из них узлы с пустыми дочерними подузлами '(nil nil nil nil) : 139095
Ф-я room выполнялась после полного построения и выборочного обхода дерева:
1) Без использования константы
2) С использованием оной
Нетрудно выяснить что common-lisp (в лице sbcl) имеет хорошо оптимизированный компилятор, т.к. для сборки не применялись никакие специфические опции,
поэтому использование констант не дает практически никакого преимущества, напротив, использование константы незначительно увеличивает объем памяти на величину не
зависящую от размера дерева.
Напомню что была идея заменить пустые 4 дочерних узла константой, чтобы было меньше памяти и эффективнее работало,
провел несколько тестов, но результаты по времени очень похожи (каждый раз перед построением дерева запускается imagemagick, так что доли секунды
можно списать на задержки его запуска)
Статистика по дереву
Общее количество узлов : 211689
Из них узлы с пустыми дочерними подузлами '(nil nil nil nil) : 139095
Ф-я room выполнялась после полного построения и выборочного обхода дерева:
1) Без использования константы
Evaluation took:
6.743 seconds of real time
1.284692 seconds of total run time (0.885785 user, 0.398907 system)
[ Run times consist of 0.300 seconds GC time, and 0.985 seconds non-GC time. ]
19.06% CPU
111 lambdas converted
17,039,362,546 processor cycles
98,017,200 bytes consed
Dynamic space usage is: 113,122,112 bytes.
Read-only space usage is: 5,264 bytes.
Static space usage is: 3,728 bytes.
Control stack usage is: 2,512 bytes.
Binding stack usage is: 288 bytes.
Garbage collection is currently enabled.
Breakdown for dynamic space:
30,863,456 bytes for 1,928,966 cons objects.
30,679,840 bytes for 279,845 simple-vector objects.
15,388,688 bytes for 310,144 instance objects.
14,116,704 bytes for 13,593 code objects.
10,418,576 bytes for 895 simple-array-unsigned-byte-64 objects.
11,749,664 bytes for 156,882 other objects.
113,216,928 bytes for 2,690,325 dynamic objects (space total.)
2) С использованием оной
Evaluation took:
6.576 seconds of real time
1.273243 seconds of total run time (0.877627 user, 0.395616 system)
[ Run times consist of 0.298 seconds GC time, and 0.976 seconds non-GC time. ]
19.36% CPU
111 lambdas converted
16,618,414,573 processor cycles
98,017,200 bytes consed
Dynamic space usage is: 113,122,368 bytes.
Read-only space usage is: 5,264 bytes.
Static space usage is: 3,728 bytes.
Control stack usage is: 2,512 bytes.
Binding stack usage is: 288 bytes.
Garbage collection is currently enabled.
Breakdown for dynamic space:
30,863,488 bytes for 1,928,968 cons objects.
30,679,856 bytes for 279,845 simple-vector objects.
15,388,736 bytes for 310,145 instance objects.
14,116,704 bytes for 13,593 code objects.
10,418,576 bytes for 895 simple-array-unsigned-byte-64 objects.
11,749,792 bytes for 156,884 other objects.
113,217,152 bytes for 2,690,330 dynamic objects (space total.)
Нетрудно выяснить что common-lisp (в лице sbcl) имеет хорошо оптимизированный компилятор, т.к. для сборки не применялись никакие специфические опции,
поэтому использование констант не дает практически никакого преимущества, напротив, использование константы незначительно увеличивает объем памяти на величину не
зависящую от размера дерева.
[#] Ответ на комментарий от treep 25.07.2010 21:52
последних двух переключателей не знал, спасибо,
насчет "be consistence" это конечно здорово, но если количество ветвей алгоритма заранее не известно (может это тоже плохой стиль?) намного
проще добавить или убрать условие в cond чем в if.
В финальном варианте соглашусь, if читается лучше, но до этого момента код надо еще отладить и тут cond незаменим,
предпочитаю здоровый прагматизм побуквенному следованию мануала, при этом понимая все недостатки такого подхода)
насчет "be consistence" это конечно здорово, но если количество ветвей алгоритма заранее не известно (может это тоже плохой стиль?) намного
проще добавить или убрать условие в cond чем в if.
В финальном варианте соглашусь, if читается лучше, но до этого момента код надо еще отладить и тут cond незаменим,
предпочитаю здоровый прагматизм побуквенному следованию мануала, при этом понимая все недостатки такого подхода)
[#] Ответ на комментарий от selead 28.07.2010 02:25
Как писал LinkFly нужно делать вот так:
иначе будут крутые косяки (все ноды будут использовать одну и ту же память для childs).
>> но если количество ветвей алгоритма заранее не известно (может это тоже плохой стиль?)
Не знаю, вроде всегда известно количество ветвей.
иначе будут крутые косяки (все ноды будут использовать одну и ту же память для childs).
>> но если количество ветвей алгоритма заранее не известно (может это тоже плохой стиль?)
Не знаю, вроде всегда известно количество ветвей.
[#] Ответ на комментарий от treep 28.07.2010 23:40
да, это я не проверял,
при использовании copy-list для тех же тестовых данных потребление памяти снизилось на 2,4 Мб,
но время работы не изменилось – добавились лишние 100 мс для GC.
>иначе будут крутые косяки
от этого застраховался тем что использую copy-list при сохранении дочерних объектов
>Не знаю, вроде всегда известно количество ветвей.
Некоторые алгоритмы самописные, в лиспе их у меня особенно много, т.к. занимаюсь им не по работе)
Еще такой вопрос возник
макрирую дерево с помощью счетчика, он передается в списке вида (LABEL)
соответственно метку устанавливаю так
После работы алгоритма все метки имеют одно значение, думаю что знаю даже почему,
однако не знаю как от этого избавиться. Можно сделать новый класс вместо списка и там все хранить, а считывать и записывать значение через свойства
но по моему это overkill, передавать счетчик отдельной переменной тоже не выход.
при использовании copy-list для тех же тестовых данных потребление памяти снизилось на 2,4 Мб,
но время работы не изменилось – добавились лишние 100 мс для GC.
>иначе будут крутые косяки
от этого застраховался тем что использую copy-list при сохранении дочерних объектов
>Не знаю, вроде всегда известно количество ветвей.
Некоторые алгоритмы самописные, в лиспе их у меня особенно много, т.к. занимаюсь им не по работе)
Еще такой вопрос возник
макрирую дерево с помощью счетчика, он передается в списке вида (LABEL)
`(:label 1 :condition ,func :root-node ,(slot-value tree 'root-node)
соответственно метку устанавливаю так
(let ((label-for-node (getf state :label)))
(with-slots (size density label) node
...
(setf label label-for-node)
....
(with-slots (size density label) node
...
(setf label label-for-node)
....
После работы алгоритма все метки имеют одно значение, думаю что знаю даже почему,
однако не знаю как от этого избавиться. Можно сделать новый класс вместо списка и там все хранить, а считывать и записывать значение через свойства
но по моему это overkill, передавать счетчик отдельной переменной тоже не выход.
[#] Ответ на комментарий от selead 29.07.2010 02:01
Не скажу в чём дело (там много всего проверять нужно), но например map-tree нужно писать как-то так:
dolist тут не к месту (у меня тот код с dolist вообще падает в дебагер). Кстати про "this place is good for parallel computing" - если всё же использовать dolist, то нужно использовать и присваивание, а в этом случае ни о какой параллелизации не может идти и речи, ну а чистоту ФВП тоже нельзя гарантировать, короче нынешние реализации CL не занимаются такой работой, можно только вручную параллелить свои вычисления с помощью bordeaux-threads (при наличии ядер > 1).
Буду ждать рефакторинга и consisten-ции, тогда, может, многие глюки отпадут :)
(declaim (ftype (function ((or function symbol) cons) cons) map-tree))
(defun map-tree (fun tree)
(mapcar #'(lambda (e)
(typecase e
(atom (funcall fun e))
(cons (map-tree fun e))))
tree))
(defun map-tree (fun tree)
(mapcar #'(lambda (e)
(typecase e
(atom (funcall fun e))
(cons (map-tree fun e))))
tree))
dolist тут не к месту (у меня тот код с dolist вообще падает в дебагер). Кстати про "this place is good for parallel computing" - если всё же использовать dolist, то нужно использовать и присваивание, а в этом случае ни о какой параллелизации не может идти и речи, ну а чистоту ФВП тоже нельзя гарантировать, короче нынешние реализации CL не занимаются такой работой, можно только вручную параллелить свои вычисления с помощью bordeaux-threads (при наличии ядер > 1).
Буду ждать рефакторинга и consisten-ции, тогда, может, многие глюки отпадут :)
[#] Ответ на комментарий от Ander Skirnir 30.07.2010 13:24
>> typecase вместо if - "неконсистентно" же :)
Почему? Там разные английские слова, может я плохо запомнил (не consistence, а concise или что-то в этом роде), но суть в том чтобы использовать наиболее частный синтаксический вариант в каждом случае - если у нас одна ветвь в зависимости от условия, то это unless/when (не if и не cond), а если две ветви то if (не cond), а если выбор по типу, то typecase а не cond по разным предикатам типа, ну и case вместо cond по предикатам сравнения. Для того их и сделали.
Я недавно читал статью и там говорилось про "консистентную математику" - такую в которой меньше всего базовых аксиом, так что наверно я плохо запомнил то слово, нужно говорить be concise или be speciale.
Почему? Там разные английские слова, может я плохо запомнил (не consistence, а concise или что-то в этом роде), но суть в том чтобы использовать наиболее частный синтаксический вариант в каждом случае - если у нас одна ветвь в зависимости от условия, то это unless/when (не if и не cond), а если две ветви то if (не cond), а если выбор по типу, то typecase а не cond по разным предикатам типа, ну и case вместо cond по предикатам сравнения. Для того их и сделали.
Я недавно читал статью и там говорилось про "консистентную математику" - такую в которой меньше всего базовых аксиом, так что наверно я плохо запомнил то слово, нужно говорить be concise или be speciale.
[#] Ответ на комментарий от treep 30.07.2010 18:57
> суть в том чтобы использовать наиболее частный синтаксический вариант в каждом случае
Ну а разве свитч-по-типу с двумя ветвями - более частный, чем if по предикату типа?
Ну а разве свитч-по-типу с двумя ветвями - более частный, чем if по предикату типа?
[#] Ответ на комментарий от Ander Skirnir 30.07.2010 20:36
Ну тут спасает, что list = atom + cons. А если бы было не так, то во вторую ветвь if попали бы экземпляры не того типа. А так да - if лучше выглядит, просто я уже привык - как только switch по типу, то сразу typecase.
[#] Ответ на комментарий от treep 30.07.2010 21:18
В смысле:
list ::= null | cons
cons ::= (atom . atom)
list ::= null | cons
cons ::= (atom . atom)
[#] Ответ на комментарий от treep 30.07.2010 21:21
Опять не то :) Вот:
list ::= null | cons
cons ::= (cons . cons) | atom
[#] Ответ на комментарий от treep 30.07.2010 21:22
Да что ты будешь делать :
list ::= null | cons
cons ::= (object . object)
object ::= cons | atom
atom ::= null | not-null-atom
[#] Ответ на комментарий от treep 29.07.2010 22:00
Насчет map-tree,
как ты предлагаешь мапить функцию с переменным числом параметров?,
например у меня каждой map функции передается еще путь к узлу (&key path) и состояние - state (тоже ключ) где хранятся все остальные переменные
параметры.
Кстати, как mapcar будет дерево обходить? по дочерним узлам?
У меня ф-я fun вызывается только для реальных узлов (не nil), а у тебя я не понимаю для чего точно получается вызов [смущает (cons (map-tree fun e))], можешь код прокомментировать немного?
>dolist тут не к месту (у меня тот код с dolist вообще падает в дебагер).
c dolist странно, там вроде все логично, на какой системе смотрел?
>Кстати про "this place is good for parallel computing"
Тут мой алгоритм позволяет разделять дерево на несколько поддеревьев с возможностью натравливать на каждое свой поток (правда метки тоже придется разделять тогда)
В моей сборке sbcl не поддерживает создание потоков, если дойдут руки буду в ручную пересобирать.
На самом деле это больше для частного случая – чем менее квадратное исходное изображение тем меньше профита от распараллеливания.
Сейчас с map-tree все укладывается в примерно полсекунды, а изображение ~ 2/1 высота на ширину, поэтому правая половина дерева вся пустая.
как ты предлагаешь мапить функцию с переменным числом параметров?,
например у меня каждой map функции передается еще путь к узлу (&key path) и состояние - state (тоже ключ) где хранятся все остальные переменные
параметры.
Кстати, как mapcar будет дерево обходить? по дочерним узлам?
У меня ф-я fun вызывается только для реальных узлов (не nil), а у тебя я не понимаю для чего точно получается вызов [смущает (cons (map-tree fun e))], можешь код прокомментировать немного?
>dolist тут не к месту (у меня тот код с dolist вообще падает в дебагер).
c dolist странно, там вроде все логично, на какой системе смотрел?
>Кстати про "this place is good for parallel computing"
Тут мой алгоритм позволяет разделять дерево на несколько поддеревьев с возможностью натравливать на каждое свой поток (правда метки тоже придется разделять тогда)
В моей сборке sbcl не поддерживает создание потоков, если дойдут руки буду в ручную пересобирать.
На самом деле это больше для частного случая – чем менее квадратное исходное изображение тем меньше профита от распараллеливания.
Сейчас с map-tree все укладывается в примерно полсекунды, а изображение ~ 2/1 высота на ширину, поэтому правая половина дерева вся пустая.
[#] Ответ на комментарий от selead 01.08.2010 00:51
>> Насчет map-tree,
Это было отвлечённое замечание, в данном случае смущает неявный побочный эффект (в funcall), если посмотреть в (macroexpand '(dolist (e L) (f))) то можно увидеть что dolist вообще возвращает nil - не может использоваться в чистых алгоритмах - только для мутации чего либо.
Могу предложить такое упрощение (но по-прежднему с dolist и funcall который должен менять ноду):
;; кстати &key (path nil) (state nil) писать не надо - они и так будут nil
(defmethod map-tree ((node qtree-node) fun &key path state)
(funcall fun node :path path :state state) ;; у fun побочный эффект?
(dolist (child (node-childs node))
(unless (null child)
(map-tree child fun :path (cons (node-orient node) path) :state state))))
;; как я говорил - дублирование слотов/методов мне не нравится,
;; но если уж дублировать, то по минимуму:
(defmethod map-tree ((tree qtree) fun &key path state)
(map-tree (tree-root-node tree) fun :path path :state state))
>> на какой системе смотрел?
То был баг в мозгу :)
>> В моей сборке sbcl не поддерживает создание потоков, если дойдут руки буду в ручную пересобирать.
А это на какой ОС планируется делать?
Это было отвлечённое замечание, в данном случае смущает неявный побочный эффект (в funcall), если посмотреть в (macroexpand '(dolist (e L) (f))) то можно увидеть что dolist вообще возвращает nil - не может использоваться в чистых алгоритмах - только для мутации чего либо.
Могу предложить такое упрощение (но по-прежднему с dolist и funcall который должен менять ноду):
;; кстати &key (path nil) (state nil) писать не надо - они и так будут nil
(defmethod map-tree ((node qtree-node) fun &key path state)
(funcall fun node :path path :state state) ;; у fun побочный эффект?
(dolist (child (node-childs node))
(unless (null child)
(map-tree child fun :path (cons (node-orient node) path) :state state))))
;; как я говорил - дублирование слотов/методов мне не нравится,
;; но если уж дублировать, то по минимуму:
(defmethod map-tree ((tree qtree) fun &key path state)
(map-tree (tree-root-node tree) fun :path path :state state))
>> на какой системе смотрел?
То был баг в мозгу :)
>> В моей сборке sbcl не поддерживает создание потоков, если дойдут руки буду в ручную пересобирать.
А это на какой ОС планируется делать?
[#] Ответ на комментарий от treep 01.08.2010 02:10
>в данном случае смущает неявный побочный эффект (в funcall),
Если бороться за чистоту алгоритма можно развернуть dolist в 4 проверки и вызова функции, но чувство эстетики у меня перевесило, к тому же,
конкретно в map-tree результат не нужен в принципе, но если он и потребуется - можно сохранить его в state как вариант)
>Могу предложить такое упрощение
У меня практически то же самое, только с дублированием (пока еще можно)
>А это на какой ОС планируется делать?
Изначально планировал по *nix/Linux, но после того как у меня на маке успешно поставились пакеты
cl-png и cffi, решил делать под мак, потом портировать под линукс. На винде тоже должно работать,
но там нужно помимо установки imagemagick пропатчить настройки, потому что на наличие дисков в файловой системе я не рассчитывал)
Других узких мест не вижу, кроме проблем с потоками.
Под win не знаю как там дела сейчас обстоят, а на маке ставил из macports, поэтому потоки не поддерживаются...
Если бороться за чистоту алгоритма можно развернуть dolist в 4 проверки и вызова функции, но чувство эстетики у меня перевесило, к тому же,
конкретно в map-tree результат не нужен в принципе, но если он и потребуется - можно сохранить его в state как вариант)
>Могу предложить такое упрощение
У меня практически то же самое, только с дублированием (пока еще можно)
>А это на какой ОС планируется делать?
Изначально планировал по *nix/Linux, но после того как у меня на маке успешно поставились пакеты
cl-png и cffi, решил делать под мак, потом портировать под линукс. На винде тоже должно работать,
но там нужно помимо установки imagemagick пропатчить настройки, потому что на наличие дисков в файловой системе я не рассчитывал)
Других узких мест не вижу, кроме проблем с потоками.
Под win не знаю как там дела сейчас обстоят, а на маке ставил из macports, поэтому потоки не поддерживаются...
[#] Ответ на комментарий от selead 01.08.2010 11:07
> в map-tree результат не нужен в принципе
Ну тогда это dotree :)
Ну тогда это dotree :)