Update equal? to compare graphs using the Union-Find algorithm

Signed-off-by: yamacir-kit <[email protected]>

Author: yamacir-kit

README.md

@@ -73,7 +73,7 @@ Subset of R7RS-small.
 cmake -B build -DCMAKE_BUILD_TYPE=Release
 cd build
 make package
-sudo apt install build/meevax_0.4.777_amd64.deb
+sudo apt install build/meevax_0.4.778_amd64.deb
 ```
 
 or
@@ -105,15 +105,15 @@ sudo rm -rf /usr/local/share/meevax
 
 | Target Name     | Description
 |-----------------|-------------
-| `all` (default) | Build shared-library `libmeevax.0.4.777.so` and executable `meevax`
+| `all` (default) | Build shared-library `libmeevax.0.4.778.so` and executable `meevax`
 | `test`          | Test executable `meevax`
-| `package`       | Generate debian package `meevax_0.4.777_amd64.deb`
+| `package`       | Generate debian package `meevax_0.4.778_amd64.deb`
 | `install`       | Copy files into `/usr/local` directly
 
 ## Usage
 
 ```
-Meevax Lisp 0.4.777
+Meevax Lisp 0.4.778
 
 Usage:
   meevax [option...] [file...]

VERSION

@@ -1 +1 @@
-0.4.777
+0.4.778

include/meevax/kernel/pair.hpp

@@ -169,4 +169,13 @@ inline namespace kernel
 } // namespace kernel
 } // namespace meevax
 
+template <>
+struct std::hash<meevax::object>
+{
+  auto operator ()(meevax::object const& x) const noexcept
+  {
+    return std::hash<decltype(x.get())>()(x.get());
+  }
+};
+
 #endif // INCLUDED_MEEVAX_KERNEL_PAIR_HPP

src/kernel/comparator.cpp

@@ -20,10 +20,100 @@ namespace meevax
 {
 inline namespace kernel
 {
+  struct box : public virtual pair // (value . unit)
+  {
+    auto unbox() -> object &
+    {
+      return first;
+    }
+
+    auto unbox() const -> object const&
+    {
+      return first;
+    }
+
+    auto set(object const& x) -> object const&
+    {
+      return first = x;
+    }
+  };
+
+  auto find(let const& b) -> object const&
+  {
+    if (let x = b.as<box>().unbox(); x.is<box>())
+    {
+      return b.as<box>().set(find(x));
+    }
+    else
+    {
+      return b;
+    }
+  }
+
+  /*
+     Efficient Nondestructive Equality Checking for Trees and Graphs
+  */
+  auto union_find(object const& x, object const& y, std::unordered_map<object, object> & forest)
+  {
+    using rank = std::uint32_t;
+
+    if (auto iterator_x = forest.find(x); iterator_x != forest.end())
+    {
+      if (auto iterator_y = forest.find(y); iterator_y != forest.end())
+      {
+        if (let root_x = find(iterator_x->second),
+                root_y = find(iterator_y->second); eq(root_x, root_y))
+        {
+          return true;
+        }
+        else
+        {
+          if (auto rank_x = root_x.as<box>().unbox().as<rank>(),
+                   rank_y = root_y.as<box>().unbox().as<rank>(); rank_x > rank_y)
+          {
+            root_x.as<box>().set(make<rank>(rank_x + rank_y));
+            root_y.as<box>().set(root_x);
+          }
+          else
+          {
+            root_x.as<box>().set(root_y);
+            root_y.as<box>().set(make<rank>(rank_x + rank_y));
+          }
+        }
+      }
+      else
+      {
+        forest.emplace(y, find(iterator_x->second));
+      }
+    }
+    else
+    {
+      if (auto iterator_y = forest.find(y); iterator_y != forest.end())
+      {
+        forest.emplace(x, find(iterator_y->second));
+      }
+      else
+      {
+        let const b = make<box>(make<rank>(1));
+        forest.emplace(x, b);
+        forest.emplace(y, b);
+      }
+    }
+
+    return false;
+  }
+
+  auto equal(object const& x, object const& y, std::unordered_map<object, object> & forest) -> bool
+  {
+    return eqv(x, y) or (x.is<pair>() and
+                         y.is<pair>() and (union_find(x, y, forest) or (equal(car(x), car(y), forest) and
+                                                                        equal(cdr(x), cdr(y), forest))));
+  }
+
   auto equal(object const& x, object const& y) -> bool
   {
-    return eqv(x, y) or std::equal(x.cbegin(), x.cend(),
-                                   y.cbegin(), y.cend(), equal);
+    auto forest = std::unordered_map<object, object>();
+    return equal(x, y, forest);
   }
 } // namespace kernel
 } // namespace meevax

test/list.cpp

@@ -48,5 +48,15 @@ auto main() -> int
     }
   }
 
+  {
+    let x = list(a, b);
+    cddr(x) = x;
+
+    let y = list(a, b, a, b);
+    cddddr(y) = y;
+
+    assert(equal(x, y));
+  }
+
   return EXIT_SUCCESS;
 }

test/r7rs.ss

@@ -856,8 +856,8 @@
 (check (equal? (make-vector 5 'a)
                (make-vector 5 'a)) => #t)
 
-; (check (equal? '#1=(a b . #1#)
-;                '#2=(a b a b . #2#)) => #t)
+(check (equal? '#1=(a b . #1#)
+               '#2=(a b a b . #2#)) => #t)
 
 (check (equal? (lambda (x) x)
                (lambda (y) y)) => #f) ; unspecified
@@ -1611,4 +1611,4 @@
 
 (check-report)
 
-(exit (check-passed? 431))
+(exit (check-passed? 432))