Поскольку мне нравится использовать преимущества инфиксных операторов и функций более высокого порядка там, где это имеет смысл, я написал бы
infixr 5 @@
(@@) :: (Ord a) => [a] -> [a] -> [a]
-- if one side is empty, the merges can only possibly go one way
[] @@ ys = ys
xs @@ [] = xs
-- otherwise, take the smaller of the two heads out, and continue with the rest
(x:xs) @@ (y:ys) = case x `compare` y of
LT -> x : xs @@ (y:ys)
EQ -> x : xs @@ ys
GT -> y : (x:xs) @@ ys
-- a n-way merge can be implemented by a repeated 2-way merge
merge :: (Ord a) => [[a]] -> [a]
merge = foldr1 (@@)
Здесь xs @@ ys
объединяет два списка по их естественному порядку (и удаляет дубликаты), а merge [xs, ys, zs..]
объединяет любое количество списков.
Это приводит к очень естественному определению чисел Хэмминга :
hamming :: (Num a, Ord a) => [a]
hamming = 1 : map (2*) hamming @@ map (3*) hamming @@ map (5*) hamming
hamming = 1 : merge [map (n*) hamming | n <- [2, 3, 5]] -- alternative
-- this generates, in order, all numbers of the form 2^i * 3^j * 5^k
-- hamming = [1,2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,27,30,32,36,40,45,48,50,..]
Воровство Яирчу Не реализовано Идея :
{-# LANGUAGE ViewPatterns #-}
import qualified Data.Map as M
import Data.List (foldl', unfoldr)
import Data.Maybe (mapMaybe)
-- merge any number of ordered lists, dropping duplicate elements
merge :: (Ord a) => [[a]] -> [a]
-- create a map of {n: [tails of lists starting with n]}; then
-- repeatedly take the least n and re-insert the tails
merge = unfoldr ((=<<) step . M.minViewWithKey) . foldl' add M.empty where
add m (x:xs) = M.insertWith' (++) x [xs] m; add m _ = m
step ((x, xss), m) = Just (x, foldl' add m xss)
-- merge any number of ordered lists, preserving duplicate elements
mergeDup :: (Ord a) => [[a]] -> [a]
-- create a map of {(n, i): tail of list number i (which starts with n)}; then
-- repeatedly take the least n and re-insert the tail
-- the index i <- [0..] is used to prevent map from losing duplicates
mergeDup = unfoldr step . M.fromList . mapMaybe swap . zip [0..] where
swap (n, (x:xs)) = Just ((x, n), xs); swap _ = Nothing
step (M.minViewWithKey -> Just (((x, n), xs), m)) =
Just (x, case xs of y:ys -> M.insert (y, n) ys m; _ -> m)
step _ = Nothing
, где merge
, как и мой оригинал, удаляет дубликаты, а mergeDup
сохраняет их (например, Игорь ответ ).