{-
  Here's my current attempt at the ultimate "Fair and Square" program.
  (See https://code.google.com/codejam/contest/2270488/dashboard#s=p2;
  the core of the problem is: given two positive integers, M and N, how many
  base 10 palindromes between M and N are squares of base 10 palindromes?)

  Best time output for the L2 input file, on a 2.8 GHz AMD Athlon II X4 630:

  real    0m0.228s
  user    0m0.196s
  sys     0m0.028s

  The main insights to speed up the process follow.
  (4)-(5) are directly from the Google Code Jam analysis of the problem at
  https://code.google.com/codejam/contest/2270488/dashboard#s=a&a=2
  (8) is from Twan van Laarhoven's "Search trees without sorting" at
  http://twanvl.nl/blog/haskell/SemilatticeSearchTree

 1. Look for palindromes in [ceil(sqrt(M))..floor(sqrt(N))] whose squares are
    palindromes. (Following Google's analysis, we'll refer to such numbers as
    Ys, and their squares as Xs.)
 2. Don't look for palindromes, generate them. ceil(n/2) digits determine an
    n-digit palindrome, reducing the work by a factor similar to (1).
 3. The most/least significant digit of a Y can't be greater than 3.
 4. Ys are precisely those palindromes that, when you square them via long
    multiplication, have no carries in the addition of partial products.
 5. (4) implies that the middle digit of X, which is the sum of the squares
    of the digits of the palindrome being squared, must be less than 10.
    Hence *none* of the digits of a Y can be greater than 3, and 3 can only
    appear in Y = 3.
 6. By (5), Ys can be categorized as having either zero, one, or two 2s.
 7. Counting d-digit Ys is faster than generating them; only generate when
    you have to. (The problem only asks "how many".)
 8. By treating a binary tree as a sublattice, labeling branches with the upper
    bounds of the corresponding subtrees, one can quickly search for the first
    value in the tree >= a specified value.
 9. Given such trees of d-digit Ys with their ordinal positions, two searches
    suffice to determine how many d-digit Ys are in a given range.
-}

import Prelude
import Data.List
import SemilatticeSearchTree
import qualified Data.ByteString.Char8 as B

-- It's easy to calculate the number of n-digit Ys.

numNDigitYs :: Int -> Int

numNDigitYs 1 = 3
numNDigitYs n = numTwoTwos n + numOneTwos n + numNoTwos n
    where numTwoTwos n = if even n then 1 else 2
          numOneTwos n = if even n then 0 else n `div` 2
          numNoTwos  n = if even n then s else 2 * s
                         where h = n `div` 2 - 1
                               s = sum [h `choose` i | i <- [0..min h 3]]

choose :: Int -> Int -> Int

m `choose` 0 = 1
m `choose` n = product [m - n + 1..m] `div` product [1..n]

-- With partial sums from 0 to n, one subtract gives the sum from m to n

nDigitYsSums         = scanl (+) 0 (map numNDigitYs [1..])
ysInDigitRange d1 d2 = nDigitYsSums !! d2 - nDigitYsSums !! (d1 - 1)

-- Now the slow part: actually generating and sorting the Ys

powersOfTen = map (10 ^) [0..]

tenToThe :: Int -> Integer

tenToThe n = powersOfTen !! n

nDigitYs :: Int -> [Integer]

nDigitYs 1 = [1,2,3]
nDigitYs n = sort (oneTwos n ++ noTwos n ++ twoTwos n)
    where twoTwos n
              | even n    = [twoShell]
              | otherwise = [twoShell, twoShell + tenToThe halfN]
              where twoShell = 2 * shell
          oneTwos n
              | even n    = []
              | otherwise = map (+ (shell + 2 * tenToThe halfN))
                                (0 : map pair [1..halfN - 1])
          noTwos n
              | even n    = base
              | otherwise = concat [[p, p + tenToThe halfN] | p <- base]
              where base  = map pairSum (noTwosChoices !! (halfN - 1))
          halfN      = n `div` 2
          shell      = pair 0
          memoPair   = zipWith (+) powersOfTen
                                   (take halfN (reverse (take n powersOfTen)))
          pair i     = memoPair !! i -- tenToThe i + tenToThe (n - (i + 1))
          pairSum xs = foldl' (+) shell (map pair xs)

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)

