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

## 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 : 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 version with a 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... • Better use “base 64” instead of “base64”. At least for me base64(65)="NjU=" vs. 65₆₄=11 are different. – manatwork Nov 12 '13 at 14:44 • @manatwork: The base64 encoding that many programming languages use, encodes the ASCII values of the characters. – Qqwy Nov 12 '13 at 15:29 • “This have to be explained” Indeed. Please explain. – J B Nov 12 '13 at 15:59 • And how do you count operations? – J B Nov 12 '13 at 16:44 • Then what is the range of numbers we should examine? – DavidC Nov 13 '13 at 3:37 ## 7 Answers # 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]  • Warning: Question is modified (sorry) in that way: a maximum has to be specified. Your code seem not to be optimal in the meaning: oper/output. – F. Hauri Nov 15 '13 at 21:42 ## 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... • +1 as you're the first and your solution match the request. – F. Hauri Nov 13 '13 at 2:38 • Warning: Question is modified (sorry) in that way: a maximum has to be specified. Your code seem not to be optimal in the meaning: oper/output. – F. Hauri Nov 15 '13 at 21:40 ## 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

• I like your universal base conversion tool – F. Hauri Nov 13 '13 at 12:56
• Who said perl is write only? I find your version more readable than the python one! ;-) – F. Hauri Nov 13 '13 at 13:01
• Hah, thanks! I used that instead of switching between sprintf and another method to save bytes, as I say though, probably less efficient :( I'm glad it's a bit readable, the original golfed one made much less sense! – Dom Hastings Nov 13 '13 at 16:59
• Warning: Question is modified (sorry) in that way: a maximum has to be specified. Your code seem not to be optimal in the meaning: oper/output. – F. Hauri Nov 15 '13 at 21:41
• I like the pseudo code nature of your answer. It gave me a good conceptual implementation to wrap my head around before writing my own code. – mleise Jan 7 '14 at 0:29

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). • Unfortunely, in your last edition, you've dropped compile command. Please replace them. – F. Hauri Nov 21 '13 at 16:33 • I'm sorry, why the concern about where clauses? They don't cost anything in Haskell - and occasionally they can speed things up. – MtnViewMark Nov 21 '13 at 16:54 • I don't understand the concern over [0..base-1]? Perhaps you aren't familiar with Haskell - that list will be computed once, and then simply looped over. – MtnViewMark Nov 21 '13 at 16:57 • If there is any op/line to be saved here, it is that rather than use a Map, the ten streams of palindromes (two for each base, evens and odds) could be merged (as they are strictly monotonic), and then pull off runs of the same number that are long enough. This would cause the whole computation to be pipelined, and need constant memory no matter the max value. In fact, one could generated all values infinitely, easily this way. But I'm not sure it will be all that faster. I could try that later today... have to head to work now! – MtnViewMark Nov 21 '13 at 17:03 • Implemented the merge version - now takes only 70% of the time it did before. And takes only constant memory! – MtnViewMark Nov 22 '13 at 0:29 ## 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;
}();
}


### 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

+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 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  -  palindrome@F-Hauri.ch


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


### 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
DD4y1pKKgiynO5qIm3SxkKaXmHQV7ECUq3xFE6VXCnG7xO0TaQKt9hpj4gbTUQpz6Eq6XLOsjxYpJLki
eFa6TaOMPtdqbHSMvwa3lE9QO2HCTYOty9fV0DEsHqBYK9HliuXimoRqVaMKAlMZN7AaMXxmVfWQLELi
ZC2Mw5Zsy6EGy7LAstl31m3LebYsKaknagqqoGrrXfTO6j52i+1qXCJXaXIP9QqYUQ6kzieYyKQBpSdf
Croe+rWDXvih0vPC4bB8Ifb28z6EmZwSNWsGGzkSdcAnM1KNa8ajLOea96XPQtAwJiDvpLSui+cs6wpx
JyqJ+lk84XPyjdQJQjj+wa/C7Qbxg4RS4xcb8Uj+y3SdHqKromjoVIT9o03/7yNpatPhRH4xCf53mfwj
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.

• Interesting! I haven't had much of a chance to look at this again, but I'm very intrigued to see your modifications! – Dom Hastings Nov 21 '13 at 8:31
• @DomHastings : I'ts not only modifications, maybe the expression could better by You have to think  from the inner box ... !? – F. Hauri Nov 21 '13 at 9:51

## 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}do1=&}%{+}*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]]
...

• You know, at IBM they pay by number of lines written. – mleise Jan 7 '14 at 22:10