雑記帳
僕用勉強ノート 「圏論」の巻

圏論的にIf文を組み立てる

(圏論シリーズロゴ)
前置き
条件分岐を伴う対応の規則を矢印の合成規則として反映する射の存在を示すには...
以下のような「写像・関数 f の満たすべき関係」
f(n)=2n+1
が与えられたとし、もしその式に含まれる変数を上手く括りだすことが出来れば、その対応の規則を射の合成規則の結果として持つような具体的な射の形を見出すことができた。
f(n)=2n+1nf=2,n(N),1(+N)nf=nconst(2),N(N),1(+N)nf=nconst(2),N(N),const(1)(+N)nf=n(const(2),N(N),const(1)(+N))
一方、次のような条件分岐を含む関係式
g(n)={2n+1 if n5n otherwise 
となった場合、今までと全く同じような方法を用いて与えられた条件を満足するような写像の存在を示すことは出来なくなる。
Excel の IF 関数のような写像が存在すると仮定すると上手くいく?
ではどうすればよいのかという話になるのだが、手っ取り早い1つの方法としては、「Excel の IF 関数」に相当する写像を使って分岐を表現するというものである。
例えば上の関数のとる値 g(A1) は、Excel では
=IF(A1<=5,2*A1+1,A1)
という式で記述することができる。
同様に、もしその IF 関数に相当する写像 if:Bool×(A×A)A の存在を仮定すると、圏論的にも
g(n)=if(n5,2n+1,n)
と書き表すことができるわけだが、この形であれば通常通り n を括りだすことができ、
g(n)=if(n5,2n+1,n)ng=if(n,5(),2,n(),1(+),n)ng=n,5(),2,n(),1(+),nifng=nid,const(5)(),n(const(2),id(),const(1)(+)),nifng=nid,const(5)(),nconst(2),id(),const(1)(+),idifng=nid,const(5)(),const(2),id(),const(1)(+),idif
より
g=id,const(5)(),const(2),id(),const(1)(+),idif
というように射 g の存在が示せる。
そもそも if をどのように写像として構成するのか?
写像 if:Bool×(A×A)A について、A が有限個の要素しか持たない場合であるとすると、技術的には
で説明した方法を使って構成することはできる。
具体例を1つ挙げると A(1+1)+1 の場合は
A:=(1+1)+1Bool:=1+1true:=inj1false:=inj20:=inj1inj11:=inj2inj12:=inj2
としたとき
if(true,0,0)=0if(false,0,0)=0if(true,0,1)=0if(false,0,1)=1if(true,0,2)=0if(false,0,2)=2if(true,1,0)=1if(false,1,0)=0if(true,1,1)=1if(false,1,1)=1if(true,1,2)=1if(false,1,2)=2if(true,2,0)=2if(false,2,0)=0if(true,2,1)=2if(false,2,1)=1if(true,2,2)=2if(false,2,2)=2
を満たす射として if が構成される。
一方で、A が非有限個の要素を持つ場合、上記の「愚直に対応を全て列挙する方法」は通用しなくなる。
つまり、冒頭に挙げた
g(n)={2n+1 if n5n otherwise 
を満たす写像 g の構成に必要になる if の存在は依然として示せない。
因みに、「非有限の場合でも、単に写像のグラフを構成してしまえば良いのでは?」と思う人がいるかもしれないが、その方法では「逆射」の存在の証明が付きまとうし、そもそも「部分対象の操作 (共通部分や合併の誘導など)」を柔軟に行うためには周囲圏に対して「トポス」というあまりにも強すぎる設定が必要になる。
できれば「トポス」という強い設定ではなく、関数型プログラミング言語にも適用可能なより課される条件の少ない (Haskell で機械的に検証可能な) 設定で、さらに欲を言えば「直接的な構成」のできる方が好ましい。
幸運にも、そういった条件分岐を含む関係式によって特徴付けられる関数の圏論的な組み立てに必要になる写像 if は、「全ての有限余積と自然数対象を持つカルテシアン閉圏」という設定の下でかなり簡単に構成することができる。
この記事では、その幾つかについてを簡単に紹介していきたい。
真偽値を余積対象 1+1 の要素として受け取る If-Else 条件分岐
これは普通に「射影 A×AA」を要素に変換して得られる2つの指数対象の要素から引き起こされる「余積対象 1+1 からの射 1+1AA×A」に対して un-カリー化をとって得られる
if2=((arrToEl(prj1)arrToEl(prj2))×(A×A))ev
として構成できる。
但し、ここで使っている arrToEl(f) の定義については、
を参照。
余談
当たり前だが、A×AA ではなく A×BA, A×BB という型の射影を用いて分岐を作ることは、型に不整合が生じてしまうことからわかるように不可能となる。
これについては、Haskell のような強い型付けがされるプログラミング言語における If-Else 分岐に慣れている人にとってはしっくりくることと思う。
とはいえこのままでは使い勝手が良くないので、応用のためには次節で説明するちょっとした小細工が必要になる。
真偽値をC言語ライクに自然数として受け取る If-Else 条件分岐
導入
先ほど紹介した「真偽値を終対象同士の余積対象の要素として受け取る条件分岐」には、応用が利きづらいという難点がある。
というのも、現在の「全ての有限余積と自然数対象を持つカルテシアン閉圏」という設定では、そもそもトポスが持つような論理演算子が定義されない。
即ち条件分岐が作れたとしても、「1+1 をコドメインにとる射」という形の条件式がそもそもとして柔軟に組めないので、応用のしようがないという状況になってしまっている。
幸運なことに現在の設定の下でも、C言語ライクに
  • 自然数 0 を偽
  • それ以外の自然数を真
と見做すことで、
  • 論理積
  • 論理和
  • 否定
  • 相等関係
  • 順序関係
といった条件式を組み立てる上で重要な役割を果たすパーツを組み立てることはできる。(これら射の具体的な構成方法は「自然数対象を持つカルテシアン閉圏の一般論の中でアッカーマン関数を構成する。」を参照。)
そのため、「真偽値をC言語ライクに自然数として受け取る If-Else 条件分岐」であれば、かなり柔軟に射の構成へと応用できることが期待される。
構成
具体的な構成は以下のようになる。
基本的には先ほどの構成と変わらないが、一つ異なるのは、「自然数として表された真偽を余積対象の要素として表された真偽に変換する射 N1+1」を途中でかませるという点である。
そのデータ変換用の射は
recN(inj2,inj1)
として構成でき、よって条件分岐 ifN:N×(A×A)A
ifN=((recN(inj2,inj1)(arrToEl(prj1)arrToEl(prj2)))×(A×A))ev
となる。
但しここで、余対角射 である。(その射を余対角射ではなく、単なる終射 ! として捉えることももちろん可能であるのだが、せっかくなのでこちらの構成を採用している。)
余談
アッカーマン関数を構成する記事では、周囲圏に対して「全ての有限余積の存在」を仮定していないため、少しぎこちないスタイルで If-Else を無理やりに表現しているが、余積の存在を仮定すればこのような「出力される値の型に対して "自然数でなければいけない" という縛りのない If」を用いて記述することが可能になる。
応用
自然数対象を添字集合とする対象の要素の族
この If-Else 条件分岐は自然数対象を添字集合とする対象 X の要素の族 NX を組み立てる際に便利となる。
例えば
an={2,2inj1 if n=09,2inj1 if n=116inj2 if n=20,0inj1 otherwise 
という条件を満たす族 a:N((N×N)+N)
a(n)=ifN(n==0,2,2inj1,ifN(n==1,9,2inj1,ifN(n==2,16inj2,0,0inj1)))
と書き変わるが、この式であれば a の形を通常通り求められる。
a(n)=ifN(n==0,2,2inj1,ifN(n==1,9,2inj1,ifN(n==2,16inj2,0,0inj1)))na=n(N,const(0)(==),const(2,2inj1),N,const(1)(==),const(9,2inj1),N,const(2)(==),const(16inj2,0,0inj1)ifNifNifN)
つまり
a=N,const(0)(==),const(2,2inj1),N,const(1)(==),const(9,2inj1),N,const(2)(==),const(16inj2,0,0inj1)ifNifNifN
として構成される。
Haskell での動作確認
Haskell の型とその間の関数は (理想的には) 「全ての有限余積と自然数対象を持つカルテシアン閉圏」をなすため、以上の構成は Haskell でもそのまま適用可能である。
ということで、「自然数対象を添字集合とする対象の要素の族」の例として構成した射を実際に Haskell の関数として組み立てて、ちゃんと動作するのかを検証しておく。
以下はこのページの終わりに載せたコードを、GHC のインタラクティブモードから読み込んで実行した結果である。
ghci> printEl $ nat(0) -: a'
(2,2);inj1
ghci> printEl $ nat(1) -: a'
(9,2);inj1
ghci> printEl $ nat(2) -: a'
16;inj2
ghci> printEl $ nat(3) -: a'
(0,0);inj1
ghci> printEl $ nat(4) -: a'
(0,0);inj1
ghci> printEl $ nat(5) -: a'
(0,0);inj1
この結果からわかるように、
a(0)=2,2inj1a(1)=9,2inj1a(2)=16inj2a(3)=0,0inj1a(4)=0,0inj1a(5)=0,0inj1
という最初に与えた関係式が満たされている事の確認が取れる。
ソースコード
{-# LANGUAGE TypeOperators #-}

import Data.Void

main :: IO ()
main = do

  printEl $ nat(0) -: a'
  printEl $ nat(1) -: a'
  printEl $ nat(2) -: a'
  printEl $ nat(3) -: a'
  printEl $ nat(4) -: a'
  printEl $ nat(5) -: a'


class (MyShow a) where
  myShow :: a -> String

instance MyShow () where
  myShow = const "*"

instance (MyShow a, MyShow b) => MyShow (Either a b) where
  myShow = either
    (\z -> if (myShow z == "*") then "inj1" else (myShow z) ++ ";inj1")
      (\z -> if (myShow z == "*") then "inj2" else (myShow z) ++ ";inj2")

instance (MyShow a, MyShow b) => MyShow (a,b) where
  myShow (x,y) = "(" ++ myShow x ++ "," ++ myShow y ++ ")"

instance MyShow Int where
  myShow = show

instance MyShow Nat where
  myShow (Nat i) = myShow (length i)
  --myShow (Nat i) = "zero" ++ (foldr ((++).(const ";succ")) [] i)

instance MyShow (a -> b) where
  myShow = const "(AN ARROW)"


-- X の要素を圏論に倣って終対象から X への射(Global element)として扱うための関数
el :: a -> (Pt -> a)
el = (const::a -> (Pt -> a))


-- Global elements 用 ユーティリティ
(===) :: Eq a =>  (Pt -> a) -> (Pt -> a) -> Bool
(===) x y = (x() == y())

showEl :: MyShow a => (Pt -> a) -> String
showEl x = (myShow $ x())

printEl :: MyShow a => (Pt -> a) -> IO ()
printEl = putStrLn . showEl


-- Diagrammatic-order な射の合成演算
(-:) = flip (.)

-- # 始対象と終対象
type Empty = Void
type Pt = ()

initArr :: Empty -> a
initArr = absurd

termArr :: a -> Pt
termArr = const ()

point :: Pt -> Pt
point = id

const' x = termArr -: x

-- # 余積対象と積対象
type (+++)  a b = Either a b
type (***) a b = (a,b)

-- 入射
inj1 :: a -> a +++ b
inj1 = Left

inj2 :: b -> a +++ b
inj2 = Right

-- 射影
prj1 :: a *** b -> a
prj1 = fst

prj2 :: a *** b -> b
prj2 = snd

-- 余積対象の仲介射
coPair :: (a -> c, b -> c) -> (a +++ b -> c)
coPair = uncurry either

-- 積対象の仲介射
pair   :: (c -> a, c -> b) -> (c -> a *** b)
pair = uncurry $ (<*>) . fmap (,)

-- 畳み込み
fol = coPair(id, id)

-- 対角射
dup = pair(id, id)

-- 射同士の余積
(+++) :: (a1 -> b1) -> (a2 -> b2) -> (a1 +++ a2 -> b1 +++ b2)
(+++) f g = coPair(f -: inj1 , g -: inj2)

-- 射同士の積
(***) :: (a1 -> b1) -> (a2 -> b2) -> (a1 *** a2 -> b1 *** b2)
(***) f g =   pair(prj1 -: f, prj2 -: g)

-- Twist の形式的双対
coTw :: a +++ b -> b +++ a
coTw = coPair(inj2, inj1)

-- Twist
tw :: a *** b -> b *** a
tw = pair(prj2, prj1)

-- # Exponential 対象
type (^) b a = a -> b

-- 評価射
ev :: (b ^ a) *** a -> b
ev = uncurry id

-- 射の転置 (transpose) の構成
trans :: (c *** a -> b) -> (c -> b ^ a)
trans = curry

-- 射 h:a->b の Exponential 対象 (Exp b a) の要素への変換
arrToEl :: (a -> b) -> (Pt -> b ^ a)
arrToEl h = trans(prj2-:h)

elToArr x = pair(termArr, id) -: (x *** id) -: ev

-- # 自然数対象 (NNO)
data Nat = Nat{imp::[()]} deriving Eq

_Nat :: Nat -> Nat
_Nat = id

zero :: Pt -> Nat
zero = el (Nat [])

succ' :: Nat -> Nat
succ' (Nat i) = Nat (():i)

-- 整数リテラルを使って NNO の Global elements としての自然数を得るための小細工
nat :: Int -> (Pt -> Nat)
-- nat i = zero -: (foldr (.) id (replicate i succ'))
nat i = el (Nat (replicate i ()))

-- recursion data x_0:1->X と f:X->X から rec_N(x_0, f):Nat->X を構成する関数
rec_N :: (Pt -> a, a -> a) -> (Nat -> a)
rec_N = ((flip ($) ())***id)-:((curry((id***(length.imp))-:uncurry(!!))).(uncurry.flip $ iterate))

add_N = (rec_N(arrToEl(_Nat), trans(ev-:succ'))***_Nat)-:ev
mul_N = (rec_N(arrToEl(termArr-:nat(0)), trans(pair(ev,prj2)-:add_N))***_Nat)-:ev
mul_N_fast (Nat x, Nat y) = Nat (replicate (length x * length y) ()) -- デバッグ用
sq_N  = dup-:mul_N

pred' = rec_N(pair(nat(0),nat(0)), pair(prj2, prj2 -:succ')) -: prj1
sub_N = tw-:(rec_N(arrToEl(_Nat), trans(ev-:pred'))***_Nat)-:ev

true :: Pt -> Nat
true = nat(1)

false :: Pt -> Nat
false = nat(0)

le' :: Nat *** Nat -> Nat
le' = sub_N -: not'

eq' :: Nat *** Nat -> Nat
eq' = pair(le',tw-:le')-:and'

not' :: Nat -> Nat
not' = rec_N(pair(nat(1),nat(0)), pair(prj2, prj2)) -: prj1

and' :: Nat *** Nat -> Nat
and' = mul_N

or' :: Nat *** Nat -> Nat
or' = add_N

if_N :: (Nat *** (a *** a)) -> a
if_N = ((rec_N(inj2,fol-:inj1) -: coPair(arrToEl(prj1),arrToEl(prj2)))***id)-:ev

a' =
  pair(pair(id,const'(nat(0)))-:eq',pair(const'(pair(nat(2),nat(2))-:inj1),pair(pair(id,const'(nat(1)))-:
  eq', pair(const'(pair(nat(9),nat(2))-:inj1),pair(pair(id,const'(nat(2)))-:
  eq', const'(pair(nat(16)-:inj2, pair(nat(0),nat(0))-:inj1)))-:if_N))-:if_N))-:if_N