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.
random notes and thoughts, mostly about Haskell these days, of a rather past middle-aged programmer
Subscribe to:
Post Comments (Atom)
Riddler Classic, May 23, 2020—Holy Mackerel!
Another one using Peter Norvig's word list . It turns out that the word "mackerel" has a curious property: there is exactly ...
-
Back in the Cretaceous era I worked at the University of Oklahoma as a student assistant at Remote 1. OU was a [shudder] IBM big iron shop a...
-
You've probably heard about how the notion of sum types (e.g. Algol 68 union s, Rust enum s, Haskell type s) and product types (e.g. tup...
-
Verbal Abuse as Entertainment When I grew up, my parents always told me that there was a sort of person who needed to tear down others t...
No comments:
Post a Comment