Bagaimana cara membuat algoritma ini lebih malas tanpa mengulangi sendiri?


9

(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?

Jawaban:


4

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

2
Ini adalah solusi yang sangat keren
luqui

3

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.


1
Apakah semua yang ada iddi antara Justdan final (k,v)dihilangkan oleh kompiler? mungkin tidak, fungsi yang seharusnya buram, dan Anda bisa (ketik-layak) digunakan first (1+)daripada idsemua kompiler tahu. tapi itu membuat kode ringkas ... tentu saja, kode saya adalah penguraian dan spesifikasi Anda di sini, dengan penyederhanaan tambahan (penghapusan ids). juga sangat menarik bagaimana tipe yang lebih umum berfungsi sebagai kendala, hubungan antara nilai yang terlibat (meskipun tidak cukup ketat, dengan first (1+)diizinkan sebagai wrap).
Will Ness

1
(lanjutan) polimorfik Anda precisedigunakan pada dua jenis, yang secara langsung berhubungan dengan dua fungsi khusus yang digunakan dalam varian yang lebih verbose. interaksi yang bagus di sana. Juga, saya tidak akan menyebut CPS ini, wraptidak digunakan sebagai kelanjutan, itu tidak dibangun "di dalam", itu ditumpuk - dengan rekursi - di luar. Mungkin jika itu yang digunakan sebagai kelanjutan Anda bisa menyingkirkan orang-orang asing ids ... btw kita bisa lihat di sini sekali lagi bahwa pola lama argumen fungsional digunakan sebagai indikator apa yang harus dilakukan, beralih antara dua program aksi ( Justatau id).
Will Ness

3

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)

Saya tidak memikirkan jawaban saya sebagai CPS sampai Anda menunjukkannya. Saya sedang memikirkan sesuatu yang lebih dekat dengan transformasi pekerja-bungkus. Saya kira Raymond Chen menyerang lagi!
Joseph Sible-Reinstate Monica

2

Bagaimana tentang

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

?


Karena itu adalah kecocokan pola yang tidak lengkap. Bahkan jika fungsi saya adalah keseluruhan adalah total, saya tidak suka itu sebagian.
Joseph Sible-Reinstate Monica

Jadi Anda mengatakan "kami tahu pasti" masih ragu. Mungkin itu sehat.
luqui

Kami tahu pasti, mengingat bahwa blok kode kedua saya di pertanyaan saya selalu kembali Justnamun total. Saya tahu bahwa solusi Anda sebagai tertulis sebenarnya total, tetapi rapuh karena modifikasi yang tampaknya aman dapat menghasilkan bottoming.
Joseph Sible-Reinstate Monica

Ini juga akan sedikit memperlambat program, karena GHC tidak dapat membuktikannya akan selalu demikian Just, sehingga akan menambah tes untuk memastikan itu tidak Nothingsetiap kali berulang.
Joseph Sible-Reinstate Monica

1

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.

Dengan menggunakan situs kami, Anda mengakui telah membaca dan memahami Kebijakan Cookie dan Kebijakan Privasi kami.
Licensed under cc by-sa 3.0 with attribution required.