O(n) good, O(log n) better

What we need is a list/array of b, b2, b4, b8, b16, ... to count base b digits. The initial loop unrolling should have given us the idea already.

powersOfTwo = map (2^) [0..]
bigTwos = map (2^) powersOfTwo
bigTens = map (10^) powersOfTwo

bitsIn n   = bDigits n bigTwos
digitsIn n = bDigits n bigTens

bDigits :: Integer -> [Integer] -> Int

bDigits n xs = bDigits' n 1
    where bDigits' n s = let upToN = takeWhile (<= n) xs
                         in case upToN of
                            [] -> s
                            _  -> bDigits' (n `div` (last upToN))
                                           (s + powersOfTwo !! (length upToN - 1))

Whew! OK, so does it help? Best observed time output:

real    0m0.227s
user    0m0.208s
sys     0m0.016s

Worst observed time output:

real    0m0.238s
user    0m0.212s
sys     0m0.024s

Profiling output claims 0.20 seconds runtime (still; the difference is a few "ticks" that aren't noticeable in the calculated time). It's a little better, but we are definitely in the realm of diminishing returns. Let's check out the cost centers:

COST CENTRE            MODULE                %time %alloc

nDigitYs               Main                   17.3   20.4
fromList.(...)         SemilatticeSearchTree  15.7   21.6
justOnes               Main                   10.7   12.9
process                Main                    5.1    8.9
bDigits.bDigits'       Main                    5.1    2.1
fromList               SemilatticeSearchTree   4.6    0.5
justOnes.pair          Main                    4.1    0.0
floorSqrt.floorSqrt'.y Main                    4.1    4.5
choices                Main                    3.6    6.8
bDigits.bDigits'.upToN Main                    3.6    2.8
meet                   SemilatticeSearchTree   3.0    0.0
choose                 Main                    2.5    2.3
yTree                  Main                    2.5    3.3
findFirst              SemilatticeSearchTree   2.5    0.0
justOnes.innards       Main                    2.0    1.2
mkBranch               SemilatticeSearchTree   2.0    2.5
main.r                 Main                    1.5    0.3
noTwos                 Main                    1.5    2.3
main                   Main                    1.0    0.6
numYs                  Main                    1.0    0.1
floorSqrt              Main                    1.0    0.7
satisfy                SemilatticeSearchTree   1.0    0.0
satisfy                SemilatticeSearchTree   1.0    0.6
meet                   SemilatticeSearchTree   0.0    2.8

Before, we had digitsIn and digitsIn.digitsIn', which collectively consumed 12.5% of the time and 9.3% of allocation. Now we have bDigits.bDigits' and bDigits.bDigits'.upToN, which just eat 8.7% of time and 4.9% of allocation (though speaking of allocation, of course we now have those three new lists sitting around).

UPDATE: It bugged me that I was grabbing a whole prefix of a list when I really only wanted the last item of that prefix (along with something like its length), so I added yet another helper function, resulting in

bDigits n xs = bDigits' n 1
    where bDigits' n s = case lastLE n xs of
                           Nothing     -> s
                           Just (m, p) -> bDigits' (n `div` m) (s + twoToThe p)

lastLE :: Integer -> [Integer] -> Maybe (Integer, Int)

lastLE n xs =
    let lastLE' xs prevVal prevIndex
           | head xs <= n = lastLE' (tail xs) (head xs) (prevIndex + 1)
           | otherwise    = if prevIndex < 0 then Nothing
                                             else Just (prevVal, prevIndex)
    in lastLE' xs (-1) (-1)

where twoToThe is just like tenToThe, using powersOfTwo instead of powersOfTen.

That helped; with the change, the cost center listing shows bDigits, bDigits.bDigits', and lastLE.lastLE' collectively chowing down on just 3.3% of total time and 2.1% of allocation, which beats the heck out of 8.7 and 4.9. The -hc heap graph shows the peak at around 6.5 MB rather than the 8 it sailed up to when we went to the semilattice trees.


Popular posts from this blog

a longest path problem

No tutorial, I swear...

Bikeshedding leap years