自分で繰り返さずにこのアルゴリズムを遅延させるにはどうすればよいですか？

（この質問に対する私の答えに触発されました。）

次のコードを検討してください（指定された入力以下の最大の要素を見つけることが想定されています）。

data TreeMap v = Leaf | Node Integer v (TreeMap v) (TreeMap v) deriving (Show, Read, Eq, Ord)

closestLess :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess i = precise Nothing where
  precise :: Maybe (Integer, v) -> TreeMap v -> Maybe (Integer, v)
  precise closestSoFar Leaf = closestSoFar
  precise closestSoFar (Node k v l r) = case i `compare` k of
    LT -> precise closestSoFar l
    EQ -> Just (k, v)
    GT -> precise (Just (k, v)) r

これは非常に怠惰ではありません。一度GTケースが入力され、我々は、最終的な戻り値がされることを確実に知るJustのではなく、何かNothingが、Justそれでも最後まで使用できません。ケースが入力Justされるとすぐに使用できるように、このレイジーを作成したいと思いますGT。これに対する私のテストケースは、底打ちではなくData.Maybe.isJust $ closestLess 5 (Node 3 () Leaf undefined)評価したいというものですTrue。これは私がこれを行うと考えることができる1つの方法です：

data TreeMap v = Leaf | Node Integer v (TreeMap v) (TreeMap v) deriving (Show, Read, Eq, Ord)

closestLess :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess _ Leaf = Nothing
closestLess i (Node k v l r) = case i `compare` k of
  LT -> closestLess i l
  EQ -> Just (k, v)
  GT -> Just (precise (k, v) r)
  where
    precise :: (Integer, v) -> TreeMap v -> (Integer, v)
    precise closestSoFar Leaf = closestSoFar
    precise closestSoFar (Node k v l r) = case i `compare` k of
      LT -> precise closestSoFar l
      EQ -> (k, v)
      GT -> precise (k, v) r

ただし、繰り返しますが、コアロジックはとの両方にclosestLessありpreciseます。これを怠惰に繰り返すことなく、どのように書くことができますか？

明示的なラッパーを使用する代わりに、型システムを活用できます。最初のコードスニペットにprecise使用するのバージョンに注意して Maybeください。

precise :: Maybe (Integer, v) -> TreeMap v -> Maybe (Integer, v)
precise closestSoFar Leaf = closestSoFar
precise closestSoFar (Node k v l r) = case i `compare` k of
  LT -> precise closestSoFar l
  EQ -> Just (k, v)
  GT -> precise (Just (k, v)) r

は、2つ目のコードスニペットを含まpreciseないのバージョンとほぼ同じアルゴリズムMaybeであり、Identityファンクタで次のように記述できます。

precise :: Identity (Integer, v) -> TreeMap v -> Identity (Integer, v)
precise closestSoFar Leaf = closestSoFar
precise closestSoFar (Node k v l r) = case i `compare` k of
  LT -> precise closestSoFar l
  EQ -> Identity (k, v)
  GT -> precise (Identity (k, v)) r

これらは、でバージョンポリモーフィックに統合できますApplicative。

precise :: (Applicative f) => f (Integer, v) -> TreeMap v -> f (Integer, v)
precise closestSoFar Leaf = closestSoFar
precise closestSoFar (Node k v l r) = case i `compare` k of
  LT -> precise closestSoFar l
  EQ -> pure (k, v)
  GT -> precise (pure (k, v)) r

それ自体ではあまり効果はありませんが、GTブランチが常に値を返すことがわかっている場合Identityは、開始ファンクタに関係なく、ブランチを強制的に実行することができます。つまり、Maybeファンクターから始めIdentityて、GTブランチのファンクターに再帰できます。

closestLess :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess i = precise Nothing
  where
    precise :: (Applicative t) => t (Integer, v) -> TreeMap v -> t (Integer, v)
    precise closestSoFar Leaf = closestSoFar
    precise closestSoFar (Node k v l r) = case i `compare` k of
      LT -> precise closestSoFar l
      EQ -> pure (k, v)
      GT -> pure . runIdentity $ precise (Identity (k, v)) r

これはあなたのテストケースでうまく動作します：

> isJust $ closestLess 5 (Node 3 () Leaf undefined)
True

ポリモーフィック再帰の良い例です。

パフォーマンスの観点から見たこのアプローチのもう1つの良い点-ddump-simplは、ラッパーや辞書がないことを示しています。2つのファンクタに特化した関数を使用して、型レベルですべて削除されています。

closestLess
  = \ @ v i eta ->
      letrec {
        $sprecise
        $sprecise
          = \ @ v1 closestSoFar ds ->
              case ds of {
                Leaf -> closestSoFar;
                Node k v2 l r ->
                  case compareInteger i k of {
                    LT -> $sprecise closestSoFar l;
                    EQ -> (k, v2) `cast` <Co:5>;
                    GT -> $sprecise ((k, v2) `cast` <Co:5>) r
                  }
              }; } in
      letrec {
        $sprecise1
        $sprecise1
          = \ @ v1 closestSoFar ds ->
              case ds of {
                Leaf -> closestSoFar;
                Node k v2 l r ->
                  case compareInteger i k of {
                    LT -> $sprecise1 closestSoFar l;
                    EQ -> Just (k, v2);
                    GT -> Just (($sprecise ((k, v2) `cast` <Co:5>) r) `cast` <Co:4>)
                  }
              }; } in
      $sprecise1 Nothing eta

私の怠惰でない実装から始めて、私は最初に引数としてprecise受け取るJustようにリファクタリングし、それに応じてその型を一般化しました：

data TreeMap v = Leaf | Node Integer v (TreeMap v) (TreeMap v) deriving (Show, Read, Eq, Ord)

closestLess :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess i = precise Just Nothing where
  precise :: ((Integer, v) -> t) -> t -> TreeMap v -> t
  precise _ closestSoFar Leaf = closestSoFar
  precise wrap closestSoFar (Node k v l r) = case i `compare` k of
    LT -> precise wrap closestSoFar l
    EQ -> wrap (k, v)
    GT -> precise wrap (wrap (k, v)) r

それから、私はそれをwrap早く行うように変更idし、GTケースで自分自身を呼び出します：

data TreeMap v = Leaf | Node Integer v (TreeMap v) (TreeMap v) deriving (Show, Read, Eq, Ord)

closestLess :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess i = precise Just Nothing where
  precise :: ((Integer, v) -> t) -> t -> TreeMap v -> t
  precise _ closestSoFar Leaf = closestSoFar
  precise wrap closestSoFar (Node k v l r) = case i `compare` k of
    LT -> precise wrap closestSoFar l
    EQ -> wrap (k, v)
    GT -> wrap (precise id (k, v) r)

これは、追加された遅延の利点を除いて、以前とまったく同じように機能します。

あなたが自分で回答したCPSバージョンが最適だと思いますが、完全を期すために、ここにいくつかのアイデアを示します。（編集：Buhrの答えが最もパフォーマンスが高くなりました。）

最初のアイデアは、 " closestSoFar"アキュムレータを取り除くことで、代わりにGT、引数よりも小さい右端の値を選択するすべてのロジックをケースに処理させます。この形式では、GTケースは直接Just：

closestLess1 :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess1 _ Leaf = Nothing
closestLess1 i (Node k v l r) =
  case i `compare` k of
    LT -> closestLess1 i l
    EQ -> Just (k, v)
    GT -> Just (fromMaybe (k, v) (closestLess1 i r))

これはより単純ですが、多くのGT場合、スタックで少し多くのスペースを必要とします。技術的にfromMaybeは、それをアキュムレータ形式で使用することもできます（つまり、fromJustluquiの答えの暗黙を置き換える）こともできますが、これは冗長で到達できないブランチになります。

アルゴリズムには実際には2つの「フェーズ」があり、を押す前と後のGT2つがあるため、ブール値でパラメータ化してこれらの2つのフェーズを表し、依存型を使用して常に存在する不変式をエンコードします。その結果、第2フェーズになります。

data SBool (b :: Bool) where
  STrue :: SBool 'True
  SFalse :: SBool 'False

type family MaybeUnless (b :: Bool) a where
  MaybeUnless 'True a = a
  MaybeUnless 'False a = Maybe a

ret :: SBool b -> a -> MaybeUnless b a
ret SFalse = Just
ret STrue = id

closestLess2 :: Integer -> TreeMap v -> Maybe (Integer, v)
closestLess2 i = precise SFalse Nothing where
  precise :: SBool b -> MaybeUnless b (Integer, v) -> TreeMap v -> MaybeUnless b (Integer, v)
  precise _ closestSoFar Leaf = closestSoFar
  precise b closestSoFar (Node k v l r) = case i `compare` k of
    LT -> precise b closestSoFar l
    EQ -> ret b (k, v)
    GT -> ret b (precise STrue (k, v) r)

いかがですか

GT -> let Just v = precise (Just (k,v) r) in Just v

？

私たちは常に知っているだけでなくJust、その最初の発見後、Nothing それまでも常に知っています。これは実際には2つの異なる「ロジック」です。

それで、最初に左に行くので、それを明示的にします：

data TreeMap v = Leaf | Node Integer v (TreeMap v) (TreeMap v) 
                 deriving (Show, Read, Eq, Ord)

closestLess :: Integer 
            -> TreeMap v 
            -> Maybe (Integer, v)
closestLess i = goLeft 
  where
  goLeft :: TreeMap v -> Maybe (Integer, v)
  goLeft n@(Node k v l _) = case i `compare` k of
          LT -> goLeft l
          _  -> Just (precise (k, v) n)
  goLeft Leaf = Nothing

  -- no more maybe if we're here
  precise :: (Integer, v) -> TreeMap v -> (Integer, v)
  precise closestSoFar Leaf           = closestSoFar
  precise closestSoFar (Node k v l r) = case i `compare` k of
        LT -> precise closestSoFar l
        EQ -> (k, v)
        GT -> precise (k, v) r

価格は、最大で1つのステップを最大で1回繰り返すことです。