Help us understand the problem. What is going on with this article?

Tree: 親子関係の付け替え

More than 1 year has passed since last update.

Tree: 親子関係の付け替え

この記事はHaskell Advent Calendar 2017に投稿したものです.

関数プログラミングでは,ツリー構造はさまざまなデータの集まりを表現するのに便利なデータ構造です.
単純でよいなら,Haskell(GHC)ではcontainersパッケージにある,Data.Treeモジュールを使ってTree型で表現するのが楽です.

import Data.Tree

data Lab = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z
  deriving (Eq,Ord,Enum,Bounded,Show,Read)

sample :: Tree Lab
sample = Node A [Node B [Node C [Node D []
                                ,Node E []]
                        ,Node F [Node G []
                                ,Node H []]]
                ,Node I [Node J [Node K []
                                ,Node L []]
                        ,Node M [Node N []
                                ,Node O []]]]

有向木

この木を描くと以下の図のようになります。

fig1.png

Tree a型の構造は,このように根ノードから葉ノードへ向う根付き有向木を表現したものと考えられます.このような根付き有向木は,ルートノードからはすべてのノードが到達可能です.

しかし,各ノードは自分の親ノードについては何も知らないので,任意の2ノード間のパスを調べるたりするには工夫がいります.
ここでは,その工夫を考えてみましょう.

無向木

さきほどの木を描いたものを再掲します.

fig2.png

再掲とはいいましたが,ちょっとだけ変更してあり,無向木になっています.有向木のときにはすべてのノードへの到達経路があるのは唯一ルートノードだけでした.無向木にするとどのノードから出発しても任意のノードに到達できることがわかります.どのノードでもルートノードになれるということです.
たとえば,ノードFもルートになれるのです.

fig3.png

ルートノードを別のノードに変更する

試しにFのノードを摘んで引き上げてルートノードに見立てましょう.

fig4.png

無向木であれば、Aノードをルートノードとして描いたものと、Fノードをルートノードとして描いものも、同じグラフです。これを、Fノードをルートノードとする有向木にすると

fig5.png

となり,さらにこれをTreeにすると、

reparented :: Tree Lab
reparented = Node F [Node B [Node A [Node I [Node J [Node K []
                                                    ,Node L []]
                                            ,Node M [Node N []
                                                    ,Node O []]]]
                            ,Node C [Node D []
                                    ,Node E []]]
                    ,Node G []
                    ,Node H []]

となります.さて,ここから本題です.sample :: Tree Labと,ノードFを指定して,reparented :: Tree Labを生成するにはどうするかを考えましょう.

reparent :: a -> Tree a -> Tree aをどう構成するかを考えていきます.reparentの引数はどのノードをルートノードにするかの指定です.ここでは,TreerootLabelフィールドはノードIDとして機能するという仮定をしておきます.ノードIDで指定したノードがない場合も考えてreparentの型シグネチャは,

reparent :: Eq a => a -> Tree a -> Maybe (Tree a)

aがノードID)としましょう.reparentの構成は,

  • ノードIDで指定したノードを探して(search)
  • それをルートノードに昇格させる(promote)

でいいでしょう.

reparent x = maybe Nothing (Just . promote) . search x

ノードIDで指定した,ノードを見つけたとして,それをルートノードに昇格させる方法(promote)から考えましょう.最初の図で説明したようにTree構造は有向木になります.

ノードの昇格

それでは,たとえば,ノードFをルートノードにするにはどうすればいいでしょう.

fig6.png

そうですね,ルートノードAからノードFまでのパスにある辺,A → B と B → F の向きを逆転して,B → A と F → B のようにすればいいですよね.

fig7.png

これを

fig8.png

とすればよいだけです.これでノードFを最上位に描画すれば,

fig9.png

となって,目的の木が得られます.

簡単にいってしまいましたが,ルートノードAからノードFまでのパス情報が必要です.どうしましょう?
そうです,Arunekoさんもお勧めの(Zipperに挑む)のZipperです.

Zipper

Tree用のZipperは現在のノードとパン屑リストとの対です.

type Zipper a = (Tree a, [Crumb a])

current :: Zipper a -> Tree a
current (n,_)  = n

crumbs :: Zipper a -> [Crumb a]
crumbs (_,cs) = cs

としましょう.パン屑Crumb aは以下のように定義しましょう.

type Crumb a = ([Tree a], a, [Tree a])

elders :: Crumb a -> [Tree a]
elders (es,_,_) = es

parentLabel :: Crumb a -> a
parentLabel (_,a,_) = a

youngers :: Crumb a -> [Tree a]
youngers (_,_,ys) = ys

パン屑の1つめの要素は兄姉ノードのリスト,2つめは親のルートラベル,3つめは弟妹ノードのリストです.

TreeZipperの相互変換は以下のようにします.

toZipper :: Tree a -> Zipper a
toZipper = (,[])

fromZipper :: Zipper a -> Tree a
fromZipper = current . upMost

Zipperの上への移動upと最上位への移動upMostとを定義しましょう.

up :: Zipper a -> Maybe (Zipper a)
up z = case crumbs z of
  []     -> Nothing
  (b:bs) -> Just $ (Node (parentLabel b) (elders b++current z : youngers b), bs)

upMost :: Zipper a -> Zipper a
upMost z = maybe z upMost (up z)

promoteの実装

現在のノードを含むZipperがあれば,現在ノードからルートへ,パン屑リストを使って遡れるので,promoteは以下のように実装できそうです.

promote :: Zipper a -> Tree a
promote (t,bs) = fromZipper (foldl f (t,[]) bs)
  where
    f (Node lab cs, ds) (ps,r,qs) = (Node r (ps ++ qs), ([],lab,cs) : ds)

searchの実装

promoteはZipperを必要としますので,search xTree aに適用すると,ノードIDがxであるようなノードを現在のノードとして含み,パン屑リストはルートからそのノードまでのパスを示すものですようなZipperになるはずですね.

search :: Eq a => a -> Tree a -> Maybe (Zipper a)
search x t = listToMaybe (searchDown x (toZipper t))

これにはZipperを下へたどる仕組みsearchDownを利用することにしましょう.

searchDown :: Eq a => a -> Zipper a -> [Zipper a]
searchDown x z@(Node y ys, bs) =
  bool id (z:) (x == y) (concatMap (searchDown x) (downs z))

downsはZipperの下への移動です.複数ありうるのでZipperのリストで表しています.

downs :: Zipper a -> [Zipper a]
downs (Node r rs, bs) = map zipper (select rs)
  where
    zipper (ps,x,qs) = (x,(ps,r,qs):bs)

select :: [a] -> [([a],a,[b])]
select = para f []
  where
    f x (xs, yss)   = ([], x, xs) : map (add x) yss
    add y (ys,z,zs) = (y:ys,z,zs)

para :: (a -> ([a], b) -> b) -> b -> [a] -> b
para _ e []     = e
para f e (x:xs) = f x (xs, para f e xs)

selectはリスト上のある種のZipperのリストですが,ここでは,paramorphismのインスタンスとして定義してあります.

というわけで、今回は『「木」配りのススメ』でした。(嗚呼GGネタ)

Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
Comments
Sign up for free and join this conversation.
If you already have a Qiita account
Why do not you register as a user and use Qiita more conveniently?
You need to log in to use this function. Qiita can be used more conveniently after logging in.
You seem to be reading articles frequently this month. Qiita can be used more conveniently after logging in.
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away