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

Scheme

via 自分には30分でも難しそうな希ガス > 与えられた木から、子→親への対応を作る

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

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

つまり、 <tree> := (<name> <tree> ...) という構造。

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

((LHip . Root) (LUpperLeg . LHip) (LLowerLeg . LUpperLeg) (LFoot . LLowerLeg) ...略)

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

よかった。10分かからず解けた。

(define (tree->alist tree)
  (append-map
    (lambda (x)
      (cons 
        (cons (car x)
              (car tree))
        (tree->alist x)))
    (cdr tree)))

(tree->alist *tree*)
; ((Spine . Root) (Neck . Spine) (Head . Neck)
;                 (RClavicle . Spine) (RUpperArm . RClavicle) (RLowerArm . RUpperArm) (RHand . RLowerArm)
;                 (LClavicle . Spine) (LUpperArm . LClavicle) (LLowerArm . LUpperArm) (LHand . LLowerArm)
; (RHip . Root) (RUpperLeg . RHip) (RLowerLeg . RUpperLeg) (RFoot . RLowerLeg)
; (LHip . Root) (LUpperLeg . LHip) (LLowerLeg . LUpperLeg) (LFoot . LLowerLeg))

順序が逆になってるって事は、foldで解いてるって事か。

ということでfold版。

(define (tree->alist tree)
  (fold
    (lambda (x acc)
        (cons (cons (car x)
                    (car tree))
              (append (tree->alist x) acc)))
    '()
    (cdr tree)))

(tree->alist *tree*)
; ((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))

こっちのほうがちと早いな。


回答例を見てみると色々解き方があるようだ。


aconsはgaucheの独自拡張か。MzSchemeにはないみたい。ユーティリティに追加しとこう。


おっと、ココ重要

再帰が身についてるかどうかを見るのに手頃かな。 appendによる無駄も、push!による副作用も嫌う場合、再帰パターンが樹状であっても結果がまっすぐなリストならfoldでつないでゆけることは覚えとくと便利かもしれません。

appendは無駄。foldで繋いでゆける。


書いてみよう。

(define (acons key value seq)
  (cons (cons key value) seq))

(define (tree->alist tree)
  (define (each-tree tree acc)
    (let ((parent (car tree)))
      (fold (lambda (x a)
                (acons (car x) parent (each-tree x a)))
            acc
            (cdr tree))))
  (each-tree tree '()))

Shiroさんの回答例を見ながらちと変数多めで書いてみた。foldを2回書く必要は無いので改造を加えた。

matchがよくわからんなぁ。


深さ優先検索しながらひとつづつ突っ込んでいけばappendする必要は無い。

嫌なこと思いついてしまった・・・

問題：

子→親の対応を表すalistが与えられるので、木構造を作る手続きを書け。各要素の順序は問わない。


ぬはームズイなコレ！！


む・ムズイけどできた。スゲー非効率なのでもうちょっと練り直すか。