symmetric-list (empty) → 0.1.0.0
raw patch · 8 files changed
+1076/−0 lines, 8 filesdep +QuickCheckdep +basedep +deepseq
Dependencies added: QuickCheck, base, deepseq, hspec, symmetric-list, tasty-bench
Files
- CHANGELOG.md +5/−0
- LICENSE +29/−0
- README.md +252/−0
- bench/Bench.hs +70/−0
- src/Data/SymmetricList.hs +221/−0
- src/Data/SymmetricList/Internal.hs +99/−0
- symmetric-list.cabal +79/−0
- test/Main.hs +321/−0
+ CHANGELOG.md view
@@ -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.
+ LICENSE view
@@ -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.
+ README.md view
@@ -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.
+ bench/Bench.hs view
@@ -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'
+ src/Data/SymmetricList.hs view
@@ -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)
+ src/Data/SymmetricList/Internal.hs view
@@ -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
+ symmetric-list.cabal view
@@ -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
+ test/Main.hs view
@@ -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