Ugly Numbers
{
 Problem: Ugly Numbers ( http://uva.onlinejudge.org/external/1/136.html )

 Ugly numbers are numbers whose only prime factors are 2, 3 or 5.
 The sequence 1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15, ...
 shows the first 11 ugly numbers. By convention, 1 is included.

 Write a program to find and print the 1500'th ugly number.
}
ugly :: [Integer]
ugly = 1 : merge (map (2*) ugly) (map (3*) ugly) (map (5*) ugly)
where merge xxs@(x:xs) yys@(y:ys) zzs@(z:zs)
 x < y && x < z = x : merge xs yys zzs
 y < x && y < z = y : merge xxs ys zzs
 z < x && z < y = z : merge xxs yys zs
 x == y = merge xs yys zzs
 y == z = merge xxs ys zzs
 z == x = merge xxs yys zs
main = putStrLn $ "The 1500'th ugly number is " ++ show (ugly !! 1499) ++ "."
May 23rd, 2011 at 1:43 am
Slower, but almost a oneliner:
unfactor f n = let (q,r) = n `divMod` f in if r == 0 then unfactor f q else n
main = print . (!!1500) . map fst . filter ((==1) . snd) . map (id &&& (unfactor 2 . unfactor 3 . unfactor 5)) $ [1..]
I think the ugly part of your solution, though, is the threeway merge. If you have a twoway merge:
union :: (Ord a) => [a] > [a] > [a]
union [] ys = ys
union xs [] = xs
union xs’@(x:xs) ys’@(y:ys)
= case compare x y of
LT > x : union xs ys’
GT > y : union xs’ ys
EQ > x : union xs ys
Then:
multiUnion :: (Ord a) => [[a]] > [a]
multiUnion = foldl union id
Or even:
multiUnion :: (Ord a) => [[a]] > [a]
multiUnion [] = []
multiUnion [xs] = xs
multiUnion xss = multUnion (multiUnionPass xss)
where
multiUnionPass (xs1:xs2:xss) = union xs1 xs2 : multiUnionPass xss
multiUnionPass xss = xss
Then:
ugly = 1 : (map (2*) ugly `union` map (3*) ugly `union` map (5*) ugly)
or:
ugly = 1 : multiUnion [map (2*) ugly, map (3*) ugly, map (5*) ugly]
Or even:
ugly = 1 : multiUnion (map (\f > map (f*) ugly) [2,3,5])