d433811c64
@kha I created a variant of the `rbmap` example where we create a tree but also save "checkpoints". The idea is to simulate the idiom frequently used in a backtracking search where we "save" the "context" before each case split in a "trail stack". The benchmark has two parameters: the number of nodes to be inserted, and a "frequency" (how often we create a "checkpoint"). The command `rbmap_checkpoint.lean.out n n` behaves like the original `rbmap` benchmark, and `rbmap_checkpoint.lean.out n 1` creates a checkpoint after each insertion. The frequency provides a simple way to control the amount of sharing. We can provide performance numbers for different frequencies, and show the impact on the `reset/reuse` optimization. BTW, the performance numbers are much better than I expected. For example, `./rbmap_checkpoint.lean.out 1000000 10` is only 30% slower than `./rbmap_checkpoint.lean.out 1000000 1000000` although 100k checkpoints were created. Another good news is that we are faster than Haskell even for `./rbmap_checkpoint.lean.out 1000000 1`
72 lines
2.7 KiB
Haskell
72 lines
2.7 KiB
Haskell
import System.Environment
|
||
|
||
data Color =
|
||
Red | Black
|
||
|
||
data Tree α β =
|
||
Leaf
|
||
| Node Color (Tree α β) α β (Tree α β)
|
||
|
||
fold :: (α -> β -> σ -> σ) -> Tree α β -> σ -> σ
|
||
fold _ Leaf b = b
|
||
fold f (Node _ l k v r) b = fold f r (f k v (fold f l b))
|
||
|
||
balance1 :: Tree α β -> Tree α β -> Tree α β
|
||
balance1 (Node _ _ kv vv t) (Node _ (Node Red l kx vx r₁) ky vy r₂) = Node Red (Node Black l kx vx r₁) ky vy (Node Black r₂ kv vv t)
|
||
balance1 (Node _ _ kv vv t) (Node _ l₁ ky vy (Node Red l₂ kx vx r)) = Node Red (Node Black l₁ ky vy l₂) kx vx (Node Black r kv vv t)
|
||
balance1 (Node _ _ kv vv t) (Node _ l ky vy r) = Node Black (Node Red l ky vy r) kv vv t
|
||
balance1 _ _ = Leaf
|
||
|
||
balance2 :: Tree α β -> Tree α β -> Tree α β
|
||
balance2 (Node _ t kv vv _) (Node _ (Node Red l kx₁ vx₁ r₁) ky vy r₂) = Node Red (Node Black t kv vv l) kx₁ vx₁ (Node Black r₁ ky vy r₂)
|
||
balance2 (Node _ t kv vv _) (Node _ l₁ ky vy (Node Red l₂ kx₂ vx₂ r₂)) = Node Red (Node Black t kv vv l₁) ky vy (Node Black l₂ kx₂ vx₂ r₂)
|
||
balance2 (Node _ t kv vv _) (Node _ l ky vy r) = Node Black t kv vv (Node Red l ky vy r)
|
||
balance2 _ _ = Leaf
|
||
|
||
is_red :: Tree α β -> Bool
|
||
is_red (Node Red _ _ _ _) = True
|
||
is_red _ = False
|
||
|
||
lt x y = x < y
|
||
|
||
ins :: Ord α => Tree α β -> α -> β -> Tree α β
|
||
ins Leaf kx vx = Node Red Leaf kx vx Leaf
|
||
ins (Node Red a ky vy b) kx vx =
|
||
(if lt kx ky then Node Red (ins a kx vx) ky vy b
|
||
else if lt ky kx then Node Red a ky vy (ins b kx vx)
|
||
else Node Red a ky vy (ins b kx vx))
|
||
ins (Node Black a ky vy b) kx vx =
|
||
if lt kx ky then
|
||
(if is_red a then balance1 (Node Black Leaf ky vy b) (ins a kx vx)
|
||
else Node Black (ins a kx vx) ky vy b)
|
||
else if lt ky kx then
|
||
(if is_red b then balance2 (Node Black a ky vy Leaf) (ins b kx vx)
|
||
else Node Black a ky vy (ins b kx vx))
|
||
else Node Black a kx vx b
|
||
|
||
set_black :: Tree α β -> Tree α β
|
||
set_black (Node _ l k v r) = Node Black l k v r
|
||
set_black e = e
|
||
|
||
insert t k v =
|
||
if is_red t then set_black (ins t k v)
|
||
else ins t k v
|
||
|
||
type Map = Tree Int Bool
|
||
|
||
mk_Map_aux :: Int -> Int -> Map -> [Map] -> [Map]
|
||
mk_Map_aux freq 0 m r = m:r
|
||
mk_Map_aux freq n m r =
|
||
let n' = n-1 in
|
||
let m' = (insert m n' (n' `mod` 10 == 0)) in
|
||
let r' = if (n' `mod` freq == 0) then (m':r) else r in
|
||
mk_Map_aux freq n' m' r'
|
||
|
||
mk_Map n freq = mk_Map_aux freq n Leaf []
|
||
|
||
main = do
|
||
[n, freq] <- getArgs
|
||
let mList = mk_Map (read n) (read freq)
|
||
(m:_) <- return mList
|
||
let v = fold (\_ v r -> if v then r + 1 else r) m 0
|
||
print v
|