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 one-liner:
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 three-way merge. If you have a two-way 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])