Last active
December 10, 2015 23:28
-
-
Save cnd/4509874 to your computer and use it in GitHub Desktop.
Gentoo Haskell F#
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| >>time ./hs 15 ~/tests/ :) | |
| stretch tree of depth 16 check: -1 | |
| 65536 trees of depth 4 check: -65536 | |
| 16384 trees of depth 6 check: -16384 | |
| 4096 trees of depth 8 check: -4096 | |
| 1024 trees of depth 10 check: -1024 | |
| 256 trees of depth 12 check: -256 | |
| 64 trees of depth 14 check: -64 | |
| long lived tree of depth 15 check: -1 | |
| ./hs 15 1.08s user 0.72s system 99% cpu 1.803 total | |
| >>time ./fs.exe 15 ~/tests/ :) | |
| stretch tree of depth 16 check: -1 | |
| 65536 trees of depth 4 check: -65536 | |
| 16384 trees of depth 6 check: -16384 | |
| 4096 trees of depth 8 check: -4096 | |
| 1024 trees of depth 10 check: -1024 | |
| 256 trees of depth 12 check: -256 | |
| 64 trees of depth 14 check: -64 | |
| long lived tree of depth 15 check: -1 | |
| mono ./fs.exe 15 0.69s user 0.33s system 151% cpu 0.673 total | |
| mono 3.0.3 ; F# git ; GHC 7.6.1 with -threaded |
Author
cnd
commented
Jan 11, 2013
open System
open Unchecked
type Next = { Left: Tree; Right: Tree }
and [<Struct>] Tree(next:Next,item:int) =
member t.Check() =
match box next with
| null -> item
| _ -> item + next.Left.Check() - next.Right.Check()
let rec make item depth =
if depth > 0 then Tree({Left = make (2*item-1) (depth-1); Right=make (2*item) (depth-1)}, item)
else Tree(defaultof<_>,item)
let inline check (tree:Tree) = tree.Check()
let rec loopDepths maxDepth minDepth d =
if d <= maxDepth then
let niter = 1 <<< (maxDepth - d + minDepth)
let mutable c = 0
for i = 1 to niter do
c <- c + check (make i d) + check (make (-i) d)
Console.WriteLine("{0}\t trees of depth {1}\t check: {2}",2 * niter,d,c)
loopDepths maxDepth minDepth (d + 2)
[<EntryPoint>]
let main args =
let minDepth = 4
let maxDepth =
let n = if args.Length > 0 then int args.[0] else 10
max (minDepth + 2) n
let stretchDepth = maxDepth + 1
let c = check (make 0 stretchDepth)
Console.WriteLine("stretch tree of depth {0}\t check: {1}",stretchDepth,c)
let longLivedTree = make 0 maxDepth
loopDepths maxDepth minDepth minDepth
Console.WriteLine("long lived tree of depth {0}\t check: {1}",maxDepth,(check longLivedTree))
exit 0
>>time ./fs.exe 20
stretch tree of depth 21 check: -1
2097152 trees of depth 4 check: -2097152
524288 trees of depth 6 check: -524288
131072 trees of depth 8 check: -131072
32768 trees of depth 10 check: -32768
8192 trees of depth 12 check: -8192
2048 trees of depth 14 check: -2048
512 trees of depth 16 check: -512
128 trees of depth 18 check: -128
32 trees of depth 20 check: -32
long lived tree of depth 20 check: -1
mono ./fs.exe 20 35.63s user 2.08s system 145% cpu 25.917 total
>>time ./hs 20
stretch tree of depth 21 check: -1
Stack space overflow: current size 8388608 bytes.
Use `+RTS -Ksize -RTS' to increase it.
./hs 20 4.10s user 1.53s system 99% cpu 5.638 total:(
>>time python py.py 15 ~/tests/ :)
stretch tree of depth 16 check: -1
65536 trees of depth 4 check: -65536
16384 trees of depth 6 check: -16384
4096 trees of depth 8 check: -4096
1024 trees of depth 10 check: -1024
256 trees of depth 12 check: -256
64 trees of depth 14 check: -64
long lived tree of depth 15 check: -1
python py.py 15 10.99s user 0.16s system 357% cpu 3.121 totalfrom __future__ import print_function
import sys
import multiprocessing as mp
def make_tree(i, d):
if d > 0:
i2 = i + i
d -= 1
return (i, make_tree(i2 - 1, d), make_tree(i2, d))
return (i, None, None)
def check_tree(node):
(i, l, r) = node
if l is None:
return i
else:
return i + check_tree(l) - check_tree(r)
def make_check(itde, make=make_tree, check=check_tree):
i, d = itde
return check(make(i, d))
def get_argchunks(i, d, chunksize=5000):
assert chunksize % 2 == 0
chunk = []
for k in range(1, i + 1):
chunk.extend([(k, d), (-k, d)])
if len(chunk) == chunksize:
yield chunk
chunk = []
if len(chunk) > 0:
yield chunk
def main(n, min_depth=4):
max_depth = max(min_depth + 2, n)
stretch_depth = max_depth + 1
if mp.cpu_count() > 1:
pool = mp.Pool()
chunkmap = pool.map
else:
chunkmap = map
print('stretch tree of depth {0}\t check: {1}'.format(
stretch_depth, make_check((0, stretch_depth))))
long_lived_tree = make_tree(0, max_depth)
mmd = max_depth + min_depth
for d in range(min_depth, stretch_depth, 2):
i = 2 ** (mmd - d)
cs = 0
for argchunk in get_argchunks(i,d):
cs += sum(chunkmap(make_check, argchunk))
print('{0}\t trees of depth {1}\t check: {2}'.format(i * 2, d, cs))
print('long lived tree of depth {0}\t check: {1}'.format(
max_depth, check_tree(long_lived_tree)))
if __name__ == '__main__':
main(int(sys.argv[1]))
>>time ./hs 15 +RTS -N ~/tests/ :)
stretch tree of depth 16 check: -1
65536 trees of depth 4 check: -65536
16384 trees of depth 6 check: -16384
4096 trees of depth 8 check: -4096
1024 trees of depth 10 check: -1024
256 trees of depth 12 check: -256
64 trees of depth 14 check: -64
long lived tree of depth 15 check: -1
./hs 15 +RTS -N 2.03s user 1.38s system 282% cpu 1.207 total
>>time mono --llvm fs.exe 15 ~/tests/ :)
stretch tree of depth 16 check: -1
65536 trees of depth 4 check: -65536
16384 trees of depth 6 check: -16384
4096 trees of depth 8 check: -4096
1024 trees of depth 10 check: -1024
256 trees of depth 12 check: -256
64 trees of depth 14 check: -64
long lived tree of depth 15 check: -1
mono --llvm fs.exe 15 0.66s user 0.34s system 149% cpu 0.668 totalHaskell code change:
--
-- The Computer Language Benchmarks Game
-- http://shootout.alioth.debian.org/
--
-- Contributed by Don Stewart
-- Parallelized by Louis Wasserman
import System.Environment
import Control.Monad
import System.Mem
import Data.Bits
import Text.Printf
import GHC.Conc
--
-- an artificially strict tree.
--
-- normally you would ensure the branches are lazy, but this benchmark
-- requires strict allocation.
--
data Tree = Nil | Node !Int !Tree !Tree
minN = 4
io s n t = printf "%s of depth %d\t check: %d\n" s n t
main = do
n <- getArgs >>= readIO . head
let maxN = max (minN + 2) n
stretchN = maxN + 1
-- stretch memory tree
let c = {-# SCC "stretch" #-} check (make 0 stretchN)
io "stretch tree" stretchN c
-- allocate a long lived tree
let !long = make 0 maxN
-- allocate, walk, and deallocate many bottom-up binary trees
let vs = depth minN maxN
mapM_ (\((m,d,i)) -> io (show m ++ "\t trees") d i) vs
-- confirm the the long-lived binary tree still exists
io "long lived tree" maxN (check long)
-- generate many trees
depth :: Int -> Int -> [(Int,Int,Int)]
depth d m
| d <= m = let
s = sumT d n 0
rest = depth (d+2) m
in s `seq` ((2*n,d,s) : rest)
| otherwise = []
where n = bit (m - d + minN)
-- allocate and check lots of trees
sumT :: Int -> Int -> Int -> Int
sumT d 0 t = t
sumT d i t = a `par` b `seq` sumT d (i-1) ans
--sumT d i t = a `par` b `par` sumT d (i-1) ans
where a = check (make i d)
>>time ./hs 15 +RTS -N ~/tests/ :)
stretch tree of depth 16 check: -1
65536 trees of depth 4 check: -65536
16384 trees of depth 6 check: -16384
4096 trees of depth 8 check: -4096
1024 trees of depth 10 check: -1024
256 trees of depth 12 check: -256
64 trees of depth 14 check: -64
long lived tree of depth 15 check: -1
./hs 15 +RTS -N 2.13s user 0.99s system 367% cpu 0.849 total
>>time mono --llvm fs.exe 15 ~/tests/ :)
stretch tree of depth 16 check: -1
65536 trees of depth 4 check: -65536
16384 trees of depth 6 check: -16384
4096 trees of depth 8 check: -4096
1024 trees of depth 10 check: -1024
256 trees of depth 12 check: -256
64 trees of depth 14 check: -64
long lived tree of depth 15 check: -1
mono --llvm fs.exe 15 0.74s user 0.28s system 149% cpu 0.683 totalhaskell code change:
--
-- The Computer Language Benchmarks Game
-- http://shootout.alioth.debian.org/
--
-- Contributed by Don Stewart
-- Parallelized by Louis Wasserman
import System.Environment
import Control.Monad
import System.Mem
import Data.Bits
import Text.Printf
import GHC.Conc
--
-- an artificially strict tree.
--
-- normally you would ensure the branches are lazy, but this benchmark
-- requires strict allocation.
--
data Tree = Nil | Node !Int !Tree !Tree
minN = 4
io s n t = printf "%s of depth %d\t check: %d\n" s n t
main = do
n <- getArgs >>= readIO . head
let maxN = max (minN + 2) n
stretchN = maxN + 1
-- stretch memory tree
let c = {-# SCC "stretch" #-} check (make 0 stretchN)
io "stretch tree" stretchN c
-- allocate a long lived tree
let !long = make 0 maxN
-- allocate, walk, and deallocate many bottom-up binary trees
let vs = depth minN maxN
mapM_ (\((m,d,i)) -> io (show m ++ "\t trees") d i) vs
-- confirm the the long-lived binary tree still exists
io "long lived tree" maxN (check long)
-- generate many trees
depth :: Int -> Int -> [(Int,Int,Int)]
depth d m
| d <= m = let
s = sumT d n 0
rest = depth (d+2) m
in s `par` rest `seq` ((2*n,d,s) : rest)
| otherwise = []
where n = bit (m - d + minN)
-- allocate and check lots of trees
sumT :: Int -> Int -> Int -> Int
sumT d 0 t = t
sumT d i t = a `par` b `seq` sumT d (i-1) ans
--sumT d i t = a `par` b `par` sumT d (i-1) ans
where a = check (make i d)
b = check (make (-i) d)
ans = a + b + t
check = check' True 0
-- traverse the tree, counting up the nodes
check' :: Bool -> Int -> Tree -> Int
check' !b !z Nil = z
check' b z (Node i l r) = check' (not b) (check' b (if b then z+i else z-i) l) r
-- build a tree
make :: Int -> Int -> Tree
make i 0 = Node i Nil Nil
make i d = Node i (make (i2-1) d2) (make i2 d2)
where i2 = 2*i; d2 = d-1
>>time ./hs 17 +RTS -N ~/tests/ :(
stretch tree of depth 18 check: -1
262144 trees of depth 4 check: -262144
65536 trees of depth 6 check: -65536
16384 trees of depth 8 check: -16384
4096 trees of depth 10 check: -4096
1024 trees of depth 12 check: -1024
256 trees of depth 14 check: -256
64 trees of depth 16 check: -64
long lived tree of depth 17 check: -1
./hs 17 +RTS -N 10.37s user 4.39s system 385% cpu 3.825 total
>>time mono --llvm fs.exe 17 ~/tests/ :)
stretch tree of depth 18 check: -1
262144 trees of depth 4 check: -262144
65536 trees of depth 6 check: -65536
16384 trees of depth 8 check: -16384
4096 trees of depth 10 check: -4096
1024 trees of depth 12 check: -1024
256 trees of depth 14 check: -256
64 trees of depth 16 check: -64
long lived tree of depth 17 check: -1
mono --llvm fs.exe 17 3.12s user 0.65s system 145% cpu 2.597 total
>>time mono --llvm fs.exe 18 ~/tests/ :)
stretch tree of depth 19 check: -1
524288 trees of depth 4 check: -524288
131072 trees of depth 6 check: -131072
32768 trees of depth 8 check: -32768
8192 trees of depth 10 check: -8192
2048 trees of depth 12 check: -2048
512 trees of depth 14 check: -512
128 trees of depth 16 check: -128
32 trees of depth 18 check: -32
long lived tree of depth 18 check: -1
mono --llvm fs.exe 18 7.21s user 0.93s system 142% cpu 5.714 total
>>time ./hs 18 +RTS -N4 ~/tests/ :)
stretch tree of depth 19 check: -1
524288 trees of depth 4 check: -524288
131072 trees of depth 6 check: -131072
32768 trees of depth 8 check: -32768
8192 trees of depth 10 check: -8192
2048 trees of depth 12 check: -2048
512 trees of depth 14 check: -512
128 trees of depth 16 check: -128
32 trees of depth 18 check: -32
long lived tree of depth 18 check: -1
./hs 18 +RTS -N4 26.23s user 10.98s system 392% cpu 9.487 total
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment