Flache Hierarchien (04 Apr 2015)

Die Aufgabe des Code-Stückchens war, in CoCreate Modeling eine Baugruppe abzuklappern und dabei zu verflachen. (Jaja, der aktuelle Produktname ist sowas wie PTC Creo Elements/Direct Modeling, aber spätestens beim Schrägstrich nicke ich weg.) Sprich: Für jedes Element in der Baugruppe wird ein Eintrag in der Resultatliste erzeugt, und diese Liste ist flach, also unverschachtelt.

In CoCreate Modeling werden Objekte repräsentiert durch sogenannte SEL_ITEMs - Lisp-Strukturen, die für Teile, Baugruppen, Arbeitsebenenen und allerlei andere Objekte in einem 3D-Modell stehen können. Damit man den Lisp-Code in diesem Artikel vielleicht auch einmal in einer anderen Lisp-Implementierung testen kann, definieren wir uns aber zunächst einmal eine extrem eingedampfte Sparversion als eigenen Datentyp node:

(defstruct node
  (name     ""  :type string)
  (children nil :type list))

Das reicht, um einen einfachen Teilebaum abzubilden. Ein Knoten kann entweder ein einfaches Teil repräsentieren - in diesem Fall hat er nur einen Namen. Wenn es sich um eine Baugruppe handelt, hält der Knoten eine Liste von Kindknoten in children.

(defmethod print-object ((node node) stream)
  (format stream "~A [~A]  "
     (node-name node)
     (if (node-children node) "asm" "part")))

Damit man einen node halbwegs kompakt ausgeben kann, definieren wir uns ein zur Struktur passendes generisches print-object. Aus der etwas langatmigen Darstellung einer Strukturinstanz wie

#S(NODE :NAME "42" :CHILDREN (#S(NODE :NAME "p42" :CHILDREN NIL)))

wird dadurch

42 [asm]  

Testbaugruppen baut man sich einfach per Strukturliteral. Beispiel:

