Enumerate all number that are palindromic in at least two of base 2, 8, 10, 16 or 64

Question

Multi palindromic numbers

Finding all number for which at least two** representation are palindromic, with more than one** characters, if in decimal, octal, hexadecimal, binary or in base64.

** have to be editable, see Variables below.

Edited: After lot of reflexion about comment from @DavidCarraher, I found an important issue about the range to be used. Mostly in the goal of reducing ratio operation/output. For this, variables section of this question was modified.

Details

Representation of numbers are:

• binary : 01
• octal : 01234567
• decimal : 0123456789
• hexadecimal: 0123456789abcdef (in lower case)
• base64 : 0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ@_ Nota: This representation is compatible with bash: printf "%o" $((64#r0r)) give 330033 (r0r is a palindrome in both base64 and octal)

The ouput present first a count of palindromes, than all 5 variantes from smaller representation to bigger:

Count Base64 Hexa   Decimal  Octal    Binary
3     11     41     65       101      1000001
3     33     c3     195      303      11000011
3     55     145    325      505      101000101
3     77     1c7    455      707      111000111
4     99     249    585      1111     1001001001
3     ll     555    1365     2525     10101010101
3     rr     6db    1755     3333     11011011011
3     JJ     b6d    2925     5555     101101101101
3     ZL     f6f    3951     7557     111101101111
4     __     fff    4095     7777     111111111111
4     101    1001   4097     10001    1000000000001
3     111    1041   4161     10101    1000001000001
3     202    2002   8194     20002    10000000000010
4     303    3003   12291    30003    11000000000011
3     333    30c3   12483    30303    11000011000011

Nota this sample display number that's palindromes in at least 3 representation, not 2, see Variables below.

Variables

• Minimum of palindrome length, default to 2
• Minimum number of palindrome by number, default to 2 (/5). There are 5 representation. Print a number when at least 2 of them are palindromic.
• Range to check for: could be from 1 to 2^31 or smaller. This could be an array BoundRange=(1,1000) or two variables: RangeSta=1 RangeEnd=1000.

This variables have to be changeables in simple way (modification of code at only one place or given as argument).

Output

No formating needed, only 6 colons, space separated will suffice.

2 9 9 9 11 1001
2 h 11 17 21 10001
2 r 1b 27 33 11011
2 x 21 33 41 100001
2 J 2d 45 55 101101
2 P 33 51 63 110011
2 _ 3f 63 77 111111
3 11 41 65 101 1000001
2 19 49 73 111 1001001
2 1l 55 85 125 1010101

Limits (range)

There is no real consideration of maximum useable of the range as this is depending on language used, But a range have to be fixed:

• min: 1 (notation in octal!)

• max: depending on language used, but 2^31 seem to be an overall minimum.

For tests, the range could be fixed to somthing smaller...

Goal

The more efficient algorithm with less operation count by line of output will win. (This may have to be explained)**.

• Ratio operation count / output line count
• Shortness of code, but with readable variables ie: One variable is one. Regardless of his name length. (don't obfusc)
• Quickness of execution (comparission only by language, not accross different languages. Ie: I won't try to compare a c version with a bash one. )

Operations count

The count of operation are mainly theorical. Meaning, a simple conversion is one operation whenever it is done by builtin functions, like printf or by more complex routine like sub base in Dom Hastings's answer

**As I don't know all languages, and there is some place to unusual ideas, subtles algorithms may need to be explained...

Answer 1

Mathematica

f[number,minPalindromeLength,minCount]works as follows If number is a palindrome with minPalindromeLength in at least minCount bases, f returns the information about that number.

g[max,minPalindromeLength,minCount] makes an table of "palindrome numbers" from 1 through max.

f[number_,minPalindromeLength_:2,minCount_:2]:=Module[{print,palindromeQ,count, 
convert64=Thread[Range[0,63]->Characters["0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ@_"]],
digits=IntegerDigits[number,#]&/@(bases={64,16,10,8,2})},
palindromeQ[dig_]:=(dig==Reverse[dig]);
count = Total@Boole[palindromeQ/@ Cases[digits,x_/;Length[x]>minPalindromeLength-1]];
If[count>minCount-1,Join[{count,Subscript[StringJoin[IntegerDigits[number,64]/.convert64],64]},BaseForm[number,#]&/@Rest[bases]],Sequence[]]];

g[max_,minPalindromeLength_:2,minCount_:2]:=
(Print["\nPalindromes: minPalindromeLength = ",minPalindromeLength "\tand minCount ", minCount ]; 
DeleteCases[Table[f[z,minPalindromeLength,minCount],{z,9,max}],Null]//Grid);

g[5000,2,3]
g[5000,3,3]
g[5000,4,2]

Answer 2

Python

Rather straightforward; could be optimized somewhat. For example, the octal representation is calculated twice. (Still, I hope that's much faster than creating a base 64 representation in pure python.)

Also, all representations are calculated, even if after, say, 3 representations it is clear that there will not be enough palindromes. However, i feel that the code is much cleaner as it is.

mindigits, minpalins = 2, 3
print("Count Base64 Hexa   Decimal  Octal    Binary")

from itertools import count

oct_to_64={"%02o"%i:"0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ@_"[i] for i in range(64)}

def base64(i):
    octalstring="{0:o}".format(i)
    if len(octalstring) % 2:
        octalstring = "0" + octalstring
    return "".join(oct_to_64[octalstring[i:i+2]] for i in range(0,len(octalstring), 2))

encoders=[base64, "{0:x}".format, str, "{0:o}".format, "{0:b}".format]
for i in count(8**(mindigits-1)):
    encodeds = [encoder(i) for encoder in encoders]
    palindromes = [encoded for encoded in encodeds if encoded[::-1]==encoded and len(encoded)>=mindigits]
    num_palins = len(palindromes)
    if num_palins >= minpalins:
        print("%-5s %-6s %-6s %-8s %-8s %s" % tuple([num_palins] + encodeds))

Output:

Count Base64 Hexa   Decimal  Octal    Binary
3     11     41     65       101      1000001
3     33     c3     195      303      11000011
3     55     145    325      505      101000101
3     77     1c7    455      707      111000111
4     99     249    585      1111     1001001001
3     ll     555    1365     2525     10101010101
3     rr     6db    1755     3333     11011011011
3     JJ     b6d    2925     5555     101101101101
3     ZL     f6f    3951     7557     111101101111
4     __     fff    4095     7777     111111111111
4     101    1001   4097     10001    1000000000001
3     111    1041   4161     10101    1000001000001
3     202    2002   8194     20002    10000000000010
4     303    3003   12291    30003    11000000000011
3     333    30c3   12483    30303    11000011000011
3     404    4004   16388    40004    100000000000100

and so on...

Answer 3

Perl

So I don't think this is necessarily efficient, but I guess it'll at least provide a benchmark for other Perl scripts! I originally got distracted by making the shortest code (should have RTFQ...). I imagine I could improve this more by replacing the manual base conversions <64 with sprintf so I might look at that later on.

# length of palindrome
$length = 2;
# minimum number of palindromes
$number = 2;

sub base {
    ($-, $base, $n) = @_;
    do {
        $n = (0..9,a..z,A..Z,'@',_)[$- % $base].$n
    } while $- = $- / $base;

    $n
}

while (++$i) {
    @nums = map {
        base($i, $_)
    } (64, 16, 10, 8, 2);

    $count = scalar grep { length >= $length && $_ eq scalar reverse $_ } @nums;

    print "$count @nums\n"x($count >= $number)
}

Output:

2 9 9 9 11 1001
2 h 11 17 21 10001
2 r 1b 27 33 11011
2 x 21 33 41 100001
2 J 2d 45 55 101101
2 P 33 51 63 110011
2 _ 3f 63 77 111111
3 11 41 65 101 1000001
2 19 49 73 111 1001001
2 1l 55 85 125 1010101
2 1z 63 99 143 1100011
2 1T 77 119 167 1110111
2 1V 79 121 171 1111001
2 22 82 130 202 10000010
2 2p 99 153 231 10011001
2 2G aa 170 252 10101010

Answer 4

Haskell

Total rewrite; complete new algorithm:

module Main where

import Data.List (foldl', group, unfoldr)
import qualified Data.Vector.Unboxed as V
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr)

bases :: [Integer]
bases = [64, 16, 10, 8, 2]

alphabet :: V.Vector Char
alphabet = V.fromList
    "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ@_"

fromBase :: Integer -> [Integer] -> Integer
fromBase base = foldl' ((+).(*base)) 0

toBase :: Integer -> Integer -> [Integer]
n `toBase` b = unfoldr digit n
  where
    digit 0 = Nothing
    digit m = let (q,r) = m `divMod` b in Just (r,q)

formatPalindromic :: (Integer,Int) -> String
formatPalindromic (n,count) =
    show count ++ concatMap (showDigits . (n `toBase`)) bases
  where
    showDigits = (' ':) . map digit . reverse
    digit = (alphabet V.!) . fromInteger

genEvenPalendromes :: Integer -> [[Integer]]
genEvenPalendromes base = [1..] >>= sequence . flip replicate digits >>= asPal
  where
    digits = [0..base-1]
    asPal (0:_) = []
    asPal s = [s ++ reverse s]

genOddPalendromes :: Integer -> [[Integer]]
genOddPalendromes base = [1..] >>= sequence . flip replicate digits >>= makePals
  where
    digits = [0..base-1]
    makePals (0:_) = []
    makePals s = let r = reverse s in [ s ++ d : r | d <- digits ]

merge :: (Ord a) => [a] -> [a] -> [a]
merge as [] = as
merge [] bs = bs
merge as@(a:at) bs@(b:bt) | a <= b    = a : merge at bs
                          | otherwise = b : merge as bt

allPalendromes :: Int -> Integer -> [Integer]
allPalendromes minLength base = merge (limit evens) (limit odds)
  where
    limit =  map (fromBase base) . dropWhile ((< minLength) . length)
    evens = genEvenPalendromes base
    odds = genOddPalendromes base

allPalendromics :: Int -> Int -> [(Integer,Int)]
allPalendromics minRequired minLength =
    onlyMultis $ countEm $ mergeEm $ genEm
  where
    genEm = map (allPalendromes minLength) bases
    mergeEm = foldl' merge []
    countEm = map (\s -> (head s, length s)) . group
    onlyMultis = filter ((>= minRequired) . snd)

parseArgs :: IO (Int, Int, Maybe Integer)
parseArgs = do
    args <- getArgs
    case args of
        [] -> return (2, 2, Nothing)
        [r] -> return (read r, 2, Nothing)
        [r,l] -> return (read r, read l, Nothing)
        [r,l,m] -> return (read r, read l, Just $ read m)
        _ -> do
            hPutStrLn stderr "usage: multiple-palindromes-needed min-length max-value"
            hPutStrLn stderr "-or- defaults to 2, 2, no-limit"
            exitFailure

main :: IO ()
main = do
    (minRequired, minLength, maxValue) <- parseArgs
    let result = allPalendromics minRequired minLength
        limit = maybe id (\v -> takeWhile ((<= v) . fst)) maxValue
    mapM_ (putStrLn . formatPalindromic) $ limit result

Runs on my system (1.8 GHz Intel Core i7) in under 0.1s:

& ghc -o /tmp/palin -O -fforce-recomp -outputdir /tmp -Wall 15225-Palindromic.hs
& time ( /tmp/palin 2 2 20000000 | tee >(tail -n3 >/dev/fd/3) | wc -l ) 3>&1
2 19119 1241049 19140681 111010111 1001001000001000001001001
2 19899 1248249 19169865 111101111 1001001001000001001001001
2 19999 1249249 19173961 111111111 1001001001001001001001001
    1149

real    0m0.071s
user    0m0.067s
sys     0m0.010s

Generates all solutions to 2, 3, 99 999 999 999 quickly:

& time ( /tmp/palin 2 3 99999999999 | tee >(tail -n3 >/dev/fd/3) | wc -l ) 3>&1
2 1nADADh 15e49e49d1 94029892049 1274447444721 1010111100100100111100100100111010001
2 1n@FK_h 15fea6efd1 94466666449 1277651567721 1010111111110101001101110111111010001
2 1rIGIr1 16ecaac6c1 98459895489 1335452543301 1011011101100101010101100011011000001
   12495

real    0m7.866s
user    0m7.687s
sys     0m0.170s

Note: Unlike my last solution, this code has not been hand optimized at all: It is straight forward idiomatic Haskell (with the exception of alphabet being a Vector).

Answer 5

D (thinking outside the box solution)

With the defaults (palindrome length >= 2, in bases >= 2) and the range 1..20_000_000 this takes ~8 ms on my 2 Ghz notebook. Most of the time (~6 ms) is spent for formatting and printing (to /dev/null). The actual result generation takes about 2 ms.

It works by first generating a list of all palindromes for each of the 5 bases at compile-time. The generator skips directly from one palindrome to the next by adding e.g. 110 to the number 7557 -> 7667. It's a bit like manually implementing a very weird increment instruction, but avoids checking ALL numbers by converting them to the respective base. (Only a tiny fraction of the numbers in the range 1..2³¹ are actually palindromes.)

At runtime these 5 lists are processed by finding the lowest value amongst them and counting the occurrences. The number of occurrences maps to the 'Count' field in the output and the value is the number that is a palindrome in one ore more representations. The value is then removed from the front of all the lists that had it.

All the occurrence counts and values that match the filter criteria are added to a result set and afterwards printed.

Lines of code: 280

import std.stdio, std.string, core.time, std.range, core.bitop, std.traits, 
       std.getopt, std.algorithm;

int main(string[] args) {
    // Process command line
    uint palindromeLength = 2;
    uint numPalindromes = 2;
    uint rangeLow = 1;
    uint rangeHigh = 2^^31;
    bool showHelp = false;

    getopt(args,
           "length", &palindromeLength,
           "num",    &numPalindromes,
           "low",    &rangeLow,
           "high",   &rangeHigh,
           "help",   &showHelp);

    if (showHelp) {
        writeln("Finds numbers that are palindromes in one or more bases.");
        writeln("The compared bases are 2, 8, 10, 16 and 64.");
        writeln("The following options are available (default values are given):");
        writeln("  --length=2  Filter palindromes below a certain length.");
        writeln("  --num=2     Only show numbers that are palindromes in as many bases.");
        writeln("  --low=1     The first number to check (in decimal).");
        writeln("  --high=2³¹  The last number to check (in decimal).");
        writeln("  --help      Show this help screen.");
        return 0;
    }

    if (palindromeLength == 0) {
        stderr.writeln("--length must be at least 1!");
        return 1;
    }
    if (numPalindromes < 1 || numPalindromes > 5) {
        stderr.writeln("--num must be in the range 1 to 5!");
        return 1;
    }
    if (rangeLow > rangeHigh) {
        stderr.writeln("--low must be less than --high!");
        return 1;
    }

    // We check the --length and --low option here
    auto restrictRange(immutable uint[] values, immutable size_t[] index) {
        immutable(uint)[] result;
        if (palindromeLength < index.length)
            result = values[index[palindromeLength] .. $];
        if (rangeLow < 2)
            return result[rangeLow .. $];
        return result.assumeSorted.upperBound(rangeLow - 1).release();
    }

    // Start of timing...
    auto t1 = TickDuration.currSystemTick;

    alias base2 = Palindromes!2.data;
    alias base8 = Palindromes!8.data;
    alias base10 = Palindromes!10.data;
    alias base16 = Palindromes!16.data;
    alias base64 = Palindromes!64.data;

    // Use all palindrome lists that have at least one number in range.
    auto use = [
        restrictRange(base2.values, base2.lengthIndex),
        restrictRange(base8.values, base8.lengthIndex),
        restrictRange(base10.values, base10.lengthIndex),
        restrictRange(base16.values, base16.lengthIndex),
        restrictRange(base64.values, base64.lengthIndex),
    ].filter!(a => a.length > 0 && a[0] <= rangeHigh).array();

    // This section will filter by --num and --high
    struct Group {
        uint count;
        uint value;
    }
    Group[] groups;
    groups.reserve (use.map!"a.length".reduce!"a + b"());

    do {
        // Find the lowest value and how often it occurs
        uint low = uint.max;
        uint lowCnt = 0;
        foreach (u; use) {
            if (u[0] < low) {
                low = u[0];
                lowCnt = 1;
            } else if (u[0] == low) {
                lowCnt++;
            }
        }
        if (lowCnt >= numPalindromes)
            groups ~= Group(lowCnt, low);

        // Remove the value and dead lists
        for (size_t i = 0; i < use.length;) {
            if (use[i][0] == low) {
                if (use[i].length == 1 || use[i][1] > rangeHigh) {
                    use[i] = use[$-1];
                    use.length--;
                    continue;
                } else {
                    use[i] = use[i][1 .. $];
                }
            }
            i++;
        }
    } while (use.length);
    auto t2 = TickDuration.currSystemTick;

    // Print the result
    writefln("Lookup took %.2f ms", 0.000001 * (t2-t1).nsecs);
    writeln("Count Base64 Hexa     Decimal    Octal       Binary");
    foreach (grp; groups)
        writefln("%s     %-6s %-8x %3$-10s %3$-11o %3$-32b",
                 grp.count, grp.value.toBase64, grp.value);

    return 0;
}

char[] toBase64(uint value) {
    string tab = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ@_";
    char[6] result = "      ";
    size_t pos = 6;
    do {
        result[--pos] = tab[value % 64];
        value /= 64;
    } while (value);
    return result[pos .. $].dup;
}

/**
 * Finds all palindromes for a given number base in the range 2 to 256 within
 * the limits given by data type ℕ, which can be either ubyte, ushort or uint.
 */
template Palindromes(uint base, ℕ = uint)
    if (isUnsigned!ℕ && ℕ.sizeof <= 4 && base > 1 && base <= 256)
{
    // The maximum number of digits for this base that can be represented in ℕ.
    enum digits = {
        uint result = 1;
        ℕ power = 1;
        while (ℕ.max / base >= power) {
            result++;
            power *= base;
        }
        return result;
    }();

    // Number of ways we can add a value to 0, keeping it a palindrome.
    enum options = (digits + 1) / 2 * (digits / 2 + 1);

    /* Number of ways to increment a number of `length` digits, keeping it a
     * palindrome.
     */
    enum optionsForLength(size_t length) { return (length + 1) / 2; }

    /* Lookup array for the sum of the values of the digits at positions n
     * and 0, used to increment one palindrome in this base to the next one.
     */
    immutable increments = {
        ℕ[options] result;
        size_t idx = 0;
        ℕ high = 1, low = 1;
        foreach (length; 0 .. digits) {
            ℕ h = high, l = low;
            do {
                result[idx++] = (h == l) ? h : cast(ℕ) (h + l);
                h *= base;
                l /= base;
            } while (l);

            if (length & 1)
                low *= base;
            else
                high *= base;
        }
        return result;
    }();

    /* When a slot in a palindrome overflows, this array is used to reset
     * the slot and all lesser slots much like when you do 999+1=1000.
     */
    immutable resets = {
        ℕ[options] result = 0;
        uint idx = 0;
        foreach (length; 1 .. digits + 1) {
            foreach (i; 0 .. optionsForLength(length)) {
                immutable prev = i ? result[idx - 1] : 0;
                immutable curr = (base - 1) * increments[idx];
                result[idx++] = cast(ℕ) (prev + curr);
            }
        }
        return result;
    }();

    // The count of palindromes in this base for a given number of digits.
    enum numPalindromesOfLengthUpTo(size_t digits) {
        return base ^^ (digits / 2) - 1 + base ^^ ((digits + 1) / 2);
    }

    // The real number of palindromes in this base that fit into ℕ.
    enum numPalindromes = {
        static if (bsr(base) == bsf(base) && ℕ.sizeof * 8 % bsf(base) == 0) {
            // All digits of this base fit evenly into ℕ.
            return numPalindromesOfLengthUpTo(digits);
        } else {
            // Some palindromes with the most significant digit != 0
            // cannot be represented and must be droped.
            enum options = optionsForLength(digits);

            auto remainder = ℕ.max;
            size_t result = numPalindromesOfLengthUpTo(digits - 1);
            foreach_reverse(i; 0 .. options) {
                immutable increment = increments[$ - options + i];
                auto n = remainder / increment;
                remainder -= n * increment;
                if (i == options - 1) n--;
                if (i == 0) n++;
                result += n * (base ^^ i);
            }
            return result;
        }
    }();

    /* Structure that iterates over the palindromes in this base.
     * To avoid overflow, an external check is required.
     */
    struct PalindromeRange
    {
    private:
        ubyte[(digits + 1) / 2] slots = 0;
        uint offset = 0;

    public:
        uint width = 1;
        ℕ front = 0;

        void popFront() {
            // Highest digit value in this base.
            enum max = cast(ubyte) (base - 1);

            size_t si = 0;
            if (slots[0] >= max) {
                do {
                    si++;
                } while (si < slots.length && slots[si] >= max);
                front -= resets[offset + si - 1];
                slots[0 .. si] = 0;
                if (si == optionsForLength(width)) {
                    offset += optionsForLength(width);
                    if (width++ == digits) return;
                    si = optionsForLength(width) - 1;
                }
            }
            slots[si]++;
            front += increments[offset + si];
        }
    }

    struct PalindromeData {
        ℕ[numPalindromes] values;
        size_t[digits+1] lengthIndex;
    }

    immutable data = {
        PalindromeData result;
        uint width;
        auto pr = PalindromeRange();
        foreach (i; 0 .. numPalindromes) {
            result.values[i] = pr.front;
            if (width != pr.width) {
                width = pr.width;
                result.lengthIndex[width] = i;
            }
            pr.popFront();
        }
        return result;
    }();
}

Answer 6

Not an answer.

This is not an answer to the question, but to other answers...

This is not regular on SE, but I think this could be usefull in the meaning of PPCG.

First

I've found 12 495 numbers which are palindrome in at least two of all five representations and containing at least three characters, between 1 and 99 999 999 999

Some samples:

printf "%o\n" 94466666449
1277651567721

echo $(( 64#1rIGIr1 ))
98459895489

printf "%o\n" 0x1557557551
1252725272521

My modified (perl) version of Dom Hastings's answer took ~90 seconds on my desktop...

Of course original version of same script is able to browse approx from 1 to 60 000 by using the same time, on same pc.

Here is a need to think out of the box...

My point of view:

My system is not so small:

CPU Intel(R) Core(TM)2 Duo CPU     E8400  @ 3.00GHz
Dual core run on 64 bits GNU/Linux
With 4Gb RAM.

Comparissions.

For making this something equitable, I will render outputs there to be able to make some comparissions.

For rendering output, I will use the following command:

time ( /tmp/palin-XXX.YY 20000000 2 2 | tee >(tail -n3 >/dev/fd/3) | wc -l ) 3>&1

I will try to respect publication order.

First: WolframH's Python answer

@@ -1 +1,3 @@
-mindigits, minpalins = 2, 3
+mindigits, minpalins, maxint = 2, 2, 20000000
@@ -4 +6 @@
-from itertools import count
@@ -15 +17 @@
-for i in count(8**(mindigits-1)):
+for i in range(8**(mindigits-1), maxint ):

Than:

time ( ./palin.py 20000000 2 2 | tee >(tail -n3 >/dev/fd/3) | wc -l ) 3>&1
2     19119  1241049 19140681 111010111 1001001000001000001001001
2     19899  1248249 19169865 111101111 1001001001000001001001001
2     19999  1249249 19173961 111111111 1001001001001001001001001
1150

real    3m0.768s
user    2m48.895s
sys     0m0.560s

Second: Dom Hastings's perl answer

@@ -15 +15 @@
-while (++$i) {
+while (++$i<20000000) {

Give:

time ( perl ./palin-dom-b.pl | tee >(tail -n3 >/dev/fd/3) | wc -l ) 3>&1
2 19119 1241049 19140681 111010111 1001001000001000001001001
2 19899 1248249 19169865 111101111 1001001001000001001001001
2 19999 1249249 19173961 111111111 1001001001001001001001001
1149

real    14m58.174s
user    14m54.512s
sys     0m0.412s

Third: David Carraher's Mathematica

Unfortunely, I don't know how to test this, but as I could read, there seem not to be different algorithm...

That's little a surprise, becaud David warned my about maximum and this is an important notion in this question.

Fourth: MtnViewMark's Haskell

Whithout any modification and after compilation conforming to answer indication:

time ( ./palin.haskel | tee >(tail -n3 >/dev/fd/3) | wc -l ) 3>&1
2 19119 1241049 19140681 111010111 1001001000001000001001001
2 19899 1248249 19169865 111101111 1001001001000001001001001
2 19999 1249249 19173961 111111111 1001001001001001001001001
1149

real    0m26.631s
user    0m24.802s
sys     0m0.124s

Hmm, this seem to be very interesting, in that: I didn't know haskell before.

But this miss something in them of operation/output

My results:

I've wrote two versions. The first prototype was bash (yes I could be quicker using bash than a python version;-):

time ( ./palin.sh 20000000 2 2 | tee >(tail -n3 >/dev/fd/3) | wc -l ) 3>&1
2     (19899) (1248249) (19169865) 111101111 1001001001000001001001001
2     (19999) (1249249) (19173961) 111111111 1001001001001001001001001
List len: 46572, Output len: 1149, Operations: 173548: ratio: 151.04
1150

real    1m40.052s
user    1m9.588s
sys     0m13.249s

... and this version is penalized by an operation counter: I count 173 548 operation for computing all values under all 5 base, from 1 to 20 000 000 !!!

And there is same work with a perl version:

time ( perl ./palin-d-shrink.pl 20000000 2 2 | tee >(tail -n3 >/dev/fd/3) | wc -l ) 3>&1
2     (19119) (1241049) (19140681) 111010111 1001001000001000001001001
2     (19899) (1248249) (19169865) 111101111 1001001001000001001001001
2     (19999) (1249249) (19173961) 111111111 1001001001001001001001001
1149

real        0m0.631s
user        0m0.612s
sys         0m0.016s

Recap:

First python          3m0.768s
First perl           14m58.174s
Mathematica          -- unknow (but seem not having less oper/lines ) --
Haskel                0m26.631s (this is compiled)
My bash prototyp      1m40.052s  -> 1m16.067s see Nota under bash explanation
My perl (shrinked)    0m0.631s

I insist: here is a need to think out of the box!!

End of BOUNTY: Bravo MtnViewMark's Haskell

You was the first to rewrite your code to build all possible values in a drawing fashion first before searching for values that match requirement.

There is my perl shrinked version:

#!/usr/bin/perl -w
use strict;my%vars;my$maxr=999999;my$minn=3;my$minl=3;$maxr=$1if$ARGV[0]&&$ARGV
[0]=~/^(\d+)$/;$minn=$1if$ARGV[1]&&$ARGV[1]=~/^(\d+)$/;my%value;$minl=$1if$ARGV
[2]&&$ARGV[2]=~/^(\d+)$/;my@digits=("0".."9","a".."z","A".."Z","@","_");my$i=0;
map{$value{$_}=$i++}@digits;sub base{my($n,$base)=@_;my$str='';do{$str=$digits[
$n%$base].$str}while$n=int($n/$base);$str}sub rbase{my($num,$base)=@_;my$out=0;
$out = $out * $base + $value{$1} while $num =~ s /^(.)//;$out}sub ebase{defined
($vars{$_[1]}{$_[0]})?$vars{$_[1]}{$_[0]}:"(".base(@_).")"}sub palinlst{my$base
=pop;my$maxst=base($maxr,$base);my$half=int(length($maxst)/2+.5);my($lasteven,$
lastodd)=do{length($maxst)%2? (rbase($digits[$base-1]x ($half-1), $base),rbase(
substr($maxst,0,$half), $base)): (rbase(substr($maxst, 0,$half),$base), rbase($
digits[$base-1]x$half, $base))}; foreach my$p($lasteven+1..$lastodd){ my$part1=
base($p,$base); my$part2=reverse $part1; my$str=$part1.substr($part2,1);my$val=
rbase($str,$base);if(length($str)>=$minl){$vars{$base}{$val}=$str;$vars{'count'
}{$val}++}};foreach my$p(1..$lasteven){my$part1=base($p,$base);my$part2=reverse
$part1;my$str=$part1.$part2; my$val=rbase($str,$base);if(length($str)>=$minl){$
vars{$base}{$val}=$str;$vars{'count'}{$val}++};$part2=reverse$part1;$str=$part1
.substr($part2,1);$val=rbase($str,$base);if(length($str)>=$minl){$vars{$base}{$
val}=$str;$vars{'count'}{$val}++;}}};for my$b(qw(2 8 10 16 64)){palinlst$b;}map
{printf"%-5s %-6s %-6s %-8s %-8s %s\n",$vars{'count'}{$_},ebase($_,64),ebase($_
,16),ebase($_,10),ebase($_,8),ebase($_,2);}grep{$vars{'count'}{$_}>=$minn}sort{
$a<=>$b}keys$vars{'count'};  #  (C)  2013  -  LGPL v2  -  [e-mail]

This is shrinked, not obfuscated! You could make them readable by running perltidy. I use this form to make cut'n paste easier.

perltidy < ./palin-shrinked.pl

I think this become readable.

Explanation (using bash for readabilty;-) 1m40.052s 1m16.067s

As the final version is 139 lines long, I will split them there in order to explain each part:

#!/bin/bash

printf -v RANGEND "%u" ${1:-1000} # Max decimal value of palin to compute 
MINCNT=${2:-2} # Minimum number of palindrome by output line default:2
MINLEN=${3:-2} # Minimum length of palindrome  default:2
OUTFMT="%-5s %-6s %-6s %-8s %-8s %s\n"
opcount=0
shopt -s extglob

int2b64 () { local _i _func='{ local _lt=({0..9} {a..z} {A..Z} @ _) _var _out;
                                printf -v _var "%022o" $1 ;_out="'
    for ((_i=0; _i<22; _i+=2)) ;do
        printf -v _func '%s${_lt[8#${_var:%d:2}]}' "$_func" $_i
    done
    _func+='";printf ${2:+-v} $2 "%s" ${_out##*(0)}; }'
    eval "${FUNCNAME}()" $_func
    $FUNCNAME $@ ; }
int2bin () { local _fmt="" _i
        for _i in {0..7}
        do
            fmt+="_var=\${_var//$_i/%s};"
        done
        printf -v fmt "$fmt\n" 000 001 010 011 100 101 110 111
        eval "${FUNCNAME}()"'{ local _var;printf -v _var "%o" $1;
                           '${fmt}'printf ${2+-v} $2 "%s" ${_var##*(0)}; }'
        $FUNCNAME $@ ; }

There is the first functions, I use the trick to re-define $FUNCNAME before first use.

rev() { local _func='{ printf ${2+-v} $2 "%s" ' _i
    for ((_i=64;_i--;)) do _func+='${1:'$_i':1}' ; done
    eval "rev()" $_func ';}'; rev $@ ; }
int2hex() { printf ${2+-v} $2 "%x" $1 ; }
int2oct() { printf ${2+-v} $2 "%o" $1 ; }
int2dec() { printf ${2+-v} $2 "%u" $1 ; }

Some more function, easy to understand, The hard part is comming now:

makePalinList() {
    local max=${1:-1000} vmax palin
    local forms=('' '' bin '' '' '' '' '' oct '' dec '' '' '' '' '' hex
        ''{,,,}{,,}{,,}{,}b64)
    local digmax=('' '' 1 '' '' '' '' '' 7 '' 9 '' '' '' '' '' f
        ''{,,,}{,,}{,,}{,}_)    
    local cmd=${forms[$2]}
((opcount+=5))
    int2$cmd $max vmax

with this, I make that int$form[64] will be expanded before execution to intb64 (under bash, there is no need to use eval there).

vmax is the max value to render. So now we have to compute each case (even and odd string length):

    local vpart=$((5*${#vmax}+5))
    local vpskel=${vmax:0:${vpart%?}}
    local lasteven lastodd
    if ((${#vmax}%2)) ;then
        lastodd=$(($2#$vpskel))
        vpskel=${vpskel:1}
        lasteven=$(($2#${vpskel//?/${digmax[$2]}}))
    else
        lasteven=$(($2#$vpskel))
        lastodd=$(($2#${vpskel//?/${digmax[$2]}}))
    fi

I will let you think about all this... Now we have to compute start of ranges

    local firsteven=$(((MINLEN+1)/2)) firstodd=$((MINLEN/2+1))
    printf -v firsteven "%${firsteven}s" ""
    printf -v firstodd   "%${firstodd}s" ""
    firsteven=${firsteven// /0}
    firsteven=${firsteven/0/1}
    firsteven=$(($2#$firsteven))
    firstodd=${firstodd// /0}
    firstodd=${firstodd/0/1}
    firstodd=$(($2#$firstodd))

Wow.

Nota: My previous (not published) version was not using firsteven and firstodd but simply 1.. and a in loop condition: ${#palin} -ge $MAXLEN before each printf -v lst$cmd[....

Adding this and the following if at end of next part improved my script a lot: from ~100 seconds, my script only take 76 seconds now for computing previous test 20000000 2 2

Now there could be an issue where next if could not match:

    if [ $firstodd -lt $lasteven  ] ;then 
        for ((i=firsteven;i<firstodd;i++)) ;do
            int2$cmd $i b
            rev $b r
            palin=$b$r
            printf -v lst$cmd[$(($2#$palin))] $palin
            ((counts[$(($2#$palin))]++))
            ((opcount+=3))
        done
        for ((i=firstodd;i<=lasteven;i++)) ;do
            int2$cmd $i b
            rev $b r
            palin=$b$r
            printf -v lst$cmd[$(($2#$palin))] $palin
            ((counts[$(($2#$palin))]++))
            palin=$b${r:1}
            printf -v lst$cmd[$(($2#$palin))] $palin
            ((counts[$(($2#$palin))]++))
            ((opcount+=4))
        done
        for ((i=lasteven+1;i<=lastodd;i++)) ;do
            int2$cmd $i b
            rev $b r
            palin=$b${r:1}
            printf -v lst$cmd[$(($2#$palin))] $palin
            ((counts[$(($2#$palin))]++))
            ((opcount+=4))
        done

And if else:

    else

        for ((i=firsteven;i<=lasteven;i++)) ;do
            int2$cmd $i b
            rev $b r
            palin=$b$r
            printf -v lst$cmd[$(($2#$palin))] $palin
            ((counts[$(($2#$palin))]++))
            ((opcount+=3))
        done

        for ((i=firstodd;i<=lastodd;i++)) ;do
            int2$cmd $i b
            rev $b r
            palin=$b${r:1}
            printf -v lst$cmd[$(($2#$palin))] $palin
            ((counts[$(($2#$palin))]++))
        done

    fi

That's all (for now)...

}
for base in 2 8 10 16 64; do makePalinList $RANGEND $base ;done

Now we just have to print all values (adding parenthesis if value have to be computer -> ie not already exist -> ie not match requirement.)...

lines=0;for i in ${!counts[@]};do
    [ ${counts[i]} -ge $MINCNT ] && \
        printf "%-5s %-6s %-6s %-8s %-8s %s\n" ${counts[i]} \
        ${lstb64[i]:-($(int2b64 $i))} \
        ${lsthex[i]:-($(int2hex $i))} \
        ${lstdec[i]:-($i)} \
        ${lstoct[i]:-($(int2oct $i))} \
        ${lstbin[i]:-($(int2bin $i))} && ((lines++))
  done

if [ $lines -gt 0 ] ;then ratio=000$((opcount*1000/lines))
    printf "List len: %s, Output len: %d, Operations: %d: ratio: %.2f\n" \
    ${#counts[@]} $lines $opcount ${ratio:0:${#ratio}-3}.${ratio:${#ratio}-3}
else echo no output; fi

Ok, there is a zipped version of this bash script, to make cut'n paste easy:

#!/usr/bin/perl -w
my$u="";open my$st,"|gunzip";sub d{my$l=pack("c",32+.75*length($_[0]));print$st
unpack("u",$l.$_[0]);"";};while(<DATA>){tr#A-Za-z0-9+/##cd; tr#A-Za-z0-9+/# -_#
;$u.=$_;while($u=~s/(.{80})/d($1)/egx){};};d($u);__DATA__
H4sIAHg8jlICA9VX227bRhB9Fr9iQq1C0jLFiy9xxBCx0TpFgdgpCueltiBQ0soiwosgUoJbYv+9s7u8
iZbjh6JFKkgid3fmzMzZ4XC2/8aahYk1C7KVoqw3YZIvwdzB71e3v1zf/gzqYKsCKZyx6di2zaAPN8ET
LOg8jIMIdkG0pZAuYR1EYQJ5CvM0Xm9zCsrNr7c/3d75pHDHpiv0wiSMtzEk23hGN7XSYpPGFGZ/QrrN
URNwiiL+MthG+djlMJ+vbxHmpAMT0eQxX3VgWopfvt59urnz1YF5lsHAPK//Lqq/7CFRlXQ9T7dJ7ttK
tkrXOZgZ0Kf8MUpnioJcuLPzU9ANKCBK5xjwNITpcpvMfa2eiXJfL+zR6D2DIhiN/sLL1Wj0B4NLmBow
3QUbmGJsngKvfBryhZI6sF03RfId8DiAr2oCYpluQNenoW976M4H1+WXoe8aBniLVDmAxh0GbZCRAp29
v+jjFQ2MB4uxyyZMA5UIETQ1DYX+Ik2ouBHzQ19TvRKOb+fQ3DEgLjqY8dTgvvX7R7ptMA+Y9JFiYiBs
8ekrJsHVzTXTDY7O0cQ6qRaAXAJqSaoxg9pUL2OMWcXglB6PGalHAc70O6b0WpEKUuJ86Ks8LP9BhmdZ
GI01yJincmkMqNdQguLoHv5jCgDmNf4csB28Og5gouMPrzh2HEfpHYqm2X+05T3bOrFv391yjRRon2kN
sV1eEanNa+8ZacqG7vYIKxPzBUgNyu2tM+j81JuGpulh6izSerP5064hedrYweTwmmyQPAij1W6C5jHN
A5xr7+SKPgm/DjnyJDO6lEzn+YuS6Z4klpwXJbe1pBIH3+hvvCB8DjMBLTyXBMXBk98qZTscy+LRkkFu
4szXNQ3wyzNS3tVfdJhf0JvuCgat9DStOD4+ZkX9Y1hAjBb+InzkbpQGnC7IO/73vju7PASMxQU/Leh5
vMDwRAD3xJ0wRdfL6jb0zwzpBGeSoCAQHjxnQGkh7NbBJveJrp8dkaLPV9mw0qwksm80QjN8cWyP8Ybr
DD4y1pKKgiynO5qIm3SxkKaXmHQV7ECUq3xFE6VXCnG7xO0TaQKt9hpj4gbTUQpz6Eq6XLOsjxYpJLki
eFa6TaOMPtdqbHSMvwa3lE9QO2HCTYOty9fV0DEsHqBYK9HliuXimoRqVaMKAlMZN7AaMXxmVfWQLELi
ZC2Mw5Zsy6EGy7LAstl31m3LebYsKaknagqqoGrrXfTO6j52i+1qXCJXaXIP9QqYUQ6kzieYyKQBpSdf
Croe+rWDXvih0vPC4bB8Ifb28z6EmZwSNWsGGzkSdcAnM1KNa8ajLOea96XPQtAwJiDvpLSui+cs6wpx
JyqJ+lk84XPyjdQJQjj+wa/C7Qbxg4RS4xcb8Uj+y3SdHqKromjoVIT9o03/7yNpatPhRH4xCf53mfwj
bkxrE7CiM4X7jicgyjtMFy6Ad37ngO0R74v2Wgog1cmICAVPQCn81JJhR86BRJ9KijelA5cTVvXlWNiK
cjacMDAfKRB5TsLC9vYtPNQ96ivHln0cVCMFkoKtBo7Hpk706uhCQsNoBLBFaQvgsCOAbU0pELZmsedp
q/EWaF8N+6Q9wzx+IYAx6brgRvBeniwUWePFPJKQg13X9U2Qh6mP7Rmp0+yId2uWEN5/c6piP/AcOEZS
juFLeX4U4wWO11SgJRkfjyU03o7cJWfwQR5Ein6zTZVLpLSMq1KJ9zl9ccvMEzaqptuTCn+Ygc5XKSRp
eZb1eHL9DRLsWT9gDwAA

You could simply run:

perl >/tmp/palin-bash.sh

than paste previous script into your console.

Answer 7

GolfScript 94

Didn't do the formatting really, but this works in GolfScript. Doing the formatting would probably add 20-30 characters.

~:j;:i;
10 5?,
{[2 8 10 16 64]\{\base}+%}%
{{.,i(>\{.,2<{;1.(}{(\)@=}if}do`1`=&}%{+}*j(>},
{p}%

This also limits the numbers to 10000 (in decimal). That number can be changed, of course, to the maximum integer, but this runs pretty quickly as is.

Example call: echo '3 2' | ruby golfscript.rb h.gs

Output:

[[1 0 0 0 0 0 0 0 0 1] [1 0 0 1] [5 1 3] [2 0 1] [8 1]]
[[1 0 0 1 0 0 1 0 0 1] [1 1 1 1] [5 8 5] [2 4 9] [9 9]]
[[1 1 0 0 0 0 0 0 0 1 1] [3 0 0 3] [1 5 3 9] [6 0 3] [24 3]]
[[1 1 0 1 1 0 1 1 0 1 1] [3 3 3 3] [1 7 5 5] [6 13 11] [27 27]]
[[1 0 1 0 0 0 0 0 0 1 0 1] [5 0 0 5] [2 5 6 5] [10 0 5] [40 5]]
[[1 0 1 0 1 0 0 1 0 1 0 1] [5 2 2 5] [2 7 0 9] [10 9 5] [42 21]]
...