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) ++ "."

One Response to “Ugly Numbers”

  1. Pseudonym Says:

    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])

Leave a Reply