[Haskell-cafe] Bubble sort algorithm implementations (Haskell vs. C)
Yasir Arsanukaev
yarsanukaev at gmail.com
Sun Mar 21 01:39:08 EDT 2010
Hello. I have written 2 implementation of bubble sort algorithm in C
and Haskell. Haskell implementation:
module Main where
main = do
contents <- readFile "./data"
print "Data loaded. Sorting.."
let newcontents = bubblesort contents
writeFile "./data_new_ghc" newcontents
print "Sorting done"
bubblesort list = sort list [] False
rev = reverse -- separated. To see
rev2 = reverse -- who calls the routine
sort (x1:x2:xs) acc _
| x1 > x2 = sort (x1:xs) (x2:acc) True
sort (x1:xs) acc flag = sort xs (x1:acc) flag
sort [] acc True = sort (rev acc) [] False
sort _ acc _ = rev2 acc
I've compared these two implementations having run both on file with
size of 20 KiB.
C implementation took about a second, Haskell — about 1 min 10 sec.
I have also profiled the Haskell application:
Compile for profiling:
C:\Temp> ghc -prof -auto-all -O --make Main
Profile:
C:\Temp> Main.exe +RTS -p
and got these http://hpaste.org/fastcgi/hpaste.fcgi/view?id=24190#a24190
This is a pseudocode of the algorithm:
procedure bubbleSort( A : list of sortable items ) defined as:
do
swapped := false
for each i in 0 to length(A) - 2 inclusive do:
if A[i] > A[i+1] then
swap( A[i], A[i+1] )
swapped := true
end if
end for
while swapped
end procedure
The performance may suffer from the memory allocation for the list. I
wonder if it's possible to make Haskell implementation work faster
without changing the algorithm (there's are actually a few tricks to
make it work faster, but neither implementations have these
optimizations).
I'm interested not in particular algorithm performance but rather in
performance of its implementations in various languages. I compiled
the Haskell implementation in GHC (Haskell Platform 2009.2.0.2), which
is the latest available from the site.
More information about the Haskell-Cafe
mailing list