[Haskell-cafe] Combine list of sorted lists
Quan Ta
quancta at gmail.com
Fri Dec 29 02:21:02 EST 2006
Hi all,
I have this function which combines (zip) list of sorted lists into a sorted
list (sorted by sum). The function works with infinite list and seems to
give correct result. But after I see the code for the Hamming sequence from
the Wiki, I wonder if it can be written better, or more clearly, or succint?
import Data.List
comb [] = []
comb (a:as) = foldl f2 (f1 a) as
where
f1 :: [Int] -> [[Int]]
f1 [] = []
f1 (a:as) = [a] : f1 as
f2 :: [[Int]] -> [Int] -> [[Int]]
f2 la [] = []
f2 [] lb = []
f2 la@(a:as) lb@(b:bs) = (a ++ [b]) : (f3 (f2 [a] bs) (f2 as lb))
f3 :: [[Int]] -> [[Int]] -> [[Int]]
f3 [] lb = lb
f3 la [] = la
f3 la lb = let a = head la
b = head lb
in if sum a <= sum b then
a : f3 (tail la) lb
else
b : f3 la (tail lb)
t1 = take 500 (comb [[1,2..],[1,23..],[1,5..],[1,9..]])
t2 = take 500 (sortBy (\x y -> compare (sum x) (sum y))
[[a,b,c,d] | a<-[1,2..80],b<-[1,23..80],
c<-[1,5..80],d<-[1,9..80]])
--t3 = take 500 (sortBy (\x y -> compare (sum x) (sum y))
-- [[a,b,c,d] | a<-[1,2..],b<-[1,23..],
-- c<-[1,5..],d<-[1,9..]])
main = print (show ((map sum t1) == (map sum t2)))
-- thanks for looking,
-- Quan
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20061229/4d4f7375/attachment-0001.htm
More information about the Haskell-Cafe
mailing list