# Generating numbers palindromic in two number bases

The purpose of the code below is to generate numbers that are $2d+1$ digit palindromes in number base $b+1$, and are also palindromic in number base $b+3$, where:

The numberToBase is used to convert number $n$ to list representation in number base $b$.

The palindromeInBase returns $n^{\text{th}}$ $2d+1$ digit palindrome in base $b$, for $0\le n\lt b^{d+1}-b^d$.

I'm acquiring palindromes in base $b+1$ and checking if they are palindromic in $b+3$ as well, by looking at their digits in that base when converted to list representation.

I'm wondering how the code below can be improved, and whether there is a way to do this computation faster?

numberToBase[n_, b_] := If[n == 0, {0},
digits = {};
number = n;
While[number > 0,
digits = Append[digits, Mod[number, b]];
number = Floor[number/b];
];
Return[Reverse[digits]];
];

palindromeInBase[d_, b_, n_] :=
1 + b^(2 d) + b^d*n + b^(d - 1)*Floor[n/b] -
Sum[(b^(i + 1) - b^(i - 1))*Floor[n/b^(d - i + 1)], {i, 1, d - 1}]

d = 3;

For[b = 1, b <= 100, b += 1,
L = {};
B1 = b + 1;
B2 = b + 3;

For[n = 0, n < (B1)^(d + 1) - (B1)^d, n += 1,
x = palindromeInBase[d, B1, n];
If[PalindromeQ[numberToBase[x, B2]], L = Append[L, x];];
];

Print[b, ":", " (" , Length[L], ") " , L];
];

• Why are the bases $b+1$ and $b+3$ instead of $b^\prime$ and $b^\prime + 2$? – David G. Stork Mar 30 '18 at 17:08
• Your numberToBase[n, b] is equivalent to the built-in function IntegerDigits[n, b] – Bob Hanlon Mar 30 '18 at 17:39
• Also FromDigits might come in handy. – Henrik Schumacher Mar 30 '18 at 18:42

Here are some further ideas:

