Posts Tagged ‘numbers’

Programming Praxis – 3SUM

June 18, 2013

In today’s Programming Praxis exercise, our goal is to find all groups of three numbers in a given list that sum up to 0, and to do so in O(n2). Let’s get started, shall we?

import Data.List
import qualified Data.IntSet as I

The naive O(n3) version can be modified fairly easily to be more efficient. The first two loops can remain unchanged. In the final loop, we already know the number we’re looking for (the complement of the other two and all we need to know is whether it exists in the list. This can be done in O(1) using an IntSet. Unfortunately, this returns every triple thrice, so we sort the triples (O(1)) and remove the duplicates (I used the rather inefficient nub function here for the sake of brevity; in practive you’ll probably want to use a Set to reduce this part from O(k2) to O(k log k)).

sum3 :: [Int] -> [[Int]]
sum3 xs = nub [sort [a,b,-a-b] | (a:bs) <- tails xs, b <- bs, I.member (-a-b) s]
          where s = I.fromList xs

A test to see if everything is working properly:

main :: IO ()
main = print $ sum3 [8,-25,4,10,-10,-7,2,-3] == [[-10,2,8],[-7,-3,10]]

To check whether the function is indeed O(n2) I ran some timings by using list of consecutive numbers:

Input list
Time taken
1 to 8000 0.4s
1 to 16000 1.4s
1 to 32000 5.2s
1 to 64000 20.6s

As you can see, doubling the input size leads to a quadrupling of execution time, give or take a few tenths of a second, which means the algorithm is indeed O(n2).

Programming Praxis – 115132219018763992565095597973971522401

December 14, 2012

In today’s Programming Praxis exercise, our task is to calculate all the narcissistic numbers, also known als the Armstrong numbers or the pluperfect digital invariants, i.e. the sequence of numbers for which the sum of the cubes of the digits is equal to the number itself.

Supposedly, a mathematician by the name of Dik Winters developed an algorithm in 1985 that could generate all 88 numbers in about half an hour, which should theoretically run in seconds on modern day hardware. Unfortunately, neither Phil (the author of the Programming Praxis blog) nor I were able to find the original algorithm. The exercise provides a brute-force solution, which of course will not terminate in anything close to an acceptable time since the highest number in the sequence has 39 digits.

The solution I came up with in the end (after lots of different approaches to speed things up) is significantly faster than the naive brute-force solution, yet still nowhere close to the theoretical solution.

Some imports:

import Data.List
import qualified Data.Vector as V

Since calculating the full sequence takes too long, I added an argument to specify the maximum amount of desired digits for timing purposes.

narcissistic :: Integer -> [Integer]
narcissistic upto = narcs =<< [1..min 39 upto] \\ [2,12,13,15,18,22,26,28,30,36]

When generating the narcissistic numbers, we make a number of improvements to the brute-force algorithm:

  • Since the order of the digits doesn’t matter for the sum of cubes, we only look increasing series of digits, ruling out all permutations
  • Since the power function is relatively expensive, we precalculate all 10 possibilities into a lookup table
  • All digits sequences with a sum that is too low or high for an n-digit number are ignored
narcs :: Integer -> [Integer]
narcs n = sort $ f [] 0 9 n where
    powers = V.fromList $ map (^n) [0..9]
    pow i = powers V.! fromIntegral i
    (lo, hi) = (10^(n-1), 10^n)
    f ds s x 1 = [ s' | i <- [0..x], let s' = s + pow i, s' >= lo
                 , s' < hi, sort (show s') == (show =<< (i:ds))]
    f ds s x d = [0..x] >>= \i -> f (i:ds) (s + pow i) i (d-1)

With this approach, calculating the numbers of 1 through 16 digits takes about 3.4 seconds. 1 through 25 digits takes just over 4 minutes. I have no idea how long the full sequence would take. I’m sure there’s some way to eliminate more options using some mathematical proof, but I haven’t been able to find or come up with one.

main :: IO ()
main = mapM_ print $ narcissistic 16

Programming Praxis – Taxicab Numbers

November 9, 2012

In today’s Programming Praxis exercise, our goal is to prove that 1729 is the smallest number that can be written as the sum of two cubes. Let’s get started, shall we?

A quick import:

import Text.Printf

To find the pairs of cubes we use an incremental search algorithm that covers al of the unique combinations.

cubesums :: Integer -> [(Integer, Integer)]
cubesums n = f 0 (round $ fromIntegral n ** (1/3)) where
    f x y = if y < x then [] else case compare (x^3 + y^3) n of
                EQ -> (x,y) : f (x + 1) (y - 1)
                LT -> f (x + 1) y
                GT -> f x (y - 1)

Once we have a way of determining the cube sums, generating the taxi cab numbers is trivial. By using a pattern match to get the cube sums we don’t have to specify that there must be two solutions as a separate condition.

taxicab :: [(Integer, (Integer, Integer), (Integer, Integer))]
taxicab = [(n,p,q) | n <- [1..99999], [p,q] <- [cubesums n]]