-- Think of i as n `div` 2 - 1
noTwosChoices = [concat [i `choices` k | k <- [0..min 3 i]] | i <- [0..]]

-- We tag nDigitYs results with their ordinal position, and create
-- semilattice search trees from the resulting pairs.
-- Sigh... this is a bit of cargo cult programming; we follow the blog
-- example even though we only search for palindromes.

yTree :: Int -> SearchTree (Max Integer, Max Int)

yTree n = fromList [(Max x, Max y) | (x, y) <- zip (nDigitYs n) [0..]]

yTrees  = map yTree [1..]

dDigitYTree :: Int -> SearchTree (Max Integer, Max Int)

dDigitYTree d = yTrees !! (d - 1)

-- Given two d-digit values, m and n, how many Ys are in [m..n]?

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

ysInRange m n d
    | nVal == n = nPos - mPos + 1
    | otherwise = nPos - mPos
    where (mVal, mPos) = findFirst' m
          (nVal, nPos) = findFirst' n
          findFirst' x = case findFirst (Ge x, Any) (dDigitYTree d) of
                             Just (Max i, Max j) -> (i, j)
                             Nothing             -> (tenToThe d, numNDigitYs d)

-- counting decimal digits and bits
-- the numbers here are big enough that instead of counting digits one by one,
-- we compare with b, b^2, b^4, b^8, ... to make it O(log(# of digits)).

powersOfTwo = map (2 ^) [0..]

twoToThe n = powersOfTwo !! n

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 = 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)

-- The following is derived from a response to a Stack Overflow question
-- http://stackoverflow.com/questions/1623375/writing-your-own-square-root-function
-- citing Crandall & Pomerance, "Prime Numbers: A Computational Perspective".

floorSqrt :: Integer -> Integer

floorSqrt 0 = 0
floorSqrt n = floorSqrt' (2 ^ ((1 + bitsIn n) `div` 2))
    where floorSqrt' x =
              let y = (x + n `div` x) `div` 2
              in if y >= x then x else floorSqrt' y

ceilSqrt :: Integer -> Integer

ceilSqrt n =
    let y = floorSqrt n
    in if y * y == n then y else y + 1

-- The top level, using ysInDigitRange where possible. We break the interval
-- down by number of digits.

numYs :: Integer -> Integer -> Int

numYs m n
    | mDigits == nDigits   = ysInRange m n mDigits
    | mPower10 && nPower10 = ysInDigitRange mDigits (nDigits - 1)
    | mPower10             = ysInDigitRange mDigits (nDigits - 1)
                             + ysInRange (tenToThe (nDigits - 1) + 1) n nDigits
    | otherwise            = ysInRange m (tenToThe mDigits - 1) mDigits
                             + ysInDigitRange (mDigits + 1) (nDigits - 1)
                             + ysInRange (tenToThe (nDigits - 1) + 1) n nDigits
    where mDigits    = digitsIn m
          nDigits    = digitsIn n
          mPower10 = m == tenToThe (mDigits - 1)
          nPower10 = n == tenToThe (nDigits - 1)

numXs :: Integer -> Integer -> Int

numXs m n = numYs (ceilSqrt m) (floorSqrt n)

-- A new main, heavily inspired by "Haskell I/O for Imperative Programmers"
-- http://www.haskell.org/haskellwiki/Haskell_IO_for_Imperative_Programmers
-- (tail skips the first line that says how many lines follow)

main = do
    s <- B.getContents
    let r = zipWith (curry showsResult) [1 ..] (map process (tail $ B.lines s))
    mapM (putStr . ($ "\n")) r

process :: B.ByteString -> Int

process line = case map B.readInteger (B.words line) of
               [Just (m, _), Just (n, _)] -> numXs m n
               _                          -> -1

showsResult :: (Int, Int) -> String -> String

showsResult (c, n) = ("Case #" ++) . shows c . (": " ++) . shows n