---------------------------------------------------------------------
                       Four Haskell Programs for 
                   Binary Digitally Balanced Numbers
                        with Run-Time Comparison
   ---------------------------------------------------------------------


   1. Paraphrasing the definition
   ------------------------------

import Data.List (elemIndices)

a031443 n = a031443_list !! (n-1)
a031443_list = elemIndices True $ zipWith (==) a000120_list a023416_list


   2. Applying Reikku Kulon's formula
   ----------------------------------

   Similar to (1), but slightly faster.

import Data.List (elemIndices)

a031443 n = a031443_list !! (n-1)
a031443_list = map (+1) $ elemIndices 0 $ map a145037 [1..]


   3. Applying Ulrich Schimke's formula
   ------------------------------------

   The fastest solution!

a031443 n = a031443_list !! (n-1)
a031443_list = 2 : f 2 2 where
  f n a = y : f (n+1) y where
    y = a + bk + bm - 1 + (bk * (2*bm-1) `div` a) * bm * (4*bm+1) where
         -- a == a031443 (n-1)
         bk = 2^k
         bm = 2^(m-1)
         (m, _) = f (m' + 1)
         (k, m') = f a

         f x = f' (0, x) where
             f' (e, x) | even x    = f' (e + 1, x `div` 2)
                       | otherwise = (e, x)
         -- f n = (A007814(n), A000265(n))


   4. Digitally generated
   ----------------------
   
   Inserting simultaneously one 0 and one 1 anywhere in the binary 
   representation of a digitally balanced number, gives a new digitally 
   balanced numbers (when the 0 will not be leading). The following 
   program is based on this observation. It is much slower than the 
   others. There might be some tuning potential, but obviously there is 
   too much overhead to administer the containers for new numbers.

import Data.List (inits, tails, sort, nub, group)
import Data.Set (Set, singleton, deleteFindMin, insert)
import Data.Char (digitToInt)

newtype BinStr = BinStr String deriving Eq
instance Ord BinStr where 
  BinStr xs <= BinStr ys 
    | length xs == length ys = xs <= ys
    | otherwise              = length xs <= length ys

a031443 n = a031443_list !! (n-1)
a031443_list = f $ singleton $ BinStr "10" where
   f :: Set BinStr -> [Int]
   f s = foldl (\n d -> digitToInt d + 2*n) 0 bs : 
     f (foldl (flip insert) s' (map BinStr $ 
        nub $ sort $ concat $ map (iBit '1') $ iBit '0' bs)) where 
       (BinStr bs, s') = deleteFindMin s
   iBit b bs = zipWith (\xs ys -> xs ++ b : ys) 
                  (tail $ inits bs) (tail $ tails bs)


   ---------------------------------------------------------------
   Performance Tests: b-files of length n
                      Glasgow Haskell Compiler. Mac OS X, 2.66 GHz
   ---------------------------------------------------------------
         n      (1)      (2)      (3)       (4)   b-file   A031443
   -------  -------  -------  -------  --------  -------  --------
       100   0.003s   0.003s   0.002s    0.028s      4KB       684
      1000   0.029s   0.019s   0.007s    0.750s     12KB      9829
     10000   0.458s   0.279s   0.044s   16.094s    111KB    138924
    100000   3.410s   2.075s   0.419s    ca. 5m   1279KB    877622
   1000000  51.650s  31.006s   4.334s        ..  15014KB  11421255

-- ---------------------------------------------------------------------
--                                       Reinhard Zumkeller, Jun 16 2011
--                                          reinhard.zumkeller@gmail.com