Great Leap Forward

So, we made the change. Note that we are in fact generating the lists for the combinations!

  Here's our new approach: rather than generate the upper half separately and
  then have to reverse it a digit at a time, we generate both halves at the
  same time, when we have information we need to do so.

  So, out with backwards and {odd,even}DigitsPal, and twoTwos goes back to its
  simple self.

twoTwos :: Int -> [Integer]

twoTwos n
    | n == 1    = []
    | even n    = [twoTwosNoOnes]
    | otherwise = [twoTwosNoOnes, twoTwosNoOnes + 10 ^ (n `div` 2)]               
    where twoTwosNoOnes = 2 * tenToThe (n - 1) + 2

oneTwos :: Int -> [Integer]

oneTwos n
    | n == 1     = [2]
    | even n     = []
    | otherwise  = [p + 2 * tenToThe halfN
                      | p <- justOnes n (min 1 (halfN - 1))]
    where halfN = n `div` 2

noTwos :: Int -> [Integer]

noTwos n
    | n == 1     = [1,3]
    | even n     = base
    | otherwise  = concat [[p, p + tenToThe halfN] | p <- base]
    where halfN = n `div` 2
          base = justOnes n (min 3 (halfN - 1)) 

choices :: Int -> Int-> [[Int]]

m `choices` n
    | n == 0           = [[]]
    | m == n           = [[m,m-1..1]]
    | otherwise        = [m : c | c <- (m - 1) `choices` (n - 1)]
                         ++ ((m - 1) `choices` n)

  justOnes -- here's where the real action happens. Here we generate palindromes
  with a specified number of digits all of whose non-zero digits are 1s. 1 must
  thus be the most/least significant digit; in addition, between 0 and a
  specified number of 1s are scattered through the rest of each half. If the
  number of digits requested is odd, we will leave a 0 in the middle digit,
  which the caller may or may not replace with another digit.


justOnes :: Int -> Int -> [Integer]

justOnes n o =
    let halfN = n `div` 2
        shell = tenToThe (n - 1) + 1
        innards = concat [(halfN - 1) `choices` k | k <- [0..o]]
        pair i = tenToThe i + tenToThe (n - (i + 1))
    in [shell + sum (map pair c) | c <- innards]

This gives a definite improvement. time output again varies a fair amount; the best we've seen so far is

real    0m0.509s
user    0m0.488s
sys     0m0.016s

and the worst is

real    0m0.581s
user    0m0.564s
sys     0m0.008s

I wish I knew the source of the variation; perhaps other processes running at the time? If we can believe the best result, we're down to 1.27 times the run time of the C++ solution we tested... and we haven't touched the real time sink. Check this out:

        total alloc = 345,155,656 bytes  (excludes profiling overheads)

COST CENTRE            MODULE  %time %alloc

numWithin              Main     44.7   11.3
solve                  Main     24.7   55.5
digitsIn.digitsIn'     Main      6.1    7.8
nDigitYs               Main      5.6    7.8
tenToThe               Main      5.3    0.0
justOnes               Main      3.0    6.4
justOnes.pair          Main      2.2    3.1
floorSqrt.floorSqrt'.y Main      2.1    1.9
noTwos                 Main      1.0    1.0
choices                Main      1.0    2.9

So we've cut down total allocation by over 200MB (not to be confused with the memory usage, which takes a final spike of about a quarter megabyte above the previous version). We could take a look at avoiding actually generating the list of chosen exponents for the half-Ys, but we have to face facts. numWithin is now eating nearly half the time, and if the above is to be believed, solve, of all things, is responsible for over half the allocation! (Maybe I don't understand just what the profiling output is trying to tell me.) We're within spitting distance of the C++ version; a move from O(n) to O(log n) for the range check ought to bring us ahead.

P.S. Note that I've deviated from the define-before-use ordering that I've stuck to in the past, and the results compiled without complaint. I infer from this that Haskell must be waiting until it's read the whole file to do at least some of the type checking, so I should be able to get away with putting definitions in top-down order.


Popular posts from this blog

a longest path problem

No tutorial, I swear...

Bikeshedding leap years