guibou/PersistantArray.cpp

## PersistantArray.cpp
#include <memory>
#include <array>
#include <boost/variant.hpp>
#include <iostream>

template<typename T, int N>
class PersistantArray
{
	class Internal;

	class Diff
	{
	public:
		T v;
		size_t idx;
		std::shared_ptr<Internal> parent;
	};

	class Internal
	{
	public:
		Internal()
		{
			data = std::unique_ptr<std::array<T, N>>(new std::array<T, N>);
		}

		explicit Internal(const Diff &d)
		{
			data = d;
		}

		boost::variant<Diff, std::unique_ptr<std::array<T, N>>> data;
		std::weak_ptr<Internal> ref;

		void reroot() const
		{
			boost::apply_visitor(visitor{ref.lock()}, data);
		}

		struct visitor : public boost::static_visitor<>
		{
			std::shared_ptr<Internal> current;
			explicit visitor(const std::shared_ptr<Internal> &c) : current(c)
			{}

			void operator()(const std::unique_ptr<std::array<T, N>> &) const
			{
			}

			void operator()(const Diff &d) const
			{
				d.parent->reroot();

				auto arr = std::move(boost::get<std::unique_ptr<std::array<T, N>>>(d.parent->data));

				T oldValue = arr->operator[](d.idx);
				arr->operator[](d.idx) = d.v;

				d.parent->data = Diff{oldValue, d.idx, current};

				current->data = std::move(arr);
			}
		};
	};
public:
	T operator[](const size_t idx) const
	{
		arr->reroot();

		return boost::get<std::unique_ptr<std::array<T, N>>>(arr->data)->operator[](idx);
	}

	PersistantArray set(const size_t idx, const T &value)
	{
		PersistantArray ret;

		auto newArr = std::shared_ptr<Internal>(new Internal(Diff{value, idx, arr->ref.lock()}));
		newArr->ref = newArr;

		ret.arr = newArr;

		return ret;
	}

	PersistantArray()
		:arr(new Internal())
	{
		arr->ref = arr;
	}

private:
	std::shared_ptr<Internal> arr;
};

template<typename T, int N>
void displayArray(const PersistantArray<T, N> &arr)
{
	std::cout << "[";
	for(size_t i = 0; i < N; i++)
	{
		std::cout << arr[i] << ", ";
	}
	std::cout << "]\n";
}


int main()
{
	const PersistantArray<int, 10> arr;

	displayArray(arr);

	auto p = arr;

	for(int i = 0; i < 10; i++)
	{
		std::cout << '\t';
		displayArray(p);
		p = p.set(i, i);
	}

	const auto p2 = p.set(3, 100);

	displayArray(p);
	displayArray(p2);
	displayArray(arr);
}

## PersistentArray.hs
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-full-laziness -fno-cse #-}
import Data.IORef
import qualified Data.Vector.Mutable as V
import qualified Data.Vector as IV
import System.IO.Unsafe (unsafePerformIO)
import Criterion.Main
import Data.Foldable
import Control.DeepSeq

-- Data struct

data Array t = Diff (ImmutableSharedArray t) Int t |
               Array (V.IOVector t)

data ImmutableSharedArray t = ImmutableSharedArray (IORef (Array t))