b1 = 3;
b2 = 4;
d = 3;
a = Flatten[Outer[
List,
Range[1, b1 - 1],
Sequence @@ ConstantArray[Range[0, b1 - 1], d - 1]
], d - 1];
b1digits = a[[All, Join[Range[d], Reverse[Range[1, d - 1]]]]];
candidates = FromDigits[#, b1] & /@ b1digits;
b2digits = IntegerDigits[candidates, b2];
palindomes = Pick[n, PalindromeQ /@ IntegerDigits[candidates, b2]]
IntegerDigits[palindomes, b1]
IntegerDigits[palindomes, b2]


{130}

{{1, 1, 2, 1, 1}}

{{2, 0, 0, 2}}

(This is a self-answer after discovering I can use Reduce directly.)

The previous answer gives ideas related to your approach of iterating palindromes.

Here, I present a way to directly compute them instead.

Directly computing $$2,3$$-palindromes

"...whether there is a way to do this computation faster?"

Rather than brute-force checking palindromes, you can directly solve for them, for individual $$b$$ values, via Reduce and the corresponding system.

I've implemented get2Palindromes and get3Palindromes for getting palindromes in $$b,b-1$$ and $$b,b-1,b-2$$ respectively, using the system from the linked post. (Full code included at the end of this post.)

Since the title is referring to 2-palindromes, here is a sample input:

Do[Print["d = ", 3, ", base: ", base, "; ", Timing[get2Palindromes[3, base]]];, {base, 2, 10}]


And sample output for it:

d = 3, base: 2; {0.015625,{}}
d = 3, base: 3; {0.03125,{}}
d = 3, base: 4; {0.03125,{}}
d = 3, base: 5; {0.046875,{46}}
d = 3, base: 6; {0.0625,{67,98,104}}
d = 3, base: 7; {0.078125,{92,135,178,185}}
d = 3, base: 8; {0.09375,{121,178,235,292,300}}
d = 3, base: 9; {0.09375,{154,227,300,373,446,455}}
d = 3, base: 10; {0.09375,{191,282,373,464,555,646,656}}


If you want to display their palindromic digits, I've also implemented:

getDigits[n_, b_, k_] :=
MatrixForm[Table[IntegerDigits[n, b - i], {i, 0, k - 1}]];


Which can be used like: getDigits[#, base, 2] & /@ on the palindrome output:

Do[Print["d = ", 3, ", base: ", base, "; ", Timing[getDigits[#, base, 2] & /@ get2Palindromes[3, base]]];, {base, 2, 10}]


Which gives a output in terms of base digits:

Note that Reduce will get very slow quickly for larger $$d$$. - This is still much faster than doing a brute force search over all palindromes, especially for large $$b$$. The only exceptions might be very small $$b$$ in combination with very large $$d$$, where brute-force might be faster than Reduce.

Here is the code:

(* Helper functions for representations *)
ClearAll[d, palindromePolynom, a, x, baseCoefficients, baseBorrowings,
b, o, h];
palindromePolynom[d_, x_: x, c_: a] :=
Sum[a[i + 1] x^i, {i, 0, (d - 1)/2}] +
Sum[a[d - i] x^i, {i, (d - 1)/2 + 1, d - 1}];
baseCoefficients[d_, k_: 0] :=
Reverse[CoefficientList[palindromePolynom[d, x - k], x]];
baseBorrowings[d_, k_: 0, var_: o,
b_] := +Join[
Join[{var[1]},
Table[var[i + 1] - var[i] (b + k), {i, 1,
d - 2}]], {-var[d - 1] (b + k)}];

(* base b-1,b-2 representations digits parameterized by o,h *)
ClearAll[coefX, coefA, coefB];
coefX[d_, k_: 0, var_, b_] :=
baseCoefficients[d, k] + baseBorrowings[d, k, var, b];
coefA[d_, b_, k_: - 1, var_: o] := coefX[d, k, var, b];
coefB[d_, b_, k_: - 2, var_: h] := coefX[d, k, var, b];

(* helper functions for conditions *)
ClearAll[varList, varConds, geCond];
varList[var_, n_] := Table[var[i], {i, 1, n}];
varConds[var_, n_, cond_, c_: 0] :=
Fold[And, Table[cond[var[i], c], {i, 1, n}]];
geCond[d_, var_, c_: 0] := varConds[var, d, GreaterEqual, c];

(* conditions on digits, bases and parameters *)
ClearAll[paramVars, paramVarsA, paramVarsB, paramVars2, paramVars3,
paramConds2, paramConds3, baseConds, baseCondsA, baseCondsB,
baseConds2, baseConds3, palCondsA, palCondsB, palConds3];
paramVars[d_] := varList[a, (d + 1)/2];
paramVarsA[d_] := varList[o, d - 1];
paramVarsB[d_] := varList[h, d - 1];
paramVars2[d_] := Join[paramVars[d], paramVarsA[d]];
paramVars3[d_] := Join[paramVars[d], paramVarsA[d], paramVarsB[d]];
paramConds2[d_] :=
geCond[(d + 1)/2, a] && geCond[d - 1, o] && a[1] >= 1 ;
paramConds3[d_] :=
geCond[(d + 1)/2, a] && geCond[d - 1, o] && geCond[d - 1, h] &&
a[1] >= 1;
baseConds[d_, b_] :=  Fold[And, Table[a[i] < b, {i, 1, (d + 1)/2}]];
baseCondsA[d_, b_] :=
Fold[And, Table[0 <= coefA[d, b][[i]] < b - 1, {i, 1, d}]] &&
coefA[d, b][[1]] >= 1 && coefA[d, b][[d]] >= 1;
baseCondsB[d_, b_] :=
Fold[And, Table[0 <= coefB[d, b][[i]] < b - 2, {i, 1, d}]] &&
coefB[d, b][[1]] >= 1 && coefB[d, b][[d]] >= 1;
baseConds2[d_, b_] :=  baseConds[d, b] && baseCondsA[d, b];
baseConds3[d_, b_] :=
baseConds[d, b] && baseCondsA[d, b] && baseCondsB[d, b];
palCondsA[d_, b_] :=
Fold[And,
Table[coefA[d, b][[i]] == coefA[d, b][[d - i + 1]], {i,
1, (d + 2)/2 - 1}]] ;
palCondsB[d_, b_] :=
Fold[And,
Table[coefB[d, b][[i]] == coefB[d, b][[d - i + 1]], {i,
1, (d + 2)/2 - 1}]];
palConds3[d_, b_] := palCondsA[d, b] && palCondsB[d, b];

(* solving representations under conditions via Reduce *)
ClearAll[reduce2P, reduce3P];
reduce2P[d_, b_, conds_: True] :=
Reduce[conds && paramConds2[d] && baseConds2[d, b] &&
palCondsA[d, b], paramVars2[d], Integers];
reduce3P[d_, b_, conds_: True] :=
Reduce[conds && paramConds3[d] && baseConds3[d, b] &&
palConds3[d, b], paramVars3[d], Integers];

(* printing out solutions nicely from Reduce results *)
ClearAll[expandBase, extract2, get2Palindromes, extract3,
get3Palindromes, getDigits];
expandBase[digs_, base_] :=
Sum[digs[[i]]*base^(Length[digs] - i), {i, 1, Length[digs]}];
extract2[d_, b_, cond_] :=
Flatten[expandBase[coefA[d, b], b - 1] /.
Delete[FindInstance[#,
paramVars2[d]] & /@ (List @@ (cond || a[1] == 1)), -1]];
extract3[d_, b_, cond_] :=
Flatten[expandBase[coefA[d, b], b - 1] /.
Delete[FindInstance[#,
paramVars3[d]] & /@ (List @@ (cond || a[1] == 1)), -1]];
get2Palindromes[d_, b_] :=
Module[{r}, r = reduce2P[d, b]; If[r == False, Return[{}]];
Return[extract2[d, b, r]]];
get3Palindromes[d_, b_] :=
Module[{r}, r = reduce3P[d, b]; If[r == False, Return[{}]];
Return[extract3[d, b, r]]];
getDigits[n_, b_, k_] :=
MatrixForm[Table[IntegerDigits[n, b - i], {i, 0, k - 1}]];

Do[Print["d = ", 3, ", base: ", base, "; ",
Timing[getDigits[#, base, 2] & /@
get2Palindromes[3, base]]];, {base, 2, 10}];

(*
Do[Print["d = ",3, ", base: ",base,"; \
",Timing[getDigits[#,base,3]&/@get3Palindromes[3,base]]];,{base,8,9}];
Do[Print["d = ",5, ", base: ",base,"; \
",Timing[getDigits[#,base,3]&/@get3Palindromes[5,base]]];,{base,47,47+\
4}];
Do[Print["d = ",7, ", base: ",base,"; \
",Timing[getDigits[#,base,3]&/@get3Palindromes[7,base]]];,{base,291,\
291+11}];
*)


Note that palindromes given by this will have exactly $$d$$ digits in all of those number bases:

To search for ones with $$d,d+k_1,d+k_1+k_2$$ digits in bases $$b,b-1,b-2$$, conditions and coefficients can be easily modified in the above code. Note that such examples for $$3$$-palindromes are not known yet, and that such examples for $$2$$-palindromes only exist for small bases $$b$$ and are finite for all $$d$$ cases so far.