備忘録やめた

備忘録として使用していたけどやめた．このブログに載せてあるコードのライセンスは別途記載がない限りWTFPL OR NYSLです．

`listify`の仕組みがわからない

Haskell

はじめに

sybのlistifyの仕組みがわからない．

注意

この記事ではbaseやsybよりコードを引用している．それらのコードはBSD-3-Clauseでライセンスされている．

baseのライセンス

sybのライセンス

.cabalファイル

cabal-version:      2.4
name:               tmp-7DsxMlggVR
version:            0.1.0.0

executable tmp-7DsxMlggVR
    main-is:          Main.hs
    -- GHC 9.2.2
    build-depends:    base == 4.16.1.0
                    , syb  == 0.7.2.1
    hs-source-dirs:   app
    default-language: Haskell2010

listifyの実行例

イルヴァの世界の方々の年齢に関してはイルヴァ資料館の情報を元にしている．

{-# LANGUAGE DeriveDataTypeable #-}

module Main
  ( main
  ) where

import           Data.Data             (Data)
import           Data.Generics.Schemes (listify)

data World =
  World
    { worldName :: String
    , groups    :: [Group]
    }
  deriving (Data)

data Group =
  Group
    { groupName :: String
    , members   :: [Member]
    }
  deriving (Data)

data Member =
  Member
    { memberName  :: String
    , anotherName :: String
    , age         :: Maybe Int
    }
  deriving (Data, Show)

worlds :: [World]
worlds =
  [ World
      { worldName = "Ilva"
      , groups =
          [ Group
              { groupName = "Elea"
              , members =
                  [ Member
                      { memberName = "Romias"
                      , anotherName = "The messenger from Vindale"
                      , age = Just 24
                      }
                  , Member
                      { memberName = "Larnneire"
                      , anotherName = "The listener of the wind"
                      , age = Just 22
                      }
                  ]
              }
          , Group
              { groupName = "People in Vernis"
              , members =
                  [ Member
                      { memberName = "Vessel"
                      , anotherName = "The white hawk"
                      , age = Just 31
                      }
                  , Member
                      { memberName = "Loyter"
                      , anotherName = "The crimson of Zanan"
                      , age = Just 32
                      }
                  ]
              }
          ]
      }
  , World
      { worldName = "The world of Zakuzaku Actors"
      , groups =
          [ Group
              { groupName = "Hagure Queendom"
              , members =
                  [ Member
                      { memberName = "Derich"
                      , anotherName = "The queen of Hagure Queendom"
                      , age = Nothing
                      }
                  , Member
                      { memberName = "Rosemary"
                      , anotherName = "Big moss"
                      , age = Nothing
                      }
                  ]
              }
          ]
      }
  ]

main :: IO ()
main = print $ listify onlyMember worlds

onlyMember :: Member -> Bool
onlyMember _ = True

%cabal run
Up to date
[Member {memberName = "Romias", anotherName = "The messenger from Vindale", age = Just 24},Member {memberName = "Larnneire", anotherName = "The listener of the wind", age = Just 22},Member {memberName = "Vessel", anotherName = "The white hawk", age = Just 31},Member {memberName = "Loyter", anotherName = "The crimson of Zanan", age = Just 32},Member {memberName = "Derich", anotherName = "The queen of Hagure Queendom", age = Nothing},Member {memberName = "Rosemary", anotherName = "Big moss", age = Nothing}]

実装の確認

まずlistifyの実装を確認する．Hackageに載っているコードより引用．

-- | Get a list of all entities that meet a predicate
listify :: Typeable r => (r -> Bool) -> GenericQ [r]
listify p = everything (++) ([] `mkQ` (\x -> if p x then [x] else []))

if p x then [x] else []の部分に関しては，リスト内包表記を用いることができるので，この関数は以下のように簡単になる．

listify :: Typeable r => (r -> Bool) -> GenericQ [r]
listify p = everything (++) ([] `mkQ` (\x -> [x | p x]))

GenericQはData.Generics.Aliasesで定義されている．

type GenericQ r = forall a. Data a => a -> r

mkQの実装を確認する．Hackageに載っているコードより引用．

-- | Make a generic query;
--   start from a type-specific case;
--   return a constant otherwise
--
mkQ :: ( Typeable a
       , Typeable b
       )
    => r
    -> (b -> r)
    -> a
    -> r
(r `mkQ` br) a = case cast a of
                        Just b  -> br b
                        Nothing -> r

中置関数を定義する方法をこのように用いることはありなんか．ただ，とりあえず通常のように3つの引数を取る関数のように表記してみる．また，case式はmaybeを使うことで簡略化できる．

mkQ :: (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ r br a = maybe r br (cast a)

この関数については1に説明がある．以下，実行結果も含めて引用．

That is, the query (r ‘mkQ‘ q) behaves as follows when applied to an argument a: if a’s type is the same as q’s argument type, use q to interrogate a; otherwise return the default value r. To illustrate, here are some examples of using mkQ in an interactive session (recall that ord has type Char -> Int):

Prelude> (22 ‘mkQ‘ ord) ’a’
97
Prelude> (22 ‘mkQ‘ ord) ’b’
98
Prelude> (22 ‘mkQ‘ ord) True
22

aの型が，brが引数として取る値の型に等しければ，br aを返し，そうでなければrを返す．

ところで，cast関数に関する面白い質問があるのでここに置いておく．

stackoverflow.com

さて，先程のlistifyの定義に戻る．

listify :: Typeable r => (r -> Bool) -> GenericQ [r]
listify p = everything (++) ([] `mkQ` (\x -> [x | p x]))

この場合，

foo :: (Typeable a, Typeable r) => (r -> Bool) -> a -> [r]
foo p = [] `mkQ` (\x -> [x | p x])

は，型がaの値vを受け取って，それがpが受け取る引数の型に等しく且つp v == Trueならば，[v]を返す．そうでなければ[]を返す．以下に実行例を示す．

ghci> foo even 3
[]
ghci> foo odd 3
[3]
ghci> foo odd 'c'
[]

次に，everythingの実装を確認する．まず実行例．

ageSum :: GenericQ Int
ageSum = everything (+) (0 `mkQ` (fromMaybe 0 . age))

main :: IO ()
main = print $ ageSum worlds

%cabal run
Up to date
109

ageがJustの場合，それに含まれている年齢を使い，ageがNothing，あるいはそもそも扱っている型がMemberでなければ0を使用する．そして，それらの和を計算する．

次に実装を確認する．Hackageに載っているコードより引用．

-- | Summarise all nodes in top-down, left-to-right order
everything :: forall r. (r -> r -> r) -> GenericQ r -> GenericQ r

-- Apply f to x to summarise top-level node;
-- use gmapQ to recurse into immediate subterms;
-- use ordinary foldl to reduce list of intermediate results
--
everything k f = go
  where
    go :: GenericQ r
    go x = foldl k (f x) (gmapQ go x)

gmapQについて確認する必要がある．

まずgmapQ自体を試してみる．

main :: IO ()
main = print $ gmapQ (mkQ "" worldName) worlds

Up to date
["Ilva",""]

["Ilva", "The world of Zakuzaku Actors"]とならなかったことに驚いたが，1によれば，gmapQは一階層しか操作せず，mkQ "" worldNameが最初のWorld型の値と次の[World]型の値に適用されるため，後者はデフォルト値の""が返される．

続いて実装を確認する．Hackageに載っているコードより引用．

-- | A generic query that processes the immediate subterms and returns a list
-- of results.  The list is given in the same order as originally specified
-- in the declaration of the data constructors.
gmapQ :: (forall d. Data d => d -> u) -> a -> [u]
gmapQ f = gmapQr (:) [] f

ちなみに[a]に対しては定義が上書きされている．

gmapQ  _   []     = []
gmapQ  f   (x:xs) = [f x,f xs]

gmapQrについて確認する．まず実行例．

main :: IO ()
main =
  putStrLn $
  gmapQr
    (\x acc -> acc ++ " and " ++ x)
    "First name"
    (mkQ "Default name" worldName)
    worlds

%cabal run
Up to date
First name and Default name and Ilva

foldrと似ている．

実装を確認する．Hackageに載っているコードより引用．

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r
gmapQr o r0 f x0 = unQr (gfoldl k (const (Qr id)) x0) r0
  where
    k :: Data d => Qr r (d->b) -> d -> Qr r b
    k (Qr c) x = Qr (\r -> c (f x `o` r))

gfoldlに関しては，既定の定義ではgfoldl = const idとなっている．しかし，deriving (Data)で定義されたfoldlは，大体以下のようになる．以下，ドキュメントより引用．

data T a b = C1 a b | C2 deriving (Typeable, Data)

instance (Data a, Data b) => Data (T a b) where
    gfoldl k z (C1 a b) = z C1 `k` a `k` b
    gfoldl k z C2       = z C2

ちなみに[a]に対しては以下のように定義されている．ソースコードより引用．

instance Data a => Data [a] where
  gfoldl _ z []     = z []
  gfoldl f z (x:xs) = z (:) `f` x `f` xs

また，Qrについては以下のような定義になっている．

newtype Qr r a = Qr { unQr  :: r -> r }

したがって，例えばC1 a bに対してgmapQrを適用すると以下のようになる．まず，gmapQrの実装を再掲する．

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r
gmapQr o r0 f x0 = unQr (gfoldl k (const (Qr id)) x0) r0
  where
    k :: Data d => Qr r (d->b) -> d -> Qr r b
    k (Qr c) x = Qr (\r -> c (f x `o` r))

x0にC1 a bを代入する．

gmapQr o r0 f (C1 a b) = unQr (gfoldl k (const (Qr id)) (C1 a b)) r0
  where
    k :: Data d => Qr r (d->b) -> d -> Qr r b
    k (Qr c) x = Qr (\r -> c (f x `o` r))

gfoldlを適用する．

gmapQr o r0 f (C1 a b) = unQr (const (Qr Id) C1 `k` a `k` b) r0
  where
    k :: Data d => Qr r (d->b) -> d -> Qr r b
    k (Qr c) x = Qr (\r -> c (f x `o` r))

const (Qr id) C1を適用する．

gmapQr o r0 f (C1 a b) = unQr (Qr id `k` a `k` b) r0
  where
    k :: Data d => Qr r (d->b) -> d -> Qr r b
    k (Qr c) x = Qr (\r -> c (f x `o` r))

始めのkを適用する．

gmapQr o r0 f (C1 a b) = unQr (Qr (\r -> id (f a `o` r)) `k` b) r0
  where
    k :: Data d => Qr r (d->b) -> d -> Qr r b
    k (Qr c) x = Qr (\r -> c (f x `o` r))

idを適用する．

gmapQr o r0 f (C1 a b) = unQr (Qr (\r -> f a `o` r) `k` b) r0
  where
    k :: Data d => Qr r (d->b) -> d -> Qr r b
    k (Qr c) x = Qr (\r -> c (f x `o` r))

更に，ラムダ式を簡単にして，以下のようになる．

gmapQr o r0 f (C1 a b) = unQr (Qr (f a `o`) `k` b) r0
  where
    k :: Data d => Qr r (d->b) -> d -> Qr r b
    k (Qr c) x = Qr (\r -> c (f x `o` r))

続いて次のkを適用する．

gmapQr o r0 f (C1 a b) = unQr (Qr (\r -> (f a `o`) (f b `o` r))) r0

括弧を払う．

gmapQr o r0 f (C1 a b) = unQr (Qr (\r -> f a `o` f b `o` r)) r0

ラムダ式を簡単にする．

gmapQr o r0 f (C1 a b) = unQr (Qr (f a `o` f b `o`)) r0

unQrを適用して括弧を外す．

gmapQr o r0 f (C1 a b) = f a `o` f b `o` r0

このような感じになる．

gmapQの定義を再掲する．

gmapQ :: (forall d. Data d => d -> u) -> a -> [u]
gmapQ f = gmapQr (:) [] f

簡約化したgmapQrの結果において，o = (:)，r0 = []を代入するとこうなる．

gmapQ f (C1 a b) = gmapQr (:) [] f (C1 a b) = f a : f b : [] = [f a, f b]

なんとなくわかってきた．

everythingの定義を再掲する．

-- | Summarise all nodes in top-down, left-to-right order
everything :: forall r. (r -> r -> r) -> GenericQ r -> GenericQ r

-- Apply f to x to summarise top-level node;
-- use gmapQ to recurse into immediate subterms;
-- use ordinary foldl to reduce list of intermediate results
--
everything k f = go
  where
    go :: GenericQ r
    go x = foldl k (f x) (gmapQ go x)

コメントにもあるように，まずfoldlの第二引数の(f x)で，トップレベルの値に関数fを適用する．第三引数の(gmapQ go x)で，xの一階層のすべての子にgo xを適用する．そしてアキュムレータの初期値をf xとして，gmapQ go xというリストを関数kを用いて畳み込む．

そしてlistifyの定義に戻る．

listify :: Typeable r => (r -> Bool) -> GenericQ [r]
listify p = everything (++) ([] `mkQ` (\x -> [x | p x]))

listify onlyMember worldsの場合を考える．

listify onlyMember worlds = everything (++) ([] `mkQ` (\x -> [x | onlyMember x]))

mkQによって生成される関数は，引数yを取って，yがMember型の場合，(\x -> [x | onlyMember x])を返す．onlyMember _ = Trueなので，つまりこの関数は，yがMember型ならば[y]という値を返す．そうでなければ[]を返す．everythingによって，これはすべての階層で行われる．

そして，(++)による畳込みで，すべて結合される．

おわりに

listifyなんとなくわかってきた．