(let ((tree #S(NODE :NAME "a1"
                :CHILDREN (#S(NODE :NAME "p1")
                           #S(NODE :NAME "p2")
                           #S(NODE :NAME "a11"
                               :CHILDREN (#S(NODE :NAME "p11")
                                          #S(NODE :NAME "p12")))
                           #S(NODE :NAME "a12"
                               :CHILDREN (#S(NODE :NAME "p13")
                                          #S(NODE :NAME "p14")))))))

Mit dieser Vorbereitung können wir nun endlich des Kollegen Codeschnippsel betrachten. Naja, eine leicht angepasste Variante davon jedenfalls:

(defun flatten-assembly-apply-nconc(node)
  (cons node
    (apply #'nconc (mapcar #'flatten-assembly-apply-nconc (node-children node)))))

Ruft man flatten-assembly-apply-nconc für die obige Testbaugruppe (flatten-assembly-apply-nconc tree), erhält man dank des von uns definierten print-object in der REPL in etwa folgendes:

(a1 [asm]  p1 [part]  p2 [part]  a11 [asm]  p11 [part]  p12 [part]  a12 [asm]  p13 [part]  p14 [part]) 

Es entsteht also in der Tat eine flache Liste - wie schön. Sich zu verbildlichen, warum die Funktion die gewünschten Effekt hat, braucht schon einen kleinen Moment - und vielleicht auch den einen oder anderen Blick ins Lisp-Manual, um sich der genauen Funktionsweise von nconc oder mapcar zu vergewissern. Entscheidend ist unter anderem, dass Lisp-Listen letztlich Ketten von cons-Zellen sind, deren letztes Element auf nil verweist, und dass node-children genau solche nil-Werte passend liefert, die von mapcar und nconc auch brav durchgeschleust werden.

flatten-assembly-apply-nconc setzt das "destruktive" nconc ein, um weniger Speicher allozieren zu müssen. Was mich gleich zu der Frage geführt hat, ob es vielleicht noch effizienter geht, und so entstanden folgende Varianten:

(defun flatten-assembly-apply-append(node)
  (cons node
    (apply #'append (mapcar #'flatten-assembly-apply-append (node-children node)))))

(defun flatten-assembly-mapcan(node)
  (cons node
    (mapcan #'flatten-assembly-mapcan (node-children node))))

;; version using an accumulator
(defun flatten-assembly-accumulator(node &optional acc)
  (cond
    ((null node) acc)
    ((listp node) (flatten-assembly-accumulator (first node) (flatten-assembly-accumulator (rest node) acc)))
    ((null (node-children node)) (cons node acc))
    ;; assembly case, i.e. a node with children
    (t (cons node (flatten-assembly-accumulator (node-children node) acc)))))

Diese Varianten habe ich hintereinander in drei Lisp-Implementierungen ausgemessen, und zwar in CLISP 2.49, Clozure CL 1.1 und SBCL 1.2.10. Weil SBCL sich zumindest auf Mac OS bei kurzläufigen Tests zickig anstellt und keine Messdaten liefert, habe ich die jeweilige Testfunktion in einer Schleife 100000mal aufgerufen:

(let ((tree #S(NODE :NAME "a1"
                :CHILDREN (#S(NODE :NAME "p1")
                           #S(NODE :NAME "p2")
                           #S(NODE :NAME "a11"
                               :CHILDREN (#S(NODE :NAME "p11")
                                          #S(NODE :NAME "p12")))
                           #S(NODE :NAME "a12"
                               :CHILDREN (#S(NODE :NAME "p13")
                                          #S(NODE :NAME "a121"
                                              :CHILDREN (#S(NODE :NAME "a1211"
                                                             :CHILDREN (#S(NODE :NAME "p1211")))))
                                          #S(NODE :NAME "p14")))))))

  (defun run-test(function-symbol)
       (gc)
       (format t "~%Test function: ~A~%" (symbol-name function-symbol))
       (print (time (dotimes (i 100000) (run-test-raw function-symbol)))))

  )

(run-test 'flatten-assembly-apply-append)
(run-test 'flatten-assembly-apply-nconc)
(run-test 'flatten-assembly-mapcan)
(run-test 'flatten-assembly-accumulator)

Variante	Lisp-Implementierung	Laufzeit (µs)	Allokation (Bytes)
flatten-assembly-apply-append	SBCL	37000	52768224
flatten-assembly-apply-nconc	SBCL	25000	36798464
flatten-assembly-mapcan	SBCL	29000	19169280
flatten-assembly-accumulator	SBCL	22000	19169280
flatten-assembly-apply-append	CLISP	3173017	72000000
flatten-assembly-apply-nconc	CLISP	3034901	56000000
flatten-assembly-mapcan	CLISP	2639819	38400000
flatten-assembly-accumulator	CLISP	4959644	46400000
flatten-assembly-apply-append	CCL	70407	52800000
flatten-assembly-apply-nconc	CCL	54713	36800000
flatten-assembly-mapcan	CCL	128232	19200000
flatten-assembly-accumulator	CCL	20997	19200000

Die Angaben zu Zeit- und Speicherverbrauch lieferte dabei jeweils time.

Es gibt also durchaus signifikante Unterschiede im Speicherverbrauch. In CCL und SBCL liefert die Variante flatten-assembly-accumulator die beste Kombination aus Performance und Speichersparsamkeit. Für CLISP ist dagegen flatten-assembly-mapcan die vielversprechendste Alternative.

Weitere Vorschläge für Varianten? Bin gespannt!

PS: Natürlich ist das hier beschriebene Problem eine Variante der Aufgabe, eine verschachtelte Liste plattzuklopfen. http://rosettacode.org/wiki/Flatten_a_list#Common_Lisp hält einschlägige Lösungen hierfür parat.

PS/2: In der Lisp-Implementierung HCL, die in CoCreate Modeling verwendet wird, schneiden flatten-assembly-apply-nconc und flatten-assembly-mapcan am besten ab. Dies ist aber mit Vorbehalt gesagt, denn in HCL musste ich den Code - mangels Compiler-Lizenz - interpretiert ablaufen lassen, was das Performancebild vermutlich stark verfälscht.