{-# NOINLINE initialize #-}
-- | Create the structure from an IO operation of mutable vector
initialize :: IO (V.IOVector t) -> ImmutableSharedArray t
initialize io = unsafePerformIO $ do
  v <- io
  ref <- newIORef (Array v)
  pure (ImmutableSharedArray ref)

{-# NOINLINE index #-}
-- | Read an offset inside the array
index :: ImmutableSharedArray t -> Int -> t
index arr i = unsafePerformIO $ do
  v <- reroot arr
  value <- V.read v i
  pure value

-- | Internal use only
reroot :: ImmutableSharedArray t -> IO (V.IOVector t)
reroot current@(ImmutableSharedArray ref) = do
  arr <- readIORef ref
  case arr of
    Array v -> pure v
    Diff (arr'@(ImmutableSharedArray ref')) idx v -> do
      vec <- reroot arr'

      oldValue <- V.read vec idx
      V.write vec idx v

      writeIORef ref' (Diff current idx oldValue)
      writeIORef ref (Array vec)

      pure vec

{-# NOINLINE size #-}
-- | Returns the size of the array
size :: ImmutableSharedArray t -> Int
size arr = unsafePerformIO $ do
  v <- reroot arr
  pure (V.length v)

{-# NOINLINE update #-}
-- | Returns a new array with one modified offset
update :: ImmutableSharedArray t -> Int -> t -> ImmutableSharedArray t
update vec idx value = unsafePerformIO $ do
  ref <- newIORef (Diff vec idx value)
  pure (ImmutableSharedArray ref)

-- | `Show` instance for display
instance Show t => Show (ImmutableSharedArray t) where
  show v = show (flip map [1 .. size v] $ \i -> index v (i - 1))

-- tests are rudimentary
test :: IO ()
test = do
  let vec = initialize (V.replicate 10 ' ')

  let
    vec' = update vec 0 'a'
    vec'' = update vec' 1 'b'
    vec''' = update vec'' 2 'c'
    vec'''' = update vec''' 3 'd'

  print vec
  print vec'
  print vec''
  print vec'''
  print vec''''
  print vec'''
  print vec''
  print vec'
  print vec

-- Benchmarking

-- The function we're benchmarking.
immutable_vector :: Int -> IV.Vector Int -> IV.Vector Int
immutable_vector l v = foldl' (\v idx -> v IV.// [(idx `mod` l, idx)]) v [0..100000]

immutable_hack :: Int -> ImmutableSharedArray Int -> ImmutableSharedArray Int
immutable_hack l v = foldl' (\v idx -> update v (idx `mod` l) idx) v [0..100000]

realIOVec :: Int -> IO ()
realIOVec l = do
  v <- V.replicate l 0
  mapM_ (\idx -> V.write v (idx `mod` l) idx) [0..100000]

instance NFData (ImmutableSharedArray t) where
  {-# NOINLINE rnf #-}
  rnf (ImmutableSharedArray ref) = unsafePerformIO $ do
    arr <- readIORef ref

    case arr of
      Diff a b c -> a `seq` b `seq` c `seq` pure ()
      Array a -> a `seq` pure ()


-- Our benchmark harness.
main :: IO ()
main = defaultMain [
  bgroup "10" [ bench "IV"  $ nf (immutable_vector 10) (IV.replicate 10 0)
               , bench "this"  $ nf (immutable_hack 10) (initialize (V.replicate 10 0))
               ]
  ,bgroup "100" [ bench "IV"  $ nf (immutable_vector 100) (IV.replicate 100 0)
               , bench "this"  $ nf (immutable_hack 100) (initialize (V.replicate 100 0))
               ]
  ,bgroup "1000" [ bench "IV"  $ nf (immutable_vector 1000) (IV.replicate 1000 0)
               , bench "this"  $ nf (immutable_hack 1000) (initialize (V.replicate 1000 0))
               ]
  ,bgroup "10000" [ bench "IV"  $ nf (immutable_vector 10000) (IV.replicate 10000 0)
               , bench "this"  $ nf (immutable_hack 10000) (initialize (V.replicate 10000 0))
               ]
  ,bgroup "100000" [
               -- bench "IV"  $ nf (immutable_vector 100000) (IV.replicate 100000 0)
               bench "this"  $ nf (immutable_hack 100000) (initialize (V.replicate 100000 0))
               , bench "realIOVec"  $ nfIO (realIOVec 100000)
               ]
  ]
-- The benchmarks are crappy, but the results are interesting
{-

-- For a small array, <= 100 the normal immutable is faster

benchmarking 10/IV
time                 4.136 ms   (4.014 ms .. 4.238 ms)
                     0.995 R²   (0.993 R² .. 0.998 R²)
mean                 4.586 ms   (4.326 ms .. 5.213 ms)
std dev              1.184 ms   (576.4 μs .. 2.238 ms)
variance introduced by outliers: 93% (severely inflated)

benchmarking 10/this
time                 29.42 ms   (28.97 ms .. 29.85 ms)
                     0.999 R²   (0.998 R² .. 1.000 R²)
mean                 29.84 ms   (29.42 ms .. 30.54 ms)
std dev              1.139 ms   (632.2 μs .. 1.803 ms)
variance introduced by outliers: 11% (moderately inflated)

benchmarking 100/IV
time                 12.40 ms   (12.28 ms .. 12.53 ms)
                     0.999 R²   (0.999 R² .. 1.000 R²)
mean                 12.47 ms   (12.41 ms .. 12.53 ms)
std dev              163.4 μs   (148.5 μs .. 177.8 μs)

benchmarking 100/this
time                 29.66 ms   (29.19 ms .. 30.28 ms)
                     0.999 R²   (0.997 R² .. 0.999 R²)
mean                 29.77 ms   (29.31 ms .. 30.42 ms)
std dev              1.172 ms   (713.7 μs .. 1.953 ms)
variance introduced by outliers: 11% (moderately inflated)

-- Starting from 100, the immutable increase roughly linearly with its size
-- but the hack does not increase, update are O(1)

benchmarking 1000/IV
time                 94.76 ms   (92.49 ms .. 96.67 ms)
                     0.999 R²   (0.996 R² .. 1.000 R²)
mean                 93.51 ms   (92.37 ms .. 94.62 ms)
std dev              1.864 ms   (1.244 ms .. 2.746 ms)

benchmarking 1000/this
time                 29.44 ms   (28.92 ms .. 29.96 ms)
                     0.999 R²   (0.998 R² .. 0.999 R²)
mean                 29.66 ms   (29.17 ms .. 30.40 ms)
std dev              1.293 ms   (794.0 μs .. 2.124 ms)
variance introduced by outliers: 11% (moderately inflated)

benchmarking 10000/IV
time                 1.615 s    (1.595 s .. 1.651 s)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 1.583 s    (1.570 s .. 1.592 s)
std dev              14.45 ms   (0.0 s .. 16.53 ms)
variance introduced by outliers: 19% (moderately inflated)

benchmarking 10000/this
time                 29.56 ms   (28.78 ms .. 30.30 ms)
                     0.998 R²   (0.997 R² .. 1.000 R²)
mean                 29.22 ms   (28.87 ms .. 29.85 ms)
std dev              937.2 μs   (542.9 μs .. 1.527 ms)
variance introduced by outliers: 11% (moderately inflated)

-- Compared to a real IO Vector, that's slower ;)

benchmarking 100000/this
time                 30.72 ms   (29.62 ms .. 31.79 ms)
                     0.997 R²   (0.995 R² .. 0.999 R²)
mean                 30.06 ms   (29.45 ms .. 30.52 ms)
std dev              1.091 ms   (736.0 μs .. 1.565 ms)
variance introduced by outliers: 11% (moderately inflated)

benchmarking 100000/realIOVec
time                 4.097 ms   (4.078 ms .. 4.125 ms)
                     1.000 R²   (0.999 R² .. 1.000 R²)
mean                 4.087 ms   (4.070 ms .. 4.102 ms)
std dev              50.06 μs   (37.16 μs .. 77.09 μs)
-}
	#include <memory>
	#include <array>
	#include <boost/variant.hpp>
	#include <iostream>

	template<typename T, int N>
	class PersistantArray
	{
	class Internal;

	class Diff
	{
	public:
	T v;
	size_t idx;
	std::shared_ptr<Internal> parent;
	};

	class Internal
	{
	public:
	Internal()
	{
	data = std::unique_ptr<std::array<T, N>>(new std::array<T, N>);
	}

	explicit Internal(const Diff &d)
	{
	data = d;
	}

	boost::variant<Diff, std::unique_ptr<std::array<T, N>>> data;
	std::weak_ptr<Internal> ref;

	void reroot() const
	{
	boost::apply_visitor(visitor{ref.lock()}, data);
	}

	struct visitor : public boost::static_visitor<>
	{
	std::shared_ptr<Internal> current;
	explicit visitor(const std::shared_ptr<Internal> &c) : current(c)
	{}

	void operator()(const std::unique_ptr<std::array<T, N>> &) const
	{
	}

	void operator()(const Diff &d) const
	{
	d.parent->reroot();

	auto arr = std::move(boost::get<std::unique_ptr<std::array<T, N>>>(d.parent->data));

	T oldValue = arr->operator[](d.idx);
	arr->operator[](d.idx) = d.v;

	d.parent->data = Diff{oldValue, d.idx, current};

	current->data = std::move(arr);
	}
	};
	};
	public:
	T operator[](const size_t idx) const
	{
	arr->reroot();

	return boost::get<std::unique_ptr<std::array<T, N>>>(arr->data)->operator[](idx);
	}

	PersistantArray set(const size_t idx, const T &value)
	{
	PersistantArray ret;

	auto newArr = std::shared_ptr<Internal>(new Internal(Diff{value, idx, arr->ref.lock()}));
	newArr->ref = newArr;

	ret.arr = newArr;

	return ret;
	}

	PersistantArray()
	:arr(new Internal())
	{
	arr->ref = arr;
	}

	private:
	std::shared_ptr<Internal> arr;
	};

	template<typename T, int N>
	void displayArray(const PersistantArray<T, N> &arr)
	{
	std::cout << "[";
	for(size_t i = 0; i < N; i++)
	{
	std::cout << arr[i] << ", ";
	}
	std::cout << "]\n";
	}


	int main()
	{
	const PersistantArray<int, 10> arr;

	displayArray(arr);

	auto p = arr;

	for(int i = 0; i < 10; i++)
	{
	std::cout << '\t';
	displayArray(p);
	p = p.set(i, i);
	}

	const auto p2 = p.set(3, 100);

	displayArray(p);
	displayArray(p2);
	displayArray(arr);
	}
	{-# LANGUAGE TypeApplications #-}
	{-# OPTIONS_GHC -fno-full-laziness -fno-cse #-}
	import Data.IORef
	import qualified Data.Vector.Mutable as V
	import qualified Data.Vector as IV
	import System.IO.Unsafe (unsafePerformIO)
	import Criterion.Main
	import Data.Foldable
	import Control.DeepSeq

	-- Data struct

	data Array t = Diff (ImmutableSharedArray t) Int t \|
	Array (V.IOVector t)

	data ImmutableSharedArray t = ImmutableSharedArray (IORef (Array t))


	{-# NOINLINE initialize #-}
	-- \| Create the structure from an IO operation of mutable vector
	initialize :: IO (V.IOVector t) -> ImmutableSharedArray t
	initialize io = unsafePerformIO $ do
	v <- io
	ref <- newIORef (Array v)
	pure (ImmutableSharedArray ref)

	{-# NOINLINE index #-}
	-- \| Read an offset inside the array
	index :: ImmutableSharedArray t -> Int -> t
	index arr i = unsafePerformIO $ do
	v <- reroot arr
	value <- V.read v i
	pure value

	-- \| Internal use only
	reroot :: ImmutableSharedArray t -> IO (V.IOVector t)
	reroot current@(ImmutableSharedArray ref) = do
	arr <- readIORef ref
	case arr of
	Array v -> pure v
	Diff (arr'@(ImmutableSharedArray ref')) idx v -> do
	vec <- reroot arr'

	oldValue <- V.read vec idx
	V.write vec idx v

	writeIORef ref' (Diff current idx oldValue)
	writeIORef ref (Array vec)

	pure vec

	{-# NOINLINE size #-}
	-- \| Returns the size of the array
	size :: ImmutableSharedArray t -> Int
	size arr = unsafePerformIO $ do
	v <- reroot arr
	pure (V.length v)

	{-# NOINLINE update #-}
	-- \| Returns a new array with one modified offset
	update :: ImmutableSharedArray t -> Int -> t -> ImmutableSharedArray t
	update vec idx value = unsafePerformIO $ do
	ref <- newIORef (Diff vec idx value)
	pure (ImmutableSharedArray ref)

	-- \| `Show` instance for display
	instance Show t => Show (ImmutableSharedArray t) where
	show v = show (flip map [1 .. size v] $ \i -> index v (i - 1))

	-- tests are rudimentary
	test :: IO ()
	test = do
	let vec = initialize (V.replicate 10 ' ')

	let
	vec' = update vec 0 'a'
	vec'' = update vec' 1 'b'
	vec''' = update vec'' 2 'c'
	vec'''' = update vec''' 3 'd'

	print vec
	print vec'
	print vec''
	print vec'''
	print vec''''
	print vec'''
	print vec''
	print vec'
	print vec

	-- Benchmarking

	-- The function we're benchmarking.
	immutable_vector :: Int -> IV.Vector Int -> IV.Vector Int
	immutable_vector l v = foldl' (\v idx -> v IV.// [(idx `mod` l, idx)]) v [0..100000]

	immutable_hack :: Int -> ImmutableSharedArray Int -> ImmutableSharedArray Int
	immutable_hack l v = foldl' (\v idx -> update v (idx `mod` l) idx) v [0..100000]

	realIOVec :: Int -> IO ()
	realIOVec l = do
	v <- V.replicate l 0
	mapM_ (\idx -> V.write v (idx `mod` l) idx) [0..100000]

	instance NFData (ImmutableSharedArray t) where
	{-# NOINLINE rnf #-}
	rnf (ImmutableSharedArray ref) = unsafePerformIO $ do
	arr <- readIORef ref

	case arr of
	Diff a b c -> a `seq` b `seq` c `seq` pure ()
	Array a -> a `seq` pure ()


	-- Our benchmark harness.
	main :: IO ()
	main = defaultMain [
	bgroup "10" [ bench "IV" $ nf (immutable_vector 10) (IV.replicate 10 0)
	, bench "this" $ nf (immutable_hack 10) (initialize (V.replicate 10 0))
	]
	,bgroup "100" [ bench "IV" $ nf (immutable_vector 100) (IV.replicate 100 0)
	, bench "this" $ nf (immutable_hack 100) (initialize (V.replicate 100 0))
	]
	,bgroup "1000" [ bench "IV" $ nf (immutable_vector 1000) (IV.replicate 1000 0)
	, bench "this" $ nf (immutable_hack 1000) (initialize (V.replicate 1000 0))
	]
	,bgroup "10000" [ bench "IV" $ nf (immutable_vector 10000) (IV.replicate 10000 0)
	, bench "this" $ nf (immutable_hack 10000) (initialize (V.replicate 10000 0))
	]
	,bgroup "100000" [
	-- bench "IV" $ nf (immutable_vector 100000) (IV.replicate 100000 0)
	bench "this" $ nf (immutable_hack 100000) (initialize (V.replicate 100000 0))
	, bench "realIOVec" $ nfIO (realIOVec 100000)
	]
	]
	-- The benchmarks are crappy, but the results are interesting
	{-

	-- For a small array, <= 100 the normal immutable is faster

	benchmarking 10/IV
	time 4.136 ms (4.014 ms .. 4.238 ms)
	0.995 R² (0.993 R² .. 0.998 R²)
	mean 4.586 ms (4.326 ms .. 5.213 ms)
	std dev 1.184 ms (576.4 μs .. 2.238 ms)
	variance introduced by outliers: 93% (severely inflated)

	benchmarking 10/this
	time 29.42 ms (28.97 ms .. 29.85 ms)
	0.999 R² (0.998 R² .. 1.000 R²)
	mean 29.84 ms (29.42 ms .. 30.54 ms)
	std dev 1.139 ms (632.2 μs .. 1.803 ms)
	variance introduced by outliers: 11% (moderately inflated)

	benchmarking 100/IV
	time 12.40 ms (12.28 ms .. 12.53 ms)
	0.999 R² (0.999 R² .. 1.000 R²)
	mean 12.47 ms (12.41 ms .. 12.53 ms)
	std dev 163.4 μs (148.5 μs .. 177.8 μs)

	benchmarking 100/this
	time 29.66 ms (29.19 ms .. 30.28 ms)
	0.999 R² (0.997 R² .. 0.999 R²)
	mean 29.77 ms (29.31 ms .. 30.42 ms)
	std dev 1.172 ms (713.7 μs .. 1.953 ms)
	variance introduced by outliers: 11% (moderately inflated)

	-- Starting from 100, the immutable increase roughly linearly with its size
	-- but the hack does not increase, update are O(1)

	benchmarking 1000/IV
	time 94.76 ms (92.49 ms .. 96.67 ms)
	0.999 R² (0.996 R² .. 1.000 R²)
	mean 93.51 ms (92.37 ms .. 94.62 ms)
	std dev 1.864 ms (1.244 ms .. 2.746 ms)

	benchmarking 1000/this
	time 29.44 ms (28.92 ms .. 29.96 ms)
	0.999 R² (0.998 R² .. 0.999 R²)
	mean 29.66 ms (29.17 ms .. 30.40 ms)
	std dev 1.293 ms (794.0 μs .. 2.124 ms)
	variance introduced by outliers: 11% (moderately inflated)

	benchmarking 10000/IV
	time 1.615 s (1.595 s .. 1.651 s)
	1.000 R² (1.000 R² .. 1.000 R²)
	mean 1.583 s (1.570 s .. 1.592 s)
	std dev 14.45 ms (0.0 s .. 16.53 ms)
	variance introduced by outliers: 19% (moderately inflated)

	benchmarking 10000/this
	time 29.56 ms (28.78 ms .. 30.30 ms)
	0.998 R² (0.997 R² .. 1.000 R²)
	mean 29.22 ms (28.87 ms .. 29.85 ms)
	std dev 937.2 μs (542.9 μs .. 1.527 ms)
	variance introduced by outliers: 11% (moderately inflated)

	-- Compared to a real IO Vector, that's slower ;)

	benchmarking 100000/this
	time 30.72 ms (29.62 ms .. 31.79 ms)
	0.997 R² (0.995 R² .. 0.999 R²)
	mean 30.06 ms (29.45 ms .. 30.52 ms)
	std dev 1.091 ms (736.0 μs .. 1.565 ms)
	variance introduced by outliers: 11% (moderately inflated)

	benchmarking 100000/realIOVec
	time 4.097 ms (4.078 ms .. 4.125 ms)
	1.000 R² (0.999 R² .. 1.000 R²)
	mean 4.087 ms (4.070 ms .. 4.102 ms)
	std dev 50.06 μs (37.16 μs .. 77.09 μs)
	-}