与えられた木から、子→親への対応を作る

今回のお題は木構造を辿る問題。

木構造が与えられる。たとえばこんなの：

(define *tree*
  '(Root (Spine (Neck (Head))
                (RClavicle (RUpperArm (RLowerArm (RHand))))
                (LClavicle (LUpperArm (LLowerArm (LHand)))))
         (RHip (RUpperLeg (RLowerLeg (RFoot))))
         (LHip (LUpperLeg (LLowerLeg (LFoot))))))

つまり、 := ( ...) という構造。これから、子→親の対応を表すalistを作る手続きを書け、というもの。
結果の例はこんな感じ。各要素の順序は問わない。

((LHip . Root) (LUpperLeg . LHip) (LLowerLeg . LUpperLeg) (LFoot . LLowerLeg)
 (RHip . Root) (RUpperLeg . RHip) (RLowerLeg . RUpperLeg) (RFoot . RLowerLeg)
 (Spine . Root) (LClavicle . Spine) (LUpperArm . LClavicle)
 (LLowerArm . LUpperArm) (LHand . LLowerArm)
 (RClavicle . Spine) (RUpperArm . RClavicle)
 (RLowerArm . RUpperArm) (RHand . RLowerArm) (Neck . Spine) (Head . Neck))

30分で初級。10分で中級。

http://practical-scheme.net/wiliki/wiliki.cgi?Scheme%3A%E3%83%AA%E3%82%B9%E3%83%88%E5%87%A6%E7%90%86#H-ne4pu7

私が書いたのは以下のようなもの。一応10分くらいでは書けた。

(use srfi-1)

(define (tree->alist tree)
  (define-values (a d) (car+cdr tree))
  (fold (lambda(e r)(cons (cons (car e) a) r))
        (append-map tree->alist d)
        d))

わりと簡潔に書けたが、効率の面で好ましくない点がある。同じリストをfoldとappend-mapで1回ずつ(計2回)辿っているのがカッコワルイ。
Document ID: 8687c0de742f54c1eff17bee4cc30ac4