diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for symmetric-list + +## 0.1.0.0 -- 2026-10-20 + +* First version: `SymmetricList` with O(1) amortized access to both ends. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +Copyright (c) 2026, nahuel-merlo + + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,252 @@ +# symmetric-list + +## Motivation + +Haskell lists (`[a]`) are singly linked: operating on the **front** is cheap, +but any operation on the **end** forces a traversal of the whole list. + +The goal of this project is to improve the complexity of those inefficient +operations while keeping an interface similar to that of `Data.List`. + +| Operation | `[a]` | `SymmetricList a` | +|-----------------------|--------------|--------------------------| +| `cons`, `head` | $O(1)$ | $O(1)$ | +| `tail`, `uncons` | $O(1)$ | $O(1)$ amortized | +| `snoc` (`xs ++ [x]`) | $O(n)$ | $O(1)$ | +| `last` | $O(n)$ | $O(1)$ | +| `init`, `unsnoc` | $O(n)$ | $O(1)$ amortized | +| `reverse` | $O(n)$ | $O(1)$ | +| `length` | $O(n)$ | $O(1)$ | +| `append` (`<>`) | $O(m)$ | $O(\min(m, n))$ | + +### How does it compare? + +| | symmetric-list | deque | Data.Sequence | +| --- | --- | --- | --- | +| Mixed use of both ends | O(1) amortized | O(n) per operation | O(1) amortized | +| `head` / `last` | O(1) worst case | O(n) if its side is empty | O(1) | +| `length` | O(1) | O(n) | O(1) | +| `reverse` | O(1) | O(1) | O(n) | +| Indexing / splitting | — | O(n) | O(log n) | + +Use `Data.Sequence` if you need random access or splitting, `deque` for a +queue consumed from one end, and `symmetric-list` when you work on both ends +and want the `Data.List` API. + +### Beyond efficiency: correctness + +This library does not only propose an efficient data structure (there are +already several implementations of double-ended lists, such as `Data.Sequence` +in `containers`). It also aims to **study its correctness**. + +Currently, every operation is checked with property-based testing +([QuickCheck](https://hackage.haskell.org/package/QuickCheck)) against its +`Data.List` counterpart. The next step is to add formal verification with +[Liquid Haskell](https://ucsd-progsys.github.io/liquidhaskell/), proving that +every operation preserves the representation [invariants](#invariant). + +### Usage + +The module is designed to be imported qualified, since many of its names +(`head`, `last`, `reverse`, `map`, ...) clash with the `Prelude`: + +```haskell +import Data.SymmetricList (SymmetricList) +import qualified Data.SymmetricList as SymmetricList + +xs :: SymmetricList Int +xs = SymmetricList.snoc 4 (SymmetricList.fromList [1, 2, 3]) + +-- SymmetricList.last xs == 4 +-- SymmetricList.toList (SymmetricList.init xs) == [1, 2, 3] +-- xs <> xs == SymmetricList.append xs xs +``` + +This convention follows the guide +[Designing Haskell libraries for qualified import](https://mrcjkb.dev/posts/2026-10-06-design-for-qualified-import.html): +the type and the functions that operate on it live in a module with the same +name, meant to be imported qualified, and operators (such as `<>`) are used +unqualified. + +## Representation + +We start from a list $l$ and split it into two parts: + +$$ +l = xs \mathbin{+\!\!+} ys +\qquad\text{for example}\qquad +[1,2,3,4,5,6] = [1,2,3] \mathbin{+\!\!+} [4,5,6] +$$ + +$$ +ys' = \mathrm{reverse}\ ys +\quad\Longrightarrow\quad +ys = \mathrm{reverse}\ ys' +\quad\Longrightarrow\quad +l = xs \mathbin{+\!\!+} \mathrm{reverse}\ ys' +$$ + +$$ +\langle xs,\ ys \rangle \;\equiv\; xs \mathbin{+\!\!+} \mathrm{reverse}\ ys +$$ + +If $xs = [x_1, \dots, x_k]$ and $ys = [y_1, \dots, y_m]$, the represented list +is: + +$$ +[\;\underbrace{x_1,\ x_2,\ \dots,\ x_k}_{xs}\;,\;\underbrace{y_m,\ \dots,\ y_2,\ y_1}_{\mathrm{reverse}\ ys}\;] +$$ + +This way the **first** element is at the head of $xs$ ($x_1$) and the **last** +one at the head of $ys$ ($y_1$): both ends are one step away. + +In Haskell: + +```haskell +data SymmetricList a = SL !Int !Int ([a], [a]) +-- lenL lenR (xs, ys) +``` + +Storing the lengths makes `length` $O(1)$ and lets rebalancing avoid +traversing the lists to measure them. + +### Invariant + +If one of the two lists is empty, the other has at most one element: + +$$ +\mathrm{null}\ xs \Rightarrow |ys| \le 1 +\qquad\qquad +\mathrm{null}\ ys \Rightarrow |xs| \le 1 +$$ + +This guarantees that `head` and `last` always find their element in $O(1)$. + +### Inserting at the end: `snoc` + +Adding to the end means adding to the head of $ys$: + +$$ +\mathrm{snoc}\ z\ \langle xs,\ ys \rangle = \langle xs,\ z : ys \rangle +$$ + +If $xs$ is empty, by the invariant $ys$ has at most one element, which +becomes the left side: $\mathrm{snoc}\ z\ \langle [\,],\ ys \rangle = \langle ys,\ [z] \rangle$. + +Example, starting from `fromList [1..6]` (which splits the elements in half): + +$$ +\begin{array}{lcl} +\mathrm{fromList}\ [1,2,3,4,5,6] & = & \langle [1,2,3],\ [6,5,4] \rangle \\ +\mathrm{snoc}\ 7\ \langle [1,2,3],\ [6,5,4] \rangle & = & \langle [1,2,3],\ [7,6,5,4] \rangle +\end{array} +$$ + +### Removing from the end: `init` / `unsnoc` + +Removing the last element means removing the head of $ys$: + +$$ +\mathrm{unsnoc}\ \langle xs,\ y : ys \rangle = (\langle xs,\ ys \rangle,\ y) \qquad \text{if } ys \neq [\,] +$$ + +The interesting case is when $ys$ has a single element: removing it would +leave it empty and break the invariant. In that case the list is +**rebalanced**, splitting the remaining elements in half between both sides: + +$$ +\mathrm{unsnoc}\ \langle xs,\ [y] \rangle = (\mathrm{balance}\ \langle xs,\ [\,] \rangle,\ y) +$$ + +$$ +\mathrm{balance}\ \langle xs,\ ys \rangle = \langle\, \mathrm{take}\ \lfloor n/2 \rfloor\ l,\ \ \mathrm{reverse}\,(\mathrm{drop}\ \lfloor n/2 \rfloor\ l) \,\rangle +\quad \text{where } l = xs \mathbin{+\!\!+} \mathrm{reverse}\ ys,\ \ n = |l| +$$ + +Example: + +$$ +\begin{array}{lcl} +\mathrm{unsnoc}\ \langle [1,2,3],\ [6,5,4] \rangle & = & (\langle [1,2,3],\ [5,4] \rangle,\ 6) \\ +\mathrm{unsnoc}\ \langle [1,2,3],\ [5,4] \rangle & = & (\langle [1,2,3],\ [4] \rangle,\ 5) \\ +\mathrm{unsnoc}\ \langle [1,2,3],\ [4] \rangle & = & (\mathrm{balance}\ \langle [1,2,3],\ [\,] \rangle,\ 4) = (\langle [1],\ [3,2] \rangle,\ 4) +\end{array} +$$ + +`cons`, `tail` and `uncons` are symmetric: they operate on $xs$ and rebalance +when $xs$ becomes empty. `reverse` simply swaps the sides: +$\mathrm{reverse}\ \langle xs,\ ys \rangle = \langle ys,\ xs \rangle$. + +### Why $O(1)$ amortized? + +`balance` costs $O(n)$, but it only happens when one side has become empty, +and it leaves both sides with half of the elements. Taking as potential +function + +$$ +\Phi(\langle xs,\ ys \rangle) = \big|\, |xs| - |ys| \,\big| +$$ + +each cheap operation changes $\Phi$ by at most $1$, and a rebalance of cost +$n$ happens when $\Phi \approx n$ and brings it down to $\Phi \le 1$. The cost +of the rebalance is paid with the accumulated potential, so a sequence of $k$ +operations on the ends (`cons`, `snoc`, `tail`, `init`, ...) costs $O(k)$. + +## Benchmarks + +Comparison against `[a]` with [`tasty-bench`](https://hackage.haskell.org/package/tasty-bench), +on the list `[1..n]` (see [bench/Bench.hs](bench/Bench.hs)). Compiled with +GHC 9.10.3 and `-O2`; absolute times depend on the machine. + +For the operations that return a list (`snoc`, `init`, `unsnoc`), the `[a]` +version is evaluated to normal form: because of lazy evaluation, evaluating to +WHNF would only measure the first constructor and not the traversal. + +### Individual operations, $n = 100\,000$ + +| Operation | `SymmetricList` | `[a]` | Speedup | +|-----------|----------------:|--------:|------------:| +| `last` | 6.88 ns | 939 μs | ~136 000× | +| `reverse` | 15.5 ns | 1.19 ms | ~77 000× | +| `snoc` | 18.6 ns | 1.65 ms | ~89 000× | +| `init` | 15.5 ns | 1.65 ms | ~106 000× | +| `unsnoc` | 21.7 ns | 5.25 ms | ~242 000× | +| `length` | 8.38 ns | 825 μs | ~98 000× | + +The time of `SymmetricList` stays constant as $n$ grows, while that of `[a]` +grows linearly: + +| `last` | $n = 1\,000$ | $n = 10\,000$ | $n = 100\,000$ | +|---------------|-------------:|--------------:|---------------:| +| `SymmetricList` | 8.11 ns | 6.95 ns | 6.88 ns | +| `[a]` | 1.50 μs | 17.6 μs | 939 μs | + +### Amortized cost: emptying from the end + +`unsnoc` is applied repeatedly until the list is empty, so that the cost of +the rebalances is included in the measurement. With `[a]` this is $O(n^2)$, +with `SymmetricList` it is $O(n)$: + +| $n$ | `SymmetricList` | `[a]` | +|-----------|----------------:|--------:| +| 1 000 | 38.1 μs | 13.0 ms | +| 10 000 | 418 μs | 1.41 s | +| 100 000 | 6.50 ms | — | + +(With `[a]` it is not run for $n = 100\,000$ because it takes too long.) + +### Running the benchmarks + +```sh +cabal bench symmetric-list-bench +# export results +cabal bench symmetric-list-bench --benchmark-options='--csv bench.csv --svg bench.svg' +``` + +## References + +- Richard Bird and Jeremy Gibbons. *Algorithm Design with Haskell*. + Cambridge University Press, 2020. The implementation follows the + presentation of symmetric lists in this book. +- Chris Okasaki. *Purely Functional Data Structures*. Cambridge University + Press, 1998. The canonical reference for this structure. diff --git a/bench/Bench.hs b/bench/Bench.hs new file mode 100644 --- /dev/null +++ b/bench/Bench.hs @@ -0,0 +1,70 @@ +module Main (main) where + +import Test.Tasty.Bench +import Data.SymmetricList (SymmetricList) +import qualified Data.SymmetricList as SymmetricList +import qualified Data.List as L + +-- balanced symmetric list benchmark +main :: IO () +main = defaultMain + [ env (pure (SymmetricList.fromList [1 .. n :: Int], [1 .. n :: Int])) $ \ ~(sl, xs) -> + bgroup ("n=" ++ show n) + [ bgroup "last" + [ bench "symmetricList" $ whnf SymmetricList.last sl + , bcompare (baseline n "last") $ + bench "list" $ whnf last xs + ] + , bgroup "reverse" + [ bench "symmetricList" $ whnf SymmetricList.reverse sl + , bcompare (baseline n "reverse") $ + bench "list" $ whnf reverse xs + ] + , bgroup "snoc" + [ bench "symmetricList" $ whnf (uncurry SymmetricList.snoc) (n, sl) + , bcompare (baseline n "snoc") $ + bench "list" $ nf (uncurry (++)) (xs, [n]) + ] + , bgroup "init" + [ bench "symmetricList" $ whnf SymmetricList.init sl + , bcompare (baseline n "init") $ + bench "list" $ nf init xs + ] + , bgroup "unsnoc" + [ bench "symmetricList" $ whnf SymmetricList.unsnoc sl + , bcompare (baseline n "unsnoc") $ + bench "list" $ nf L.unsnoc xs + ] + , bgroup "length" $ + [ bench "symmetricList" $ whnf length sl + , bcompare (baseline n "length") $ + bench "list" $ whnf length xs + ] + , bgroup "drain from right" $ + [ bench "symmetricList" $ whnf drainSL sl ] ++ + [ bcompare (baseline n "drain from right") $ + bench "list" $ whnf drainList xs + | n <= 10000 + ] + ] + | n <- [1000, 10000, 100000] + ] + +baseline :: Int -> String -> String +baseline n node = ("$NF == \"symmetricList\" && $(NF-1) == \"" ++ node ++ "\" && $(NF-2) == \"n="++ show n ++"\"") + +-- | Removes every element from the back, summing them. +drainSL :: SymmetricList Int -> Int +drainSL = go 0 + where + go acc s = acc `seq` case SymmetricList.unsnoc s of + Nothing -> acc + Just (s', y) -> go (acc + y) s' + +-- | Removes every element from the back, summing them. +drainList :: [Int] -> Int +drainList = go 0 + where + go acc xs = acc `seq` case L.unsnoc xs of + Nothing -> acc + Just (xs', y) -> go (acc + y) xs' diff --git a/src/Data/SymmetricList.hs b/src/Data/SymmetricList.hs new file mode 100644 --- /dev/null +++ b/src/Data/SymmetricList.hs @@ -0,0 +1,221 @@ +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} + +{-| +Module : Data.SymmetricList +Description : Lists with efficient access to both ends + +A symmetric list stores its elements split between a front list and a +reversed back list, giving \(\mathcal{O}(1)\) access to both ends. + += Importing + +This module is designed to be imported qualified: many of its names +('head', 'tail', 'reverse', 'map', ...) clash with "Prelude" and "Data.List". +The standard import is the type unqualified and everything else qualified +as @SymmetricList@: + +> import Data.SymmetricList (SymmetricList) +> import qualified Data.SymmetricList as SymmetricList +> +> xs :: SymmetricList Int +> xs = SymmetricList.snoc 3 (SymmetricList.fromList [1, 2]) + +Appending is also available unqualified through the 'Semigroup' instance: + +> SymmetricList.append xs ys == xs <> ys +-} + +module Data.SymmetricList ( + SymmetricList, + fromList, + toList, + nil, + cons, + snoc, + head, + last, + init, + tail, + dropWhile, + null, + single, + singleton, + reverse, + map, + append, + uncons, + unsnoc, +) where + +import Prelude hiding (head, tail, last, dropWhile, init, null, reverse, map, filter) +import qualified Data.List as Lst +import Data.SymmetricList.Internal + +-- | \(\mathcal{O}(n)\). Returns the symmetric representation of the list +-- +-- > xs == (toList . fromList) xs +fromList :: [a] -> SymmetricList a +fromList l = SL lenL lenR (xs, Lst.reverse ys) + where + len = Lst.length l + lenL = (len `div` 2) + lenR = len - lenL + (xs, ys) = Lst.splitAt lenL l + +-- | \(\mathcal{O}(n)\). Returns the list representation of the symmetric lits +-- +-- > (toList . fromList) xs == xs +toList :: SymmetricList a -> [a] +toList (SL _ _ (xs, ys)) = xs Lst.++ Lst.reverse ys + +-- | \(\mathcal{O}(1)\). Returns an empty symmetric list +-- +-- On lists: @[]@ is \(\mathcal{O}(1)\). +-- +-- > toList nil == [] +nil :: SymmetricList a +nil = SL 0 0 ([], []) + +-- | \(\mathcal{O}(1)\). Adds an element to the front of a symmetric list. +-- +-- On lists: @(:)@ is \(\mathcal{O}(1)\). +-- +-- > toList (cons x (fromList xs)) == x:xs +cons :: a -> SymmetricList a -> SymmetricList a +cons x (SL lenL lenR (xs, ys)) + | Lst.null ys = SL 1 (lenL) ([x], xs) + | otherwise = SL (lenL+1) lenR (x:xs, ys) + +-- | \(\mathcal{O}(1)\). Adds an element to the end of a symmetric list. +-- +-- __Faster than lists:__ @xs ++ [x]@ is \(\mathcal{O}(n)\). +-- +-- > toList (snoc x (fromList xs)) == xs ++ [x] +snoc :: a -> SymmetricList a -> SymmetricList a +snoc y (SL lenL lenR (xs, ys)) + | Lst.null xs = SL (lenR) 1 (ys, [y]) + | otherwise = SL (lenL) (lenR+1) (xs, y:ys) + +-- | \(\mathcal{O}(1)\). Returns the first element of a non-empty symmetric list. +-- Fails on an empty symmetric list. +-- +-- On lists: 'Prelude.head' from "Prelude" is \(\mathcal{O}(1)\). +-- +-- > head (fromList xs) == Prelude.head xs +head :: SymmetricList a -> a +head (SL _ _ ([], [])) = error "head on empty symmetric list" +head (SL _ _ ((x:_), _)) = x +head (SL _ _ (_, [y])) = y + +-- | \(\mathcal{O}(1)\). Returns the last element of a non-empty symmetric list. +-- Fails on an empty symmetric list. +-- +-- __Faster than lists:__ 'Prelude.last' from "Prelude" is \(\mathcal{O}(n)\). +-- +-- > last (fromList xs) == Prelude.last xs +last :: SymmetricList a -> a +last (SL _ _ ([], [])) = error "last on empty symmetric list" +last (SL _ _ (_, (y:_))) = y +last (SL _ _([x], _)) = x + +-- | \(\mathcal{O}(1)\) amortized, \(\mathcal{O}(n)\) worst case. Removes the first element of a +-- non-empty symmetric list. Fails on an empty symmetric list. +-- +-- On lists: 'Prelude.tail' from "Prelude" is \(\mathcal{O}(1)\). +-- +-- > toList (tail (fromList xs)) == Prelude.tail xs +tail :: SymmetricList a -> SymmetricList a +tail (SL _ _ ([], [])) = error "tail on empty symmetric list" +tail (SL _ _([], [_])) = nil +tail (SL _ lenR ([_], ys)) = balance (SL 0 lenR ([], ys)) +tail (SL lenL lenR (_:xs, ys)) = SL (lenL-1) lenR (xs, ys) + +-- | \(\mathcal{O}(1)\) amortized, \(\mathcal{O}(n)\) worst case. Removes the last element of a +-- non-empty symmetric list. Fails on an empty symmetric list. +-- +-- __Faster than lists:__ 'Prelude.init' from "Prelude" is \(\mathcal{O}(n)\). +-- +-- > toList (init (fromList xs)) == Prelude.init xs +init :: SymmetricList a -> SymmetricList a +init (SL _ _ ([], [])) = error "init on empty symmetric list" +init (SL _ _ ([_], [])) = nil +init (SL _ _ ([], [_])) = nil +init (SL lenL _ (xs, [_])) = balance (SL lenL 0 (xs, [])) +init (SL lenL lenR (xs, _:ys)) = SL lenL (lenR-1) (xs, ys) + +-- | \(\mathcal{O}(n)\). Removes the longest prefix whose elements satisfy the predicate. +-- +-- On lists: 'Prelude.dropWhile' from "Prelude" is \(\mathcal{O}(n)\). +-- +-- > toList (dropWhile p (fromList xs)) == Prelude.dropWhile p xs +dropWhile :: (a -> Bool) -> SymmetricList a -> SymmetricList a +dropWhile _ (SL _ _ ([], [])) = nil +dropWhile p sl + | p $ head sl = dropWhile p (tail sl) + | otherwise = sl + +-- | \(\mathcal{O}(1)\). Checks whether a symmetric list is empty. +-- +-- On lists: 'Prelude.null' from "Prelude" is \(\mathcal{O}(1)\). +-- +-- > null (fromList xs) == Prelude.null xs +null :: SymmetricList a -> Bool +null (SL _ _ ([], [])) = True +null _ = False + +-- | \(\mathcal{O}(1)\). Checks whether a symmetric list has exactly one element. +-- +-- > single (fromList xs) == (length xs == 1) +single :: SymmetricList a -> Bool +single (SL _ _ ([_], [])) = True +single (SL _ _ ([], [_])) = True +single _ = False + +-- | \(\mathcal{O}(1)\). Returns a symmetric list with a single element. +-- +-- On lists: 'Data.List.singleton' from "Data.List" is \(\mathcal{O}(1)\). +-- +-- > toList (singleton x) == [x] +singleton :: a -> SymmetricList a +singleton x = cons x nil + +-- | \(\mathcal{O}(1)\). Reverses a symmetric list by swapping its left and right lists. +-- +-- __Faster than lists:__ 'Prelude.reverse' from "Prelude" is \(\mathcal{O}(n)\). +-- +-- > toList (reverse (fromList xs)) == Prelude.reverse xs +reverse :: SymmetricList a -> SymmetricList a +reverse (SL lenL lenR (xs, ys)) = SL lenR lenL (ys, xs) + +-- | \(\mathcal{O}(n)\). Applies a function to every element of a symmetric list. +-- +-- On lists: 'Prelude.map' from "Prelude" is \(\mathcal{O}(n)\). +-- +-- > toList (map f (fromList xs)) == Prelude.map f xs +map :: (a -> b) -> SymmetricList a -> SymmetricList b +map = fmap + +-- | \(\mathcal{O}(1)\) amortized, \(\mathcal{O}(n)\) worst case. Splits a symmetric list into its first +-- element and the rest, or returns 'Nothing' if it is empty. +-- +-- On lists: 'Data.List.uncons' from "Data.List" is \(\mathcal{O}(1)\). +-- +-- > fmap (fmap toList) (uncons (fromList xs)) == Data.List.uncons xs +uncons :: SymmetricList a -> Maybe (a, SymmetricList a) +uncons (SL _ _ ([], [])) = Nothing +uncons (SL _ lenR ([x], ys)) = Just (x, balance (SL 0 lenR ([], ys))) +uncons (SL lenL lenR (x:xs, ys)) = Just (x, SL (lenL-1) lenR (xs,ys)) +uncons (SL _ _ ([], [y])) = Just (y, nil) + +-- | \(\mathcal{O}(1)\) amortized, \(\mathcal{O}(n)\) worst case. Splits a symmetric list into all its +-- elements but the last one and the last element, or returns 'Nothing' if it +-- is empty. +-- +-- __Faster than lists:__ 'Data.List.unsnoc' from "Data.List" is \(\mathcal{O}(n)\). +-- +-- > fmap (\(sl, x) -> (toList sl, x)) (unsnoc (fromList xs)) == Data.List.unsnoc xs +unsnoc :: SymmetricList a -> Maybe (SymmetricList a, a) +unsnoc (SL _ _ ([], [])) = Nothing +unsnoc (SL lenL _ (xs, [y])) = Just (balance (SL lenL 0 (xs, [])), y) +unsnoc (SL lenL lenR (xs, y:ys)) = Just (SL lenL (lenR-1) (xs, ys), y) +unsnoc (SL _ _ ([x], [])) = Just (nil, x) diff --git a/src/Data/SymmetricList/Internal.hs b/src/Data/SymmetricList/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/SymmetricList/Internal.hs @@ -0,0 +1,99 @@ +module Data.SymmetricList.Internal ( + SymmetricList(..), + balance, + revAppend, + append, +) where + +import qualified Data.List as Lst +import Control.DeepSeq + +{-- + SymmetricList (xs, ys) = xs ++ reverse ys + Invariants over SymmetricLists: + null xs = single ys || null ys + null ys = single xs || null xs +--} + +data SymmetricList a = SL !Int !Int ([a], [a]) + +-- | \(\mathcal{O}(n)\). Splits the elements evenly between the left and right lists +-- +-- > toList (balance sl) == toList sl +balance :: SymmetricList a -> SymmetricList a +balance (SL lenL lenR (xs, ys)) = (SL newLenL newLenR (us, Lst.reverse vs)) + where + totalLen = lenL + lenR + newLenL = (totalLen `div` 2) + newLenR = totalLen - newLenL + (us, vs) = Lst.splitAt newLenL (xs Lst.++ (Lst.reverse ys)) + +-- | \(\mathcal{O}(n)\), where n is the length of the first list. Reverses the first list onto the second. +-- +-- > revAppend xs ys == Prelude.reverse xs Prelude.++ ys +revAppend :: [a] -> [a] -> [a] +revAppend [] acc = acc +revAppend (z:zs) acc = revAppend zs (z:acc) + +-- | \(\mathcal{O}(\min(m, n))\), where m and n are the lengths of the symmetric lists. +-- Appends two symmetric lists, traversing only the shorter one. +-- +-- __Faster than lists:__ '(Prelude.++)' from "Prelude" is \(\mathcal{O}(m)\), since it traverses the whole first list. +-- +-- > toList (append (fromList xs) (fromList ys)) == xs Prelude.++ ys +append :: SymmetricList a -> SymmetricList a -> SymmetricList a +append l@(SL lenL lenR (xs, ys)) r@(SL lenL' lenR' (xs', ys')) + | len == 0 = r + | len' == 0 = l + | len == 1 && len' == 1 = SL 1 1 (xs Lst.++ ys, ys' Lst.++ xs') + | len == 1 = SL (1+lenL') lenR' (xs Lst.++ (ys Lst.++ xs'), ys') + | len' == 1 = SL lenL (lenR+1) (xs, (ys' Lst.++ xs') Lst.++ ys) + | len <= len' = SL (lenL + lenR + lenL') lenR' (xs Lst.++ (ys `revAppend` xs'), ys') + | otherwise = SL lenL (lenR' + lenL' + lenR) (xs, ys' Lst.++ (xs' `revAppend` ys)) + where + len = lenL + lenR + len' = lenL' + lenR' + +{-- Instances --} + +instance Show a => Show (SymmetricList a) where + -- show (SL _ _ l) = show l + show (SL _ _ (xs, ys)) = show (xs Lst.++ Lst.reverse ys) + -- show (SL len (xs, ys)) = ("<- ") ++ (show xs) ++ (" | ") ++ (show $ reverse ys) ++ (" ->") + +instance Eq a => Eq (SymmetricList a) where + (==) sl@(SL lenL lenR (xs, ys)) sl'@(SL lenL' lenR' (xs', ys')) + | lenL + lenR /= lenL' + lenR' = False + | lenL > lenL' = sl' == sl + | Just mid' <- Lst.stripPrefix xs xs' + , Just mid <- Lst.stripPrefix ys' ys = Lst.reverse mid == mid' + | otherwise = False + +instance Ord a => Ord (SymmetricList a) where + compare (SL _ _ (xs, ys)) (SL _ _ (xs', ys')) = go xs xs' + where + go (a:as) (b:bs) = compare a b <> go as bs + go as bs = compare (as Lst.++ Lst.reverse ys) (bs Lst.++ Lst.reverse ys') + +-- | '(<>)' is 'append'. +-- +-- > toList (fromList xs <> fromList ys) == xs Prelude.++ ys +instance Semigroup (SymmetricList a) where + (<>) = append + +instance Functor SymmetricList where + fmap f (SL lenL lenR (xs, ys)) = SL lenL lenR ([f x | x <- xs], [f y | y <- ys]) + +-- | Folds over the elements from front to back. +-- +-- 'length' is \(\mathcal{O}(1)\), since the lengths of both lists are stored. +-- +-- __Faster than lists:__ 'Prelude.length' from "Prelude" is \(\mathcal{O}(n)\). +-- +-- > length (fromList xs) == Prelude.length xs +instance Foldable SymmetricList where + foldr f i (SL _ _ (xs, ys)) = foldr f (foldr f i (Lst.reverse ys)) xs + length (SL lenL lenR _) = lenL + lenR + +instance NFData a => NFData (SymmetricList a) where + rnf (SL _ _ (l, r)) = rnf l `seq` rnf r diff --git a/symmetric-list.cabal b/symmetric-list.cabal new file mode 100644 --- /dev/null +++ b/symmetric-list.cabal @@ -0,0 +1,79 @@ +cabal-version: 3.0 +name: symmetric-list +version: 0.1.0.0 +synopsis: Lists with efficient access to both ends +description: + A symmetric list stores its elements split between a front list and a + reversed back list, giving amortized \(\mathcal{O}(1)\) access to both + ends of the sequence. + + Compared to ordinary Haskell lists, operations on the end of the list + (@snoc@, @last@, @init@, @unsnoc@), as well as @reverse@ and @length@, + run in constant (amortized) time, while keeping an interface close to + "Data.List". + + The main module is "Data.SymmetricList", designed to be imported + qualified: + + > import Data.SymmetricList (SymmetricList) + > import qualified Data.SymmetricList as SymmetricList + + "Data.SymmetricList.Internal" exposes the underlying representation and + makes no API stability guarantees. + +homepage: https://github.com/nahuel-merlo/symmetric-list-haskell +bug-reports: https://github.com/nahuel-merlo/symmetric-list-haskell/issues +license: BSD-3-Clause +license-file: LICENSE +author: nahuel-merlo +maintainer: n.peraza04@gmail.com +copyright: (c) 2026 nahuel-merlo +category: Data, Data Structures +build-type: Simple +tested-with: GHC == 9.10.3 + +extra-doc-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/nahuel-merlo/symmetric-list-haskell.git + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: Data.SymmetricList + Data.SymmetricList.Internal + build-depends: + base >= 4.19 && < 4.22, + deepseq >= 1.4 && < 1.6 + hs-source-dirs: src + default-language: Haskell2010 + +test-suite symmetric-list-test + import: warnings + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + build-depends: + base, + symmetric-list, + hspec >= 2.10 && < 2.12, + QuickCheck >= 2.14 && < 2.19 + +benchmark symmetric-list-bench + import: warnings + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: bench + main-is: Bench.hs + ghc-options: -rtsopts -with-rtsopts=-A32m + build-depends: + base, + symmetric-list, + tasty-bench >= 0.3 && < 0.6, + deepseq diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,321 @@ +module Main (main) where + +import Test.Hspec +import Test.QuickCheck +import Data.SymmetricList (SymmetricList) +import qualified Data.SymmetricList as SymmetricList +import qualified Data.List as L +import Control.Exception (evaluate) + +data Seed a = Cons a | Snoc a | Reverse | Uncons | Unsnoc | Tail | Init deriving (Show) + +instance Arbitrary a => Arbitrary (Seed a) where + arbitrary = frequency [(3, Cons <$> arbitrary), (3, Snoc <$> arbitrary), (2, pure Reverse), (1, pure Unsnoc), (1, pure Uncons), (1, pure Tail), (1, pure Init)] + +apply :: SymmetricList a -> Seed a -> SymmetricList a +apply s (Cons x) = SymmetricList.cons x s +apply s (Snoc x) = SymmetricList.snoc x s +apply s Reverse = SymmetricList.reverse s +apply s Unsnoc = maybe s fst (SymmetricList.unsnoc s) +apply s Uncons = maybe s snd (SymmetricList.uncons s) +apply s (Tail) + | null s = s + | otherwise = SymmetricList.tail s +apply s Init + | null s = s + | otherwise = SymmetricList.init s + +instance Arbitrary a => Arbitrary (SymmetricList a) where + arbitrary = foldl apply SymmetricList.nil <$> listOf arbitrary + shrink s = SymmetricList.fromList <$> shrink (SymmetricList.toList s) + +fromSeeds :: [Seed a] -> SymmetricList a +fromSeeds = foldl apply SymmetricList.nil + +prop_length_seed :: [Seed Int] -> Property +prop_length_seed seeds = + let s = fromSeeds seeds + in length s === length (SymmetricList.toList s) + +prop_fromList_toList :: [Int] -> Property +prop_fromList_toList xs = + True ==> SymmetricList.toList (SymmetricList.fromList xs) == xs + +prop_cons :: Int -> [Seed Int] -> Property +prop_cons x seeds = + True ==> SymmetricList.toList (SymmetricList.cons x s) == x:SymmetricList.toList s + where + s = fromSeeds seeds + +prop_snoc :: Int -> [Seed Int] -> Property +prop_snoc x seeds = + True ==> SymmetricList.toList (SymmetricList.snoc x s) == SymmetricList.toList s ++ [x] + where + s = fromSeeds seeds + +prop_head :: [Seed Int] -> Property +prop_head seeds = not (null xs) ==> SymmetricList.head s == L.head xs + where + s = fromSeeds seeds + xs = SymmetricList.toList s + +prop_last :: [Seed Int] -> Property +prop_last seeds = not (null xs) ==> SymmetricList.last s == L.last xs + where + s = fromSeeds seeds + xs = SymmetricList.toList s + +prop_tail :: [Seed Int] -> Property +prop_tail seeds = not (null xs) ==> SymmetricList.toList (SymmetricList.tail s) == L.tail xs + where + s = fromSeeds seeds + xs = SymmetricList.toList s + +prop_init :: [Seed Int] -> Property +prop_init seeds = not (null xs) ==> SymmetricList.toList (SymmetricList.init s) == L.init xs + where + s = fromSeeds seeds + xs = SymmetricList.toList s + +prop_init_length :: [Seed Int] -> Property +prop_init_length seeds = not (null s) ==> length (SymmetricList.init s) === length s - 1 + where + s = fromSeeds seeds + +prop_init_snoc :: Int -> [Seed Int] -> Property +prop_init_snoc x seeds = SymmetricList.init (SymmetricList.snoc x s) === s + where + s = fromSeeds seeds + +prop_null :: [Seed Int] -> Property +prop_null seeds = True ==> SymmetricList.null s == L.null (SymmetricList.toList s) + where + s = fromSeeds seeds + +prop_dropWhile :: Fun Int Bool -> [Seed Int] -> Property +prop_dropWhile f seeds = True ==> SymmetricList.toList (SymmetricList.dropWhile (applyFun f) s) == L.dropWhile (applyFun f) (SymmetricList.toList s) + where + s = fromSeeds seeds + +prop_reverse :: [Seed Int] -> Property +prop_reverse seeds = True ==> SymmetricList.toList (SymmetricList.reverse s) == L.reverse (SymmetricList.toList s) + where + s = fromSeeds seeds + +prop_length :: [Seed Int] -> Property +prop_length seeds = True ==> length (SymmetricList.fromList xs) == length xs + where + xs = SymmetricList.toList (fromSeeds seeds) + +prop_map :: Fun Int Int -> [Seed Int] -> Property +prop_map f seeds = True ==> SymmetricList.toList (SymmetricList.map (applyFun f) s) == map (applyFun f) (SymmetricList.toList s) + where + s = fromSeeds seeds + +prop_uncons :: [Seed Int] -> Property +prop_uncons seeds = not (null xs) ==> (y == x && SymmetricList.toList sl == ys) + where + s = fromSeeds seeds + xs = SymmetricList.toList s + Just (x, sl) = SymmetricList.uncons s + Just (y, ys) = L.uncons xs + +prop_append :: [Seed Int] -> [Seed Int] -> Property +prop_append seeds seeds' = True ==> SymmetricList.toList (SymmetricList.append s s') == SymmetricList.toList s L.++ SymmetricList.toList s' + where + s = fromSeeds seeds + s' = fromSeeds seeds' + +prop_semigroup :: [Seed Int] -> [Seed Int] -> Property +prop_semigroup seeds seeds' = True ==> s <> s' == SymmetricList.append s s' + where + s = fromSeeds seeds + s' = fromSeeds seeds' + +prop_semigroup_assoc :: [Seed Int] -> [Seed Int] -> [Seed Int] -> Property +prop_semigroup_assoc seeds seeds' seeds'' = True ==> (s <> s') <> s'' == s <> (s' <> s'') + where + s = fromSeeds seeds + s' = fromSeeds seeds' + s'' = fromSeeds seeds'' + +prop_unsnoc :: [Seed Int] -> Property +prop_unsnoc seeds = not (null xs) ==> (x == y && SymmetricList.toList sl == ys) + where + s = fromSeeds seeds + xs = SymmetricList.toList s + Just (sl, x) = SymmetricList.unsnoc s + Just (ys, y) = L.unsnoc xs + +prop_singleton :: Int -> Property +prop_singleton x = True ==> (SymmetricList.toList . SymmetricList.singleton) x == L.singleton x + +prop_eq :: [Seed Bool] -> [Seed Bool] -> Property +prop_eq seeds seeds' = (s == s') === (SymmetricList.toList s == SymmetricList.toList s') + where + s = fromSeeds seeds + s' = fromSeeds seeds' + +prop_eq_representation :: [Seed Int] -> Property +prop_eq_representation seeds = s === SymmetricList.fromList (SymmetricList.toList s) + where + s = fromSeeds seeds + +prop_compare :: [Seed Bool] -> [Seed Bool] -> Property +prop_compare seeds seeds' = compare s s' === compare (SymmetricList.toList s) (SymmetricList.toList s') + where + s = fromSeeds seeds + s' = fromSeeds seeds' + +main :: IO () +main = hspec $ do + describe "fromList" $ do + it "round-trips a list through toList" $ do + property prop_fromList_toList + + describe "cons" $ do + it "behaves like (:) on lists" $ do + property prop_cons + + describe "snoc" $ do + + it "behaves like (++ [x]) on lists" $ do + property prop_snoc + + describe "head" $ do + it "trhows an error when the list is empty" $ do + SymmetricList.head SymmetricList.nil `shouldThrow` anyErrorCall + + it "take out the element we just added from the top" $ do + SymmetricList.head (SymmetricList.cons 1 SymmetricList.nil) `shouldBe` L.head (1:[]) + + it "take out the element we just added from the bottom" $ do + SymmetricList.head (SymmetricList.snoc 1 SymmetricList.nil) `shouldBe` L.head (1:[]) + + it "behaves like head on lists" $ do + property prop_head + + describe "last" $ do + it "throws an error when the list is empty" $ do + SymmetricList.last SymmetricList.nil `shouldThrow` anyErrorCall + + it "give the last element we just added from the front" $ do + SymmetricList.last (SymmetricList.cons 1 SymmetricList.nil) `shouldBe` L.last (1:[]) + + it "give the last element we just added from the back" $ do + SymmetricList.last (SymmetricList.snoc 1 SymmetricList.nil) `shouldBe` L.last (1:[]) + + it "behaves like last on lists" $ do + property prop_last + + + describe "tail" $ do + it "throw error when the list is empty" $ do + evaluate (SymmetricList.tail SymmetricList.nil) `shouldThrow` anyErrorCall + + it "give nil when we just added from the front" $ do + SymmetricList.toList (SymmetricList.tail (SymmetricList.cons 1 SymmetricList.nil)) `shouldBe` [] + + it "give nil when we just added from the back" $ do + SymmetricList.toList (SymmetricList.tail (SymmetricList.snoc 1 SymmetricList.nil)) `shouldBe` [] + + it "give the tail of the list" $ do + property prop_tail + + describe "init" $ do + it "throws an error when the list is empty" $ do + evaluate (SymmetricList.init SymmetricList.nil) `shouldThrow` anyErrorCall + + it "give nil when we just added from the front" $ do + SymmetricList.toList (SymmetricList.init (SymmetricList.cons 1 SymmetricList.nil)) `shouldBe` [] + + it "give nil when we just added from the back" $ do + SymmetricList.toList (SymmetricList.init (SymmetricList.snoc 1 SymmetricList.nil)) `shouldBe` [] + + it "give nil on a singleton built with fromList" $ do + SymmetricList.toList (SymmetricList.init (SymmetricList.fromList [1])) `shouldBe` [] + + it "behaves like init on lists" $ do + property prop_init + + it "decreases the length by one" $ do + property prop_init_length + + it "undoes snoc" $ do + property prop_init_snoc + + describe "null" $ do + it "behaves like null on lists" $ do + property prop_null + + describe "dropWhile" $ do + it "give nil when the list is empty" $ do + ((SymmetricList.toList (SymmetricList.dropWhile (\x -> True) SymmetricList.nil)) :: [Int]) `shouldBe` ((L.dropWhile (\x -> True) []) :: [Int]) + + it "returns an empty list when the predicate matches every element" $ do + SymmetricList.toList (SymmetricList.dropWhile (\x -> True) $ SymmetricList.fromList [1 .. 3]) `shouldBe` L.dropWhile (\x -> True) [1 .. 3] + + it "returns the original list when the predicate matches no elements" $ do + SymmetricList.toList (SymmetricList.dropWhile (\x -> False) $ SymmetricList.fromList [1 .. 3]) `shouldBe` L.dropWhile (\x -> False) [1 .. 3] + + it "behaves like dropWhile on lists" $ do + property prop_dropWhile + + describe "reverse" $ do + it "behaves like reverse on lists" $ do + property prop_reverse + + describe "length" $ do + it "behaves like length on lists using fromList" $ do + property prop_length + + it "behaves like length on lists using Seed" $ do + property prop_length_seed + + describe "map" $ do + it "behaves like map on lists" $ do + property prop_map + + describe "uncons" $ do + it "behaves like uncons on lists" $ do + property prop_uncons + + it "give Nothing when the list is empty" $ do + SymmetricList.uncons (SymmetricList.fromList ([]:: [Int])) `shouldBe` Nothing + + describe "unsnoc" $ do + it "behaves like unsnoc on lists" $ do + property prop_unsnoc + + it "give Nothing when the list is empty" $ do + SymmetricList.unsnoc (SymmetricList.fromList ([]:: [Int])) `shouldBe` Nothing + + describe "append" $ do + it "behaves like (++) on lists" $ do + property prop_append + + describe "(<>)" $ do + it "behaves like append" $ do + property prop_semigroup + + it "is associative" $ do + property prop_semigroup_assoc + + + describe "singleton" $ do + it "behaves like singleton on lists" $ do + property prop_singleton + + describe "(==)" $ do + it "behaves like (==) on the represented lists" $ do + property prop_eq + + it "ignores the internal representation" $ do + property prop_eq_representation + + it "considers equal lists with the same elements split differently" $ do + SymmetricList.snoc 3 (SymmetricList.fromList [1, 2]) `shouldBe` SymmetricList.cons 1 (SymmetricList.fromList [2, 3 :: Int]) + + describe "compare" $ do + it "behaves like compare on the represented lists" $ do + property prop_compare