[Haskell-cafe] [BUG] Criterion is tied to x86 architecture
Branimir Maksimovic
branimir.maksimovic at gmail.com
Sat Sep 25 01:58:50 UTC 2021
Thanks, it works now:
bmaxa at Branimirs-Air sort % ghc -O2 ms.hs
Loaded package environment from /Users/bmaxa/.ghc/aarch64-darwin-8.10.7/environments/default
[1 of 1] Compiling Main ( ms.hs, ms.o )
ms.hs:23:44: warning: [-Wdeprecations]
In the use of ‘bitSize’ (imported from Data.Bits):
Deprecated: "Use 'bitSizeMaybe' or 'finiteBitSize' instead"
|
23 | positiveLsdSort list = foldl step list [0..bitSize (head list)] where
| ^^^^^^^
ms.hs:27:29: warning: [-Wdeprecations]
In the use of ‘bitSize’ (imported from Data.Bits):
Deprecated: "Use 'bitSizeMaybe' or 'finiteBitSize' instead"
|
27 | positiveMsdSort list = aux (bitSize (head list) - 1) list where
| ^^^^^^^
Linking ms ...
bmaxa at Branimirs-Air sort % ./ms
list size 65536
+++ OK, passed 100 tests.
benchmarking msdSort/random
time 109.4 ms (108.4 ms .. 110.6 ms)
1.000 R² (1.000 R² .. 1.000 R²)
mean 107.2 ms (106.2 ms .. 108.0 ms)
std dev 1.456 ms (966.8 μs .. 2.248 ms)
benchmarking msdSort/sorted
time 101.1 ms (100.4 ms .. 102.3 ms)
1.000 R² (1.000 R² .. 1.000 R²)
mean 100.9 ms (100.5 ms .. 101.2 ms)
std dev 550.8 μs (418.0 μs .. 801.1 μs)
benchmarking msdSort/reverse sorted
time 104.6 ms (103.8 ms .. 106.2 ms)
1.000 R² (0.999 R² .. 1.000 R²)
mean 103.6 ms (102.8 ms .. 104.2 ms)
std dev 1.134 ms (861.7 μs .. 1.447 ms)
benchmarking lsdSort/random
time 107.9 ms (106.9 ms .. 109.0 ms)
1.000 R² (1.000 R² .. 1.000 R²)
mean 107.6 ms (107.1 ms .. 108.1 ms)
std dev 765.3 μs (406.2 μs .. 983.7 μs)
benchmarking lsdSort/sorted
time 89.28 ms (88.80 ms .. 89.99 ms)
1.000 R² (1.000 R² .. 1.000 R²)
mean 88.48 ms (88.19 ms .. 88.79 ms)
std dev 513.3 μs (427.9 μs .. 624.1 μs)
benchmarking lsdSort/reverse sorted
time 89.04 ms (88.02 ms .. 89.83 ms)
1.000 R² (0.999 R² .. 1.000 R²)
mean 89.26 ms (88.85 ms .. 89.68 ms)
std dev 684.2 μs (536.5 μs .. 851.6 μs)
benchmarking qsort/random
time 18.90 ms (18.76 ms .. 19.02 ms)
1.000 R² (1.000 R² .. 1.000 R²)
mean 18.91 ms (18.83 ms .. 19.02 ms)
std dev 221.3 μs (168.4 μs .. 321.8 μs)
benchmarking qsort/sorted
time 13.27 ms (13.15 ms .. 13.41 ms)
0.999 R² (0.998 R² .. 1.000 R²)
mean 13.33 ms (13.23 ms .. 13.45 ms)
std dev 274.2 μs (218.5 μs .. 358.7 μs)
benchmarking qsort/reverse sorted
time 13.04 ms (12.95 ms .. 13.13 ms)
1.000 R² (0.999 R² .. 1.000 R²)
mean 13.00 ms (12.88 ms .. 13.08 ms)
std dev 274.5 μs (188.5 μs .. 439.5 μs)
benchmarking sort/random
time 46.24 ms (45.99 ms .. 46.49 ms)
1.000 R² (1.000 R² .. 1.000 R²)
mean 46.08 ms (45.76 ms .. 46.27 ms)
std dev 496.2 μs (263.1 μs .. 851.3 μs)
benchmarking sort/sorted
time 1.886 ms (1.862 ms .. 1.907 ms)
0.998 R² (0.997 R² .. 0.999 R²)
mean 2.073 ms (2.035 ms .. 2.115 ms)
std dev 139.7 μs (122.6 μs .. 167.1 μs)
variance introduced by outliers: 49% (moderately inflated)
benchmarking sort/reverse sorted
time 776.4 μs (771.2 μs .. 781.4 μs)
0.999 R² (0.999 R² .. 1.000 R²)
mean 805.7 μs (797.3 μs .. 817.1 μs)
std dev 33.20 μs (26.90 μs .. 40.92 μs)
variance introduced by outliers: 32% (moderately inflated)
benchmarking msort/random
time 59.61 ms (58.73 ms .. 60.14 ms)
1.000 R² (1.000 R² .. 1.000 R²)
mean 58.98 ms (58.16 ms .. 59.34 ms)
std dev 917.6 μs (386.7 μs .. 1.670 ms)
benchmarking msort/sorted
time 27.21 ms (27.01 ms .. 27.45 ms)
1.000 R² (1.000 R² .. 1.000 R²)
mean 27.11 ms (26.92 ms .. 27.24 ms)
std dev 325.1 μs (225.9 μs .. 491.0 μs)
benchmarking msort/reverse sorted
time 27.44 ms (27.35 ms .. 27.60 ms)
1.000 R² (1.000 R² .. 1.000 R²)
mean 27.36 ms (27.21 ms .. 27.42 ms)
std dev 200.6 μs (72.91 μs .. 378.0 μs)
benchmarking rsort/random
time 24.63 ms (24.36 ms .. 24.95 ms)
1.000 R² (0.999 R² .. 1.000 R²)
mean 24.90 ms (24.72 ms .. 25.33 ms)
std dev 542.9 μs (274.7 μs .. 912.1 μs)
benchmarking rsort/sorted
time 24.55 ms (24.32 ms .. 24.80 ms)
1.000 R² (0.999 R² .. 1.000 R²)
mean 24.54 ms (24.41 ms .. 24.82 ms)
std dev 408.0 μs (206.4 μs .. 727.4 μs)
benchmarking rsort/reverse sorted
time 24.67 ms (24.44 ms .. 24.97 ms)
1.000 R² (0.999 R² .. 1.000 R²)
mean 24.38 ms (24.27 ms .. 24.52 ms)
std dev 278.1 μs (197.5 μs .. 388.4 μs)
[2,3,5,6,6,8,8,9,10,11]
bmaxa at Branimirs-Air sort % cat ms.hs
import Data.List
import qualified Test.QuickCheck as QC
import System.Random
import Criterion.Main
import Data.Bits
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector as V
import Data.Word
import System.IO.Unsafe
import Data.Bits
lsdSort :: (Ord a, Bits a, Num a) => [a] -> [a]
lsdSort = fixSort positiveLsdSort
msdSort :: (Ord a, Bits a, Num a) => [a] -> [a]
msdSort = fixSort positiveMsdSort
-- Fix a sort that puts negative numbers at the end, like positiveLsdSort and positiveMsdSort
fixSort :: (Bits a, Ord a, Num a)=>([a]->[a]) -> [a] -> [a]
fixSort sorter list = uncurry (flip (++)) (break (< 0) (sorter list))
positiveLsdSort :: (Bits a) => [a] -> [a]
positiveLsdSort list = foldl step list [0..bitSize (head list)] where
step list bit = uncurry (++) (partition (not . flip testBit bit) list)
positiveMsdSort :: (Bits a) => [a] -> [a]
positiveMsdSort list = aux (bitSize (head list) - 1) list where
aux _ [] = []
aux (-1) list = list
aux bit list = aux (bit - 1) lower ++ aux (bit - 1) upper where
(lower, upper) = partition (not . flip testBit bit) list
msort :: Ord a =>[a] -> [a]
msort xs
| n < 2 = xs
| otherwise = merge (msort x1s) (msort x2s)
where
n = length xs
(x1s,x2s) = splitAt (n`quot`2) xs
merge xs ys = case (xs,ys) of
([], ys') -> ys'
(xs', []) -> xs'
(x:xs',y:ys') | x < y -> x : merge xs' ys
| otherwise -> y : merge xs ys'
isort :: Ord a => [a] -> [a]
isort xs = foldr insert [] xs
where
insert x [] = [x]
insert x (y:ys) = if x<y then x:y:ys
else y: insert x ys
qsort :: Ord a => [a] -> [a]
qsort [] = []
qsort [x] = [x]
qsort xs =
let
pivot = mot
(x1s,x2s,pivots) = foldl (\(ys,zs,pivots) x->
if x<pivot
then (x:ys,zs,pivots)
else if x>pivot
then (ys,x:zs,pivots)
else (ys,zs,x:pivots)) ([],[],[]) xs
in qsort x1s ++ pivots ++ qsort x2s
where
mot =
let n = length xs
(a,b,c) = (xs !! 0, (xs !! (n`quot`2)), xs !! (n-1))
in if a>b
then if a<c
then a
else if c>b
then c
else b
else if b<c
then b
else if c>a
then c
else a
rsort :: [Word32] -> [Word32]
rsort xs = unsafePerformIO $ do
let base = 16
add_bucket :: Int -> Word32 -> VM.IOVector [Word32] -> VM.IOVector [Word32]
add_bucket i n b = unsafePerformIO $ do
lst <- VM.read b i
VM.write b i (n:lst)
return b
clear b = mapM_ (\i-> VM.write b i []) [0..base-1]
bucket <- VM.replicate base [] :: IO (VM.IOVector [Word32])
let loop = return $ foldl body xs [0..7]
where
body :: [Word32] -> Word32 -> [Word32]
body nums n = unsafePerformIO $ do
v <- V.freeze (foldl disp bucket nums)
clear bucket
return $ V.foldr gather [] v
where
disp :: VM.IOVector [Word32]->Word32->VM.IOVector [Word32]
disp b val = add_bucket (fromIntegral ((val`shiftR`fromIntegral (n`shiftL`fromIntegral 2)).&.0xf)) val b
gather :: [Word32]->[Word32] -> [Word32]
gather b nums = foldl (\xs x->x:xs) nums b
loop
prop_msort :: [Word32]->Bool
prop_msort xs = msort xs == sort xs && sort xs == isort xs && sort xs == qsort xs && sort xs == rsort xs &&
lsdSort xs == sort xs && msdSort xs == sort xs
deepCheck p = QC.quickCheckWith (QC.stdArgs { QC.maxSize = 1000}) p
n :: Word32
n = 4096 * 16
tl :: [Word32]->[Word32]
tl = take (fromIntegral n)
main = do
putStrLn $ "list size " ++ show n
deepCheck prop_msort
g <- getStdGen
let rl = randomRs (0,n) g
let (s,rs) = ([(0::Word32)..],[(n-1::Word32),n-2..])
let rnd = tl rl
srt = tl s
rsrt = tl rs
defaultMain [
bgroup "msdSort" [
bench "random" $ nf msdSort rnd,
bench "sorted" $ nf msdSort srt,
bench "reverse sorted" $ nf msdSort rsrt
],
bgroup "lsdSort" [
bench "random" $ nf lsdSort rnd,
bench "sorted" $ nf lsdSort srt,
bench "reverse sorted" $ nf lsdSort rsrt
],
bgroup "qsort" [
bench "random" $ nf qsort rnd,
bench "sorted" $ nf qsort srt,
bench "reverse sorted" $ nf qsort rsrt
],
bgroup "sort" [
bench "random" $ nf sort rnd,
bench "sorted" $ nf sort srt,
bench "reverse sorted" $ nf sort rsrt
],
bgroup "msort" [
bench "random" $ nf msort rnd,
bench "sorted" $ nf msort srt,
bench "reverse sorted" $ nf msort rsrt
],{-
bgroup "isort" [
bench "random" $ nf isort rnd,
bench "sorted" $ nf isort srt,
bench "reverse sorted" $ nf isort rsrt
],-}
bgroup "rsort" [
bench "random" $ nf rsort rnd,
bench "sorted" $ nf rsort srt,
bench "reverse sorted" $ nf rsort rsrt
]
]
print $ take 10 $ rsort rnd
Greetings, Branimir.
> On 18.09.2021., at 11:55, Jaro Reinders <jaro.reinders at gmail.com> wrote:
>
> This issue: https://github.com/haskell/criterion/issues/238, makes it seem like this should be fixed with criterion-measurement-0.1.3.0. If that doesn't work then I suggest placing a comment or opening a new issue there.
>
> Cheers,
>
> Jaro
>
> On 18-09-2021 11:24, Branimir Maksimovic wrote:
>> Problem as I work on Apple M1 processor, can’t compile
>> Criterion as it use x86 specific features.
>> Greetings, Branimir.
>> _______________________________________________
>> Haskell-Cafe mailing list
>> To (un)subscribe, modify options or view archives go to:
>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>> Only members subscribed via the mailman list are allowed to post.
> _______________________________________________
> Haskell-Cafe mailing list
> To (un)subscribe, modify options or view archives go to:
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> Only members subscribed via the mailman list are allowed to post.
More information about the Haskell-Cafe
mailing list