Bagaimana cara membuat algoritma ini lebih malas tanpa mengulangi sendiri?

(Terinspirasi oleh jawaban saya untuk pertanyaan ini .)

Pertimbangkan kode ini (seharusnya menemukan elemen terbesar yang kurang dari atau sama dengan input yang diberikan):

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

Ini tidak terlalu malas. Setelah GTkasing dimasukkan, kami tahu pasti bahwa nilai pengembalian akhir akan menjadi Justsesuatu yang bukan Nothing, tetapi Justmasih belum tersedia sampai akhir. Saya ingin membuat ini lebih malas sehingga Justtersedia segera setelah GTkasing dimasukkan. Kasus pengujian saya untuk ini adalah bahwa saya ingin Data.Maybe.isJust $ closestLess 5 (Node 3 () Leaf undefined)mengevaluasi Truedaripada bottoming. Inilah satu cara yang bisa saya pikirkan untuk melakukan ini:

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

Namun, saya sekarang mengulangi diri saya sendiri: logika inti sekarang ada di dalam closestLessdan di precise. Bagaimana saya bisa menulis ini sehingga malas tetapi tanpa mengulangi sendiri?

Daripada menggunakan pembungkus eksplisit, Anda dapat memanfaatkan sistem tipe. Perhatikan bahwa versi preciseyang digunakan Maybeuntuk cuplikan kode pertama Anda:

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

Algoritma ini hampir persis sama dengan versi precisetanpa Maybedari cuplikan kode kedua Anda, yang dapat ditulis dalam Identityfunctor sebagai:

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

Ini dapat disatukan menjadi versi polimorfik di 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

Dengan sendirinya, itu tidak menghasilkan banyak, tetapi jika kita tahu bahwa GTcabang akan selalu mengembalikan nilai, kita bisa memaksanya untuk berjalan di Identityfunctor, terlepas dari functor awal. Yaitu, kita bisa mulai di Maybefunctor tetapi berulang ke Identityfunctor di GTcabang:

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

Ini berfungsi baik dengan test case Anda:

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

dan merupakan contoh yang bagus dari rekursi polimorfik.

Hal baik lain tentang pendekatan ini dari sudut pandang kinerja adalah bahwa -ddump-simplmenunjukkan bahwa tidak ada pembungkus atau kamus. Semuanya terhapus pada level tipe dengan fungsi khusus untuk dua fungsi:

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

Mulai dari implementasi tanpa-malas saya, saya pertama kali refactored preciseuntuk menerima Justsebagai argumen, dan menggeneralisasikan tipenya sesuai:

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

Kemudian, aku berubah untuk melakukan wrapawal dan menyebut dirinya dengan iddalam GTkasus:

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)

Ini masih bekerja persis seperti sebelumnya, kecuali untuk manfaat kemalasan tambahan.

Saya pikir versi CPS yang Anda jawab sendiri adalah yang terbaik, tetapi untuk kelengkapannya ada beberapa ide lagi. (EDIT: Jawaban Buhr sekarang adalah yang paling berprestasi.)

Gagasan pertama adalah menyingkirkan closestSoFarakumulator, dan " " membiarkan GTkasus menangani semua logika memilih nilai paling kanan paling kecil dari argumen. Dalam formulir ini, GTkasing dapat langsung mengembalikan 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))

Ini lebih sederhana, tetapi membutuhkan lebih banyak ruang di tumpukan ketika Anda menekan banyak GTkasing. Secara teknis Anda bahkan bisa menggunakannya fromMaybedalam bentuk akumulator (yaitu, mengganti yang fromJusttersirat dalam jawaban luqui), tetapi itu akan menjadi cabang yang redundan dan tidak terjangkau.

Gagasan lain bahwa benar-benar ada dua "fase" dari algoritma, satu sebelum dan satu setelah Anda menekan GT, jadi Anda parameterkan oleh boolean untuk mewakili dua fase ini, dan gunakan tipe dependen untuk menyandikan invarian bahwa akan selalu ada menghasilkan fase kedua.

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)

Bagaimana tentang

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

?

Kita tidak hanya selalu tahu Just, setelah penemuan pertamanya, kita juga selalu tahu Nothing sampai saat itu. Itu sebenarnya dua "logika" yang berbeda.

Jadi, kita belok kiri dulu, jadi buat itu eksplisit:

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

Harganya kami ulangi paling banyak satu langkah paling banyak sekali.