Showing posts from May 12, 2013

A little finesse...

It took a little bit to get this right:

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)

The gotcha is the n == 0 case; if you have it return [] the list comprehension gives the wrong result (i.e. an empty list!) with n == 1. (I didn't really need to make the m == n case go in descending order, but it looked nicer.)

Shouldn't take long to recast the palindrome program now; the idea, as alluded to earlier, is to represent half-Ys (aside from the easy-to-generate twoTwos) not by an Integer but by a list of the positions where we place 1s. Then backwards doesn't have to take the half-palindrome apart decimal digit by decimal digit, but can just reflect the positions and directly add up the corresponding powers of ten... but OTOH, do I really want to churn out a bunch of lists? For 50-digit Ys, t…

Going backwards

I figured I might try the same "loop unrolling" with backwards' as worked so well with digitsIn'. Admittedly I only did it once, but the results didn't go the right way:

COST CENTRE                MODULE  %time %alloc

numWithin                  Main     29.5    7.2
solve                      Main     21.0   35.3
backwards.backwards'       Main     16.6   17.5
backwards.backwards'.(...) Main      9.5   12.6
choices                    Main      5.2    8.9
digitsIn.digitsIn'         Main      5.2    4.9
nDigitYs                   Main      4.6    5.8
tenToThe                   Main      1.8    0.0
floorSqrt.floorSqrt'.y     Main      1.1    1.2
oddDigitsPals              Main      0.9    1.8
noTwos                     Main      0.7    1.3

As you can see by comparison with a previous profile, backwards is now taking up more time and allocation than before.

Guess we'll have to memoize...

backwardsMemo = [backwards' n 0 | n <- [0..]]
    where backwards…

"How low can you go?"

(Hey, with that title I can just keep my mouth shut and young people will think I'm quoting Ludacris, while old people will think I'm quoting Chubby Checker! Oops...)

So I decided to create a dummy version of the program that instead of calculating the number of "fair and square" numbers in a given range, just adds the low and high end of the range and prints it out, using the format the Code Jam problem requires:

numXs :: Integer -> Integer -> Integer

numXs a b = a + b

-- jagd's main, which I believe is set up to read stdin

solve i num = do
    [a, b] <- getLine >>= return . map read . words
    putStrLn $ "Case #" ++ show i ++ ": " ++ (show $ numXs a b)
    if i < num
       then solve (i+1) num
       else return ()

main = do
   num <- getLine >>=
   solve 1 num

Compiled it up with -O2 and ran...

time ./dummy < >woof.dummy

real    0m0.106s
user    0m0.092s
sys     0m0.012s

Here the variance …

Loop unrolling, Haskell style

We'd written digitsIn' to allow tail call optimization, so that the recursive call gets compiled as a loop:

digitsIn base n = digitsIn' n 1
    where digitsIn' n count
            | n < base  = count
            | otherwise = digitsIn' (n `div` base) (count + 1)

This does remind me of a blog post that Hacker News pointed at, in which another operation was being done in Haskell a digit at a time. The solution there, as here, is something kind of like loop unrolling:

digitsIn base n = digitsIn' n 1
    where base2 = base * base
          base4 = base2 * base2
          digitsIn' n count
            | n < base  = count
            | n > base4 = digitsIn' (n `div` base4) (count + 4)
            | n > base2 = digitsIn' (n `div` base2) (count + 2)
            | otherwise = digitsIn' (n `div` base)  (count + 1)

And the results:

real    0m0.679s
user    0m0.656s
sys     0m0.020s

From the profiler:

COST CENTRE                MODULE  %time %alloc

numWithin …

Guess we'll have to take the plunge

Just to check, I ran a version of the program with a revision of ysInRange, the function that actually does the range checking to do some of the alleged improvements mentioned earlier:

numWithin :: Integer -> Integer -> [Integer] -> Int

numWithin m n xs = length (takeWhile (<= n) $ dropWhile (< m) xs)

simpleYsInRange :: Integer -> Integer -> Int -> Int

simpleYsInRange m n digits = numWithin m n (ysByDigits !! (digits - 1))

-- Now for the real thing. As with the palindrome generation, the caller has
-- the number of digits of interest handy, so we take it as a parameter

ysInRange :: Integer -> Integer -> Int -> Int

ysInRange m n digits
    | digits < 8 = simpleYsInRange m n digits
    | mMSDs > 20 = 0
    | mMSDs > 11 = numWithin m n (twoTwos digits)
    | otherwise  = simpleYsInRange m n digits
    where mMSDs = m `div` tenToThe (digits - 2)

The results? Inconclusive; there's no clear difference. It's going to take a better data structure.


A tree? Maybe not...

So, how about that tree? It's tempting to do something like van Laarhoven describes, though I'd be tempted to put maxima on the left links, minima on the right links, to assist with the range check. But wait a minute. Now that we have added the purely combinatorial part, we never actually generate and selectively count more than one power of ten's worth of palindromes at a time, and at least some of those are of the trailing edge of an interval that covers a power of ten. Since the first d-digit Y is 1, for d == 1, or 10^(d-1) + 1, for d > 1, for them it's not like we have to skip a lot of Ys to find those of interest. That leaves the leading part, either [m..n] or [m..tenToThe mdigits - 1]. Just how many Ys are there for a given number of digits, anyway?

*Main> map numNDigitYs [1..50] [3,2,5,3,8,5,13,9,22,16,37,27,60,43,93,65,138,94,197,131,272,177,365,233,478,300,613,379,772,471,957,577,1170,698,1413,835,1688,989,1997,1161,2342,1352,2725,1563,3148,1795,3613,20…

Speaking of aging...

It's been some time since I've noticed my eyes don't accommodate as they used to--but if you take a look at this blog's layout and hit ctrl-0, that text is pretty darned small. Sorry about that; I've already changed the text color from what I think was the default for this style, #262626, to pure black, which helps, and bumped the text size a little bit. I'll tweak it some more; needing to hit  ctrl-+ a few times to read my own blog is pretty sad.

"I think that I shall never see..."

I'm rummaging around Stack Overflow and Hoogle. Data.Set and Data.Map are implemented underneath as balanced trees, but for my purposes I need the tree nature exposed so I can do something like

countInRange Empty m n = 0
countInRange (Node value (Tree lhs) (Tree rhs)) m n
    | value < m = countInRange rhs m n
    | value > n = countInRange lhs m n
    | otherwise = 1 + (countInRange lhs m n)
                    + (countInRange rhs m n)

The set fold doesn't guarantee ordering, so I don't see a way to let it quit early or otherwise skip portions that can't contribute to the count.

Maybe I will have to roll my own.

UPDATE:  Twar van Laarhoven's "Search trees without sorting" looks promising for my purpose. Dank U wel.

Holy [expletive]!

jejones@eeyore:~/src/haskell_play$ time ./ultimatepalindrome < >ultimate2.out

real    0m0.866s
user    0m0.852s
sys     0m0.012s

I want to try a thing or two more before posting the source, but that beats the heck out of 1.7 seconds, and is sneaking up on that 0.4 second time from one of the C/C++ solutions.

Things to take away from this:
Even with Google's explanations of problems, it's worth looking further. I would like to think that the Code Jam folks did this on purpose; it's a good pedagogical technique. (Pamela McCorduck's Machines Who Think quotes Minsky lamenting that in the book he and Papert wrote on perceptrons, they pretty well did all the interesting stuff, leaving nothing for others to follow up on.)In conversation about Mr. Reeder's blog post that started all this hoohah, a friend pointed out that whatever one does in some scripting or high-level language could be rewritten in C/assembly language/VLIW microcode and still be fa…

Looks promising...

A first cut at code that takes the aforementioned approach looks promising. Merging the purely combinatoric code with the code that generates palindromes gave rise to a name clash or two, I left out a couple of needed parentheses, Haskell didn't like my referring to some type by the name of Integber, I wrote [1..3] rather than [1,3] for the list of one digit Ys with no 2s, and I forgot that if m is a power of 10, digitsIn 10 m is one more than the common log of m. That corrected, a few lines from the big input give the same result as the previous version, and the new version was noticeably faster on some of them, which is what we were after. Now to compile and try the whole megillah. There are some things I should probably memoize, but get it right first, right?

By the way, ghci (Glasgow Haskell Compiler Interpreter?!), the interpreter, has a useful, um... OK. "Spell checker" isn't quite right, but if you make a typo, it will notice that it's close to something e…