bmaxa
Legenda
- Poruka
- 70.808
Elem ovo staje u post:
znaci
install neophodnih libova:
potom obicno kompajliranje:
I na kraju rezultat:
Znaci poredjenje random rasporeda, asc i desc sortirane liste.
Kod:
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 rndinstall neophodnih libova:
Kod:
cabal install criterion QuickCheck vector --lib --with-ghc ghc-8.4
Kod:
ghc-8.4 -O2 ms.hsZnaci poredjenje random rasporeda, asc i desc sortirane liste.
Kod:
~/.../examples/sort >>> ./ms
list size 65536
+++ OK, passed 100 tests.
benchmarking msdSort/random
time 146.5 ms (143.0 ms .. 148.0 ms)
1.000 R² (0.999 R² .. 1.000 R²)
mean 145.6 ms (143.0 ms .. 147.1 ms)
std dev 2.911 ms (675.8 μs .. 4.574 ms)
variance introduced by outliers: 12% (moderately inflated)
benchmarking msdSort/sorted
time 136.0 ms (134.3 ms .. 137.4 ms)
1.000 R² (1.000 R² .. 1.000 R²)
mean 137.3 ms (136.1 ms .. 138.5 ms)
std dev 1.849 ms (1.185 ms .. 2.610 ms)
variance introduced by outliers: 11% (moderately inflated)
benchmarking msdSort/reverse sorted
time 142.5 ms (141.0 ms .. 144.1 ms)
1.000 R² (1.000 R² .. 1.000 R²)
mean 141.2 ms (139.9 ms .. 142.4 ms)
std dev 1.900 ms (1.018 ms .. 3.026 ms)
variance introduced by outliers: 12% (moderately inflated)
benchmarking lsdSort/random
time 156.0 ms (154.7 ms .. 157.3 ms)
1.000 R² (1.000 R² .. 1.000 R²)
mean 155.1 ms (153.8 ms .. 155.8 ms)
std dev 1.363 ms (543.0 μs .. 2.046 ms)
variance introduced by outliers: 12% (moderately inflated)
benchmarking lsdSort/sorted
time 131.6 ms (130.1 ms .. 133.8 ms)
1.000 R² (1.000 R² .. 1.000 R²)
mean 130.8 ms (130.0 ms .. 131.7 ms)
std dev 1.244 ms (856.2 μs .. 1.674 ms)
variance introduced by outliers: 11% (moderately inflated)
benchmarking lsdSort/reverse sorted
time 130.8 ms (128.5 ms .. 134.7 ms)
0.999 R² (0.998 R² .. 1.000 R²)
mean 131.5 ms (130.4 ms .. 132.7 ms)
std dev 1.737 ms (1.213 ms .. 2.375 ms)
variance introduced by outliers: 11% (moderately inflated)
benchmarking qsort/random
time 25.02 ms (24.72 ms .. 25.34 ms)
0.999 R² (0.999 R² .. 1.000 R²)
mean 25.17 ms (24.95 ms .. 25.66 ms)
std dev 668.7 μs (306.4 μs .. 1.237 ms)
benchmarking qsort/sorted
time 20.00 ms (19.69 ms .. 20.62 ms)
0.996 R² (0.990 R² .. 1.000 R²)
mean 20.03 ms (19.85 ms .. 20.37 ms)
std dev 566.9 μs (351.1 μs .. 935.1 μs)
benchmarking qsort/reverse sorted
time 19.10 ms (18.89 ms .. 19.30 ms)
0.999 R² (0.999 R² .. 1.000 R²)
mean 19.10 ms (18.89 ms .. 19.28 ms)
std dev 454.3 μs (322.6 μs .. 681.0 μs)
benchmarking sort/random
time 64.33 ms (62.46 ms .. 65.50 ms)
0.999 R² (0.998 R² .. 1.000 R²)
mean 65.79 ms (64.58 ms .. 67.05 ms)
std dev 2.186 ms (1.436 ms .. 3.603 ms)
benchmarking sort/sorted
time 2.622 ms (2.573 ms .. 2.672 ms)
0.996 R² (0.994 R² .. 0.998 R²)
mean 2.911 ms (2.855 ms .. 2.972 ms)
std dev 192.5 μs (167.3 μs .. 225.1 μs)
variance introduced by outliers: 46% (moderately inflated)
benchmarking sort/reverse sorted
time 1.213 ms (1.197 ms .. 1.228 ms)
0.997 R² (0.993 R² .. 0.999 R²)
mean 1.206 ms (1.190 ms .. 1.224 ms)
std dev 58.99 μs (45.32 μs .. 88.95 μs)
variance introduced by outliers: 37% (moderately inflated)
benchmarking msort/random
time 79.50 ms (78.11 ms .. 80.99 ms)
1.000 R² (0.999 R² .. 1.000 R²)
mean 80.31 ms (78.92 ms .. 81.44 ms)
std dev 2.113 ms (1.224 ms .. 3.566 ms)
benchmarking msort/sorted
time 39.40 ms (39.09 ms .. 39.78 ms)
1.000 R² (0.999 R² .. 1.000 R²)
mean 39.11 ms (38.81 ms .. 39.30 ms)
std dev 495.3 μs (335.9 μs .. 741.7 μs)
benchmarking msort/reverse sorted
time 39.34 ms (39.06 ms .. 39.63 ms)
1.000 R² (1.000 R² .. 1.000 R²)
mean 39.77 ms (39.45 ms .. 40.99 ms)
std dev 1.105 ms (242.4 μs .. 2.110 ms)
benchmarking rsort/random
time 40.31 ms (37.81 ms .. 42.85 ms)
0.988 R² (0.971 R² .. 0.998 R²)
mean 39.29 ms (38.01 ms .. 40.52 ms)
std dev 2.566 ms (1.764 ms .. 3.853 ms)
variance introduced by outliers: 19% (moderately inflated)
benchmarking rsort/sorted
time 36.40 ms (35.82 ms .. 36.91 ms)
0.999 R² (0.998 R² .. 1.000 R²)
mean 36.32 ms (35.96 ms .. 37.06 ms)
std dev 978.9 μs (507.0 μs .. 1.639 ms)
benchmarking rsort/reverse sorted
time 37.66 ms (37.16 ms .. 38.31 ms)
0.999 R² (0.998 R² .. 1.000 R²)
mean 37.10 ms (36.50 ms .. 37.47 ms)
std dev 948.5 μs (640.7 μs .. 1.373 ms)
[0,1,1,1,2,3,5,5,5,6]
[/code
Zeleo sam da malo reklamiram Haskell ;)
Da pokazem kako je ekspresivan ;)
