2017/11/05

HylomorphismとMetamorphism

はいどうも! Recursion SchemeのHylomorphismとMetamorphismの話です。 今年のアドベントカレンダーに向けたブログ投稿リハビリ用の記事になります。 

hylomorphismは、catamorphismとanamorphismの合成、 metamorphismは、hylmorphismの双対、anamorphismとcatamorphismの合成に当たる射になります。

catamorphismやanamorphismは、(単方向連結)Listで言う所のfoldrとunfoldに当たるものです。

(以下、長いため、catamorphismをcataと書くなど、適宜morphismを省いて書きます。)

hylomorphismは、cataとanaの合成射であり、
hylo = cata . ana
という合成です。 

プログラムにおけるhyloは、foldr/unfoldの合成、つまりデータの生成処理(unfold)と、 データの消費処理(foldr)が融合するような関数になります。

hyloを直接再帰の形式で書くことにより、anaで生成されるデータをcataが直接消費することで、 anaが生成する(代数的データ型による)データを実際に生成することなくcata/anaの合成処理が記述することが可能になります。

このような合成は、プログラムの融合変換に応用できます。
実際の所、recursion schemeは、cata、ana、hyloをプログラムで直接手で記述するというよりは、コンパイル時の中間処理として登場するイメージに近いと思います。

例えば、プログラム中に登場するmap、filter、foldr、unfoldなどをcata、ana、hyloに展開し、展開後のコードの合成部分を見て、cata/ana融合が登場すると、直接再帰の形式のhyloに書き換えるといった最適化が可能になります。 (例えば、参考文献3では、mapやsum等、リストを扱う関数をhylo形式に書き換え、hylo同士を融合するといった最適化を行っています。)

この種の最適化は、実行時に生成される中間のデータの生成、消費処理を除去し、実行時のヒープ使用量を減らすなどの効果を目当てとして、行われます。

次に、metamorphismですが、これは、hyloの双対にあたり、cata(foldr)が生成した計算結果を元に、 ana(unfoldr)によりデータを展開するという処理の記述の一般化された形式で、 
meta = ana . cata
となる合成関数です。 

hylo同様、metaもana/cataの融合であることから、同じように説明することが出来ます。 つまり、展開されているデータを畳み込み、その結果から再度、データを展開する。 ところで、そんな関数は、リスト操作上だとどのような関数でしょうか? 

その一つの答えは、リスト操作関数におけるmap関数はcataでありanaであるという事です。 例えば、anaやcataにconsを生成させる関数を渡す事で、cataとana、いずれでもmapの役割を果たすことが出来ます。

この事は、map関数でありがちな、map f . map g = map (f . g)の融合をcata/ana融合、言い換えると hyloで表現できることを意味するわけですが、それと同時に、metaでも実現出来るわけです。 ana/cata融合、つまりmetaもまた、map/map融合を表す射になりうるのです。

つまり、 map f . map g = map (f . g) は、hyloで表すと、
(cata f') . (ana g') = hylo f' g'
であり、 これと同様の意味をmetaで書くと、
(ana f'') . (cata g'') = meta g'' f'' 
と書くことができます。
f'、f''、g'、g''は、それぞれ、元のf、gをhylo/meta用に修正(wrapping)した関数になります。 cata/ana共に、そもそも、foldr/unfoldなので、mapしたい関数を直接渡す事はできません。。。

実際に、Haskellのコードで、リスト上のcata/anaを書くと以下のようになります。 まず、標準のリスト上のcataとanaです。
lcata :: (alpha -> beta -> beta) -> beta -> [alpha] -> beta
lcata f b []     = b
lcata f b (a:as) = f a (lcata f b as)

lana :: (beta -> Maybe(alpha, beta)) -> beta -> [alpha]
lana f b = case f b of
  Just (a, b') -> a:lana f b'
  Nothing      -> []
anaでは、JustとNothingでデータを生成し続けるのか、停止するのか、切り替えています。 ちなみに、これは基本的にフラグなので、代わりに1, 2とそのタプルを使う文献も多いです。(下の参考文献2、3あたりを参照。というかそっちが主流かも?) 今回は、後で紹介するコードに合わせて、Maybeで書きました。

次に直接再帰形式のhylo/metaです。cata/ana同様にHaskellの標準のリストを対象にしています。
lhylo :: beta -> (alpha -> Maybe(gam, alpha)) -> (gam -> beta -> beta) -> alpha -> beta
lhylo init f g a = case f a of
  Nothing     -> init
  Just (x, y) -> g x (lhylo init f g y)

lmeta :: (gam -> Maybe (beta, gam)) -> (alpha -> gam -> gam) -> gam -> [alpha] -> [beta]
lmeta f g c x = case f c of
  Just(b, c') -> b:(lmeta f g c' x)
  Nothing     -> case x of
    []   -> []
    a:x' -> lmeta f g (g a c) x'
hyloの直接再帰の形式はよく見るのですが、metaについては、ネットではあまり見かけません。。。上記のmetaの形式は、参考文献1の10pの直接再帰形式のコードからHaskellのリスト向けに復元したものです。

このcata/anaで書いたコードに対するmap関数は以下のようになります。元はfoldr/unfoldだけあって、mapしたい関数を直接渡す事はできません。。。
mapC f = lcata func []
  where
    func x xs = (f x):xs

mapA f = lana func
  where
    func []     = Nothing
    func (x:xs) = Just(f x, xs)
次に、hylo/metaによる(map f) . (map g) = map (f . g)の合成。それぞれ、hylo版がmapH、meta版がmapEになります。
mapH f g = lcata func1 [] . lana func2
  where
    func1 x xs = (f x):xs
    func2 []     = Nothing
    func2 (x:xs) = Just(g x, xs)

mapE f g = lana func2 . lcata func1 []
  where
    func1 x xs = (g x):xs
    func2 []     = Nothing
    func2 (x:xs) = Just(f x, xs)
しかし、この例はあまりに面白くありませんね。。。

mapをrecursion schemeで表すなら前述したようにcataかana十分なはずで、 そもそもmap自体、簡単に融合出来てしまいます。 致命的なのが、metaの特徴でもある畳込み後の値が使えるという性質を上手く活かしきれていません。

しかし、上記の例から分かることは、foldで畳み込んだ結果をリストとすることで、metamorphismもそれなりに使いみちが出てくるかも知れません。

というわけで、やってみたのが、metamorphismによるfilterとmapの融合です。
mapfilterM f g = lana func2 . lcata func1 []
  where
    func1 x xs   = if f x then x:xs else xs
    func2 []     = Nothing
    func2 (x:xs) = Just(g x, xs)
これを直接再帰の形式のmetaに差し替えると、こうなります。
mapfilterMF f g = lmeta func2 func1 []
  where
    func1 x xs   = if f x then x:xs else xs
    func2 []     = Nothing
    func2 (x:xs) = Just(g x, xs)
fにfilter用の関数を渡し、gにmapに渡す関数を渡します。
map after filter(filter関数の実結果にmap関数を実行)の融合変換は、map関数を展開があるため、metamorphismを使うことで綺麗に表現出来ています。。。(多分

以下実行結果です。
*Main> mapfilterMF (\x-> (mod x 5) == 0) (3 +) [1..20]
[8,13,18,23]
*Main> map (3 +) $ filter (\x-> (mod x 5) == 0) [1..20]
[8,13,18,23]
*Main> mapfilterM (\x-> (mod x 5) == 0) (3 +) [1..20]
[8,13,18,23]
このようにして、hylomorphismやmetamorphismは融合変換に使用することができます。

そして、最後に! ググったら出てきた、面白いhylomorphism/metamorphismの例を紹介します。(参考文献1より)
それが、hylomorphismとmetamorphismによるQuicksort & Heapsortです。 例によって、in-placeではないので、それぞれ偽のQuicksort、Heapsortになります。

まず、hylomorphismによるQuicksort(参考文献1からの引用)!
data Tree alpha = Node(Maybe(alpha, Tree(alpha), Tree(alpha))) deriving Show

foldt :: (Maybe(alpha, beta, beta) -> beta) -> Tree(alpha) -> beta
foldt f (Node Nothing)         = f Nothing
foldt f (Node (Just(a, t, u))) = f $ Just(a, foldt f t, foldt f u)

unfoldt :: (beta -> Maybe(alpha, beta, beta)) -> beta -> Tree(alpha)
unfoldt f b = case f b of
  Nothing         -> Node Nothing
  Just(a, b1, b2) -> Node(Just(a, unfoldt f b1, unfoldt f b2))

partition :: (Ord alpha) => [alpha] -> Maybe(alpha, [alpha], [alpha])
partition []          = Nothing
partition (a:as)      = Just(a, filter (< a) as, filter (> a) as)

join :: Maybe (alpha, [alpha], [alpha]) -> [alpha]
join Nothing          = []
join (Just(a, x, y))  = x ++ [a] ++ y

quicksort :: (Ord alpha) => [alpha] -> [alpha]
quicksort = foldt join . unfoldt partition
主に、partitionとjsonそして、unfoldt/foldtは木構造を生成して、それをリストに引き戻している処理になります。 Haskellのfake Quicksortのコードがjoinとpartitionの箇所にそのまま現れていることがわかります。

同様にして、metamorphismによるHeapsort(Quicksort同様、参考文献1からのほぼ引用ですが、一部修正)。
insert :: (Ord alpha) =>  alpha -> Tree(alpha) -> Tree(alpha)
insert a t = merge (Node(Just(a, e, e)), t)
  where
    e = Node Nothing

splitMin ::  (Ord alpha) => Tree(alpha) -> Maybe(alpha, Tree(alpha))
splitMin (Node t) = case t of
  Nothing       -> Nothing
  Just(a, u, v) -> Just(a, merge(v, u))

merge :: (Ord alpha) => (Tree(alpha), Tree(alpha)) -> Tree(alpha)
merge(t, Node Nothing) = t
merge(Node Nothing, u) = u
merge(Node x, Node y)  = if a < b
  then Node(Just(a, t2, merge(t1, Node y)))
  else Node(Just(b, u2, merge(u1, Node x)))
  where
    Just(a, t1, t2) = x
    Just(b, u1, u2) = y

heapsort :: (Ord alpha) => [alpha] -> [alpha]
heapsort = lana splitMin . lcata insert (Node Nothing)
こちらは少し特殊ですが、補助関数mergeを作っています。 mergeが別に再帰的な処理を行っていますが、これは本体の再帰とは別の処理です。

まあ、ここまで来ると、素直に再帰を書けば良い気もしますが、再帰関数がこのように分離出来るのは面白いですね。

Haskellのcataやana、hyloなどで書ける関数は、The pointless-haskell package(のExample)に色々紹介してあるので、それらを使って 遊んで見るのも良いかも知れません。

今回作成したコードの全体はここ(Gist)に置いてます。

ps. 急ぎで書いてしまったので、後で修正が入るかも知れません。

参考文献

  1. J.Gibbsons, Metamorphisms: Streaming Representation-Changers, 2005(PDF)
  2. F. Domínguez, Alberto Pardo, Exploiting algebra/coalgebra duality for program fusion extensions, 2011 (PDF)
  3. Yoshiyuki Onoue, Zhenjiang Hu, Hideya Iwasaki, Masato Takeichi, A Calculational Fusion System HYLO, 1997 (PDF)

2017/05/14

Emacsのギリシャ文字/キリル文字のフォント表示

長らくブログを書いてなかったので、復帰がてらに、最近やったEmacsの設定について、メモします。

Emacsを使う場合、日本語の設定を
;; 日本語
(set-fontset-font
 'nil 'japanese-jisx0208 (font-spec :family "Takaoゴシック" :height 90))
のように、何かしらフォントの設定を行うと思いますが、その時、ギリシャ文字やキリル文字のフォントも全角化されてしまいます。以下のように...


しかし、全角のギリシャ/キリル文字は読みづらいので、できれば、別のフォントで表示させたくなります。というわけで、こんな感じで別のコードポイントを割り当てます。
;; ギリシャ文字
(set-fontset-font
 'nil '(#x0370 . #x03FF) (font-spec :family "Ubuntu Mono" :height 100))

;; キリル文字
(set-fontset-font
 'nil '(#x0400 . #x04FF) (font-spec :family "Ubuntu Mono" :height 100))

ギリシャ文字のコードポイントは、#x0370〜#x03FF、キリル文字のコードポイントは、#x0400〜#x04FFなので、上記のように設定します。
そして、再表示した結果が以下。

しっかり、半角化されて、綺麗な表示になりました。

ちなみに、私はこんなフォント設定をしています。
(defvar default-font-family "Ubuntu Mono")
(defvar default-font-family-jp "Takaoゴシック")

;; デフォルトフォント設定
(set-face-attribute
 'default nil :family default-font-family :height 100)

;; 日本語のフォントセット : あいうえお ... 日本語
(set-fontset-font
 'nil 'japanese-jisx0208 (font-spec :family default-font-family-jp :height 90))

;; ギリシャ文字のフォントセット : αβγκλ ... ΛΩ
(set-fontset-font
 'nil '(#x0370 . #x03FF) (font-spec :family default-font-family :height 100))

;; キリル文字のフォントセット : Эта статья ... Русский
(set-fontset-font
 'nil '(#x0400 . #x04FF) (font-spec :family default-font-family :height 100))