And finally we pretty-print the result.

main :: IO ()
main = mapM_ (\(n,p,q) -> printf "%d : %s %s\n" n (show p) (show q)) taxicab

Programming Praxis – Pandigital Numbers

October 30, 2012

In today’s Programming Praxis exercise, our goal is to find all possible combinations in which two 3-digit sum up to a 4-digit number, with the condition that no digit is repeated in the three numbers. Let’s get started, shall we?

A quick import:

import Data.List

We’re going for the simple though somewhat inefficient approach of simply taking all possible combinations and filtering on the conditions we have. Checking for repeated digits is done by checking whether the string representation is equal to the string representation minus duplicate characters. Again, there are certainly quicker methods but since the whole program runs in 0.2 seconds anyway I personally prefer the short and easy to understand version.

pandigital :: [(Int, Int, Int)]
pandigital = [(a, b, a+b) | a <- d3, b <- d3, b > a, a+b > 999, unique [a, b, a+b]]
    where d3 = filter (unique . return) [100..999]
          unique = (\x -> x == nub x) . (show =<<)

Finding the smallest triplet of numbers is a separate task, but it’s a trivial one because our function returns all of them in ascending order, so we can simply take the first element.

main :: IO ()
main = do print $ head pandigital == (246,789,1035)
          print pandigital

Programming Praxis – McNugget Numbers, Revisited

April 13, 2012

In today’s Programming Praxis exercise, our goal is to calculate the number of ways a number can be expressed as a McNugget number. Let’s get started, shall we?

A quick import:

import Control.Monad.Identity

We use the same basic technique of building up a table of numbers where each number is the sum of the number above it and the number x spaces to its left, with x being the size of the McNugget box. We construct it differently though; rather than explicitly setting array values we use a bit of laziness to express the whole thing as a fold. The first row is a 1 followed by zeroes. For each subsequent row, we use the same principle as for the typical implementation of the Fibonacci algorithm, namely zipping a list with itself (using the fix function to avoid having to name it). The first x spaces of the previous row are maintained by adding zero to them.

mcNuggetCount :: Num a => [Int] -> Int -> a
mcNuggetCount xs n = foldl (\a x -> fix $ 
    zipWith (+) a . (replicate x 0 ++)) (1 : repeat 0) xs !! n

Some tests to see if everything works properly:

main :: IO ()
main = do print $ mcNuggetCount [6,9,20] 1000000 == 462964815
          print $ mcNuggetCount [1,5,10,25,50,100] 100 == 293
          print $ mcNuggetCount [1,2,5,10,20,50,100,200] 200 == 73682

Programming Praxis – McNugget Numbers

December 9, 2011

In today’s Programming Praxis exercise, our goal is to determine all the numbers that are not McNugget numbers, i.e. numbers that cannot be created by summing multiples of 6, 9 and 20. Let’s get started, shall we?

A quick import:

import Data.List

The code is pretty straightforward: just take all the numbers up to 180 that cannot be created by a linear combination of 6, 9 and 20.

notMcNuggets :: [Integer]
notMcNuggets = [1..180] \\
    [a+b+c | a <- [0,6..180], b <- [0,9..180-a], c <- [0,20..180-a-b]]

To test whether everything works correctly:

main :: IO ()
main = print notMcNuggets

Yup. Nice and simple.

Programming Praxis – Tetrahedral Numbers

September 13, 2011

In today’s Programming Praxis, our goal is to find the base of the three-sided pyramid that has 169179692512835000 spheres in it. Let’s get started, shall we?

A quick import:

import Data.List

The tetrahedral numbers are based on the triangular numbers, so let’s start with those.

triangular :: [Integer]
triangular = scanl1 (+) [1..]

The tetrahedral numbers are formed in much the same way as the triangular ones.

tetrahedral :: [Integer]
tetrahedral = scanl1 (+) triangular

All that’s left to do is to is to find the base of the pyramid.

main :: IO ()
main = print . maybe 0 succ $
       findIndex (== 169179692512835000) tetrahedral

Programming Praxis – Big Numbers: Input And Output

June 14, 2011

In today’s Programming Praxis exercise, our task is to write functions to convert Big Numbers to and from strings. Let’s get started, shall we?

To convert from a string, we simply convert each digit to the correct value, multiplying them by the base as we go along.

readBase :: (Num a, Enum a) => a -> String -> a
readBase b ('-':xs) = - readBase b xs
readBase b xs       = foldl (\a x -> b * a + val x) 0 xs where
    val d = maybe (error "unrecognized digit") id . lookup d $ zip
            (['0'..'9'] ++ ['A'..'Z'] ++ ['a'..'z']) [0..]

To convert to a string, we divide by the base until we reach zero. The remainders form the digits of the output.

showBase :: Integral a => a -> a -> String
showBase b n = if n < 0 then '-' : showBase b (abs n) else
               map (digit . snd) $ m : reverse ms  where
    ((_:ms), (m:_)) = span ((> 0) . fst) $ iterate (flip divMod b . fst) (n, 0)
    digit d = maybe undefined id . lookup d . zip [0..] $
              ['0'..'9'] ++ ['A'..'Z'] ++ ['a'..'z']

While we’re at it let’s also make BigNum an instance of Read and Show, the typeclasses that normally handle conversion to and from strings.

instance Read BigNum where
    readsPrec _ = return . first (readBase 10) . split where
        split ('-':xs) = first ('-':) $ split xs
        split xs       = span (`elem` ['0'..'9'] ++ ['A'..'Z'] ++ ['a'..'z']) xs

instance Show BigNum where
    show = showBase 10

Some tests to see if everything is working properly:

main :: IO ()
main = do print $ readBase 10 "1234"   == ( 1234 :: BigNum)
          print $ readBase 10 "-1234"  == (-1234 :: BigNum)
          print $ readBase  2 "101010" == (   42 :: BigNum)
          print $ read "-1234"         == (-1234 :: BigNum)
          print $ showBase 10 ( 1234 :: BigNum) ==   "1234"
          print $ showBase 10 (-1234 :: BigNum) ==  "-1234"
          print $ showBase  2 (   42 :: BigNum) == "101010"
          print $ show        (-1234 :: BigNum) ==  "-1234"

Programming Praxis – Big Numbers: Addition, Subtraction, And Multiplication

May 31, 2011

In today’s Programming Praxis exercise, we’re going to add addition, subtraction and multiplication to our big number library. Let’s get started, shall we?

Addition and multiplication are both functions of the Num typeclass, so we add the two functions (the fact that a – b is equal to a + (-b) is already present in the Num typeclass, so since we already defined negate we don’t need to define the subtraction function) in our Num instance:

instance Num BigNum where

For addition, we need to decide whether we’re adding or subtracting, which we do for each pair of digit groups. We could do this digit by digit, but I’m going to be lazy and do it per group. The conversion to and from Integers is not needed now, but will be required once the base is increased to prevent overflowing the Int type.

    a@(B l1 ds1) + b@(B l2 ds2) = B (length ds * signum l) ds where
        B l _ = if abs b > abs a then b else a
        ds = f 0 $ (if abs b > abs a then flip else id)
             (prep $ if signum l1 == -signum l2 then (-) else (+)) ds1 ds2
        prep op (x:xs) (y:ys) = op (toInteger x) (toInteger y) : prep op xs ys
        prep _  xs     ys     = map toInteger $ xs ++ ys
        f r (x:xs) = let (d,m) = divMod (r + x) base in fromIntegral m : f d xs
        f r []     = if r == 0 then [] else [fromIntegral r]

For multiplication we use the grade school method of multiplying each digit group (again, instead of per-digit) and summing them up at the end.

    (B l1 ds1) * (B l2 ds2) = B (signum l1 * signum l2 * sl) sds where
        B sl sds = sum $ mult ds1 ds2
        mult (x:xs) (y:ys) = fromIntegral (toInteger x * toInteger y) :
                             map shift (mult xs (y:ys)) ++
                             map shift (mult [x] ys)
        mult _     _  = []
        shift (B l ds) = B (l + 1) (0 : ds)

Some tests to see if everything is working properly:

main :: IO ()
main = do print $  12345678 +  987654321  == ( 999999999 :: BigNum)
          print $  12345678 -  987654321  == (-975308643 :: BigNum)
          print $ 987654321 -   12345678  == ( 975308643 :: BigNum)
          print $ -12345678 +  987654321  == ( 975308643 :: BigNum)
          print $ -12345678 -   87654321  == ( -99999999 :: BigNum)
          print $  12345678 *   87654321  == ( 1082152022374638 :: BigNum)
          print $  12345678 * (-87654321) == (-1082152022374638 :: BigNum)
          print $ -12345678 *   87654321  == (-1082152022374638 :: BigNum)
          print $ -12345678 * (-87654321) == ( 1082152022374638 :: BigNum)

Programming Praxis – Upside Up

May 27, 2011

In today’s Programming Praxis exercise, our task is to write a function to determine if a number remains the same if it is rotated 180 degrees. Let’s get started, shall we?

The function is pretty simple: reverse the number, and for each digit check if it the rotation of the corresponding digit in the original number. If a non-reversible digit is encountered, we can return false immediately. An optimization that could be made is to only check half of the number (rounding up), but in this case speed is not an issue so I opted for cleaner code.

upsideUp :: Show a => a -> Bool
upsideUp n = and . zipWith isRot (show n) . reverse $ show n where
    isRot a b = maybe False (== b) . lookup a $ zip "01689" "01986"

Two checks to see if everything is working properly:

main :: IO ()
main = do print $ head (filter upsideUp [1962..]) == 6009
          print $ length (filter upsideUp [0..9999]) == 39