| Bytes | Lang | Time | Link |
|---|---|---|---|
| nan | 250207T091621Z | 138 Aspe | |
| nan | 241208T110350Z | 138 Aspe | |
| 094 | GolfScript | 140107T050419Z | Ben Reic |
| nan | 140107T002548Z | mleise | |
| nan | 131120T163931Z | MtnViewM | |
| nan | 131120T002304Z | F. Hauri | |
| nan | 131113T063030Z | Dom Hast | |
| nan | 131113T044506Z | DavidC | |
| nan | 131113T005404Z | Reinstat |
C++
C++ port of @Reinstate Monica's Python code.
#include <iostream>
#include <string>
#include <vector>
#include <map>
#include <cmath>
#include <algorithm>
#include <functional>
#include <iomanip>
// Helper to check if a string is a palindrome and its length is >= minLen
bool isPalindrome(const std::string &s, int minLen) {
if (s.size() < static_cast<size_t>(minLen)) {
return false;
}
std::string rev(s.rbegin(), s.rend());
return s == rev;
}
// Convert an unsigned long long to an octal string
std::string toOctalString(unsigned long long value) {
if (value == 0) {
return "0";
}
std::string result;
while (value > 0) {
int remainder = static_cast<int>(value % 8);
result.push_back(static_cast<char>('0' + remainder));
value /= 8;
}
std::reverse(result.begin(), result.end());
return result;
}
// Custom base64 encoding that interprets each pair of octal digits
// as an index into 64 possible characters.
std::string customBase64Encoding(unsigned long long i,
const std::map<std::string, char> &octTo64)
{
// Convert to octal
std::string octalString = toOctalString(i);
// Ensure even length by prepending '0' if needed
if (octalString.size() % 2 != 0) {
octalString.insert(octalString.begin(), '0');
}
// Build result by mapping each chunk of 2 octal digits to a base64 char
std::string result;
for (size_t idx = 0; idx < octalString.size(); idx += 2) {
std::string key = octalString.substr(idx, 2);
auto it = octTo64.find(key);
if (it != octTo64.end()) {
result.push_back(it->second);
}
}
return result;
}
// Convert an unsigned long long to a hexadecimal string
std::string toHexString(unsigned long long value) {
std::ostringstream oss;
oss << std::hex << value;
return oss.str();
}
// Convert an unsigned long long to a decimal string
std::string toDecimalString(unsigned long long value) {
return std::to_string(value);
}
// Convert an unsigned long long to a binary string
std::string toBinaryString(unsigned long long value) {
if (value == 0) {
return "0";
}
std::string result;
while (value > 0) {
result.push_back((value & 1) ? '1' : '0');
value >>= 1;
}
std::reverse(result.begin(), result.end());
return result;
}
// Convert an unsigned long long to an octal string (reusing toOctalString)
std::string toOctalStringWrapper(unsigned long long value) {
return toOctalString(value);
}
int main() {
// Minimum number of digits for palindrome check
int mindigits = 2;
// Minimum number of palindromic encodings in different bases
int minpalins = 3;
std::cout << "Count Base64 Hexa Decimal Octal Binary\n";
// Build the oct_to_64 mapping
// "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ@_"
const std::string base64_chars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ@_";
std::map<std::string, char> octTo64;
for (int i = 0; i < 64; i++) {
// Format i in octal with 2 digits (e.g., 00, 01, ..., 77)
char buffer[4];
std::snprintf(buffer, sizeof(buffer), "%02o", i);
octTo64[buffer] = base64_chars[i];
}
// Create a list of encoders
// We'll use std::function for easy storage of lambdas
std::vector<std::function<std::string(unsigned long long)>> encoders;
encoders.push_back([&](unsigned long long i) { return customBase64Encoding(i, octTo64); });
encoders.push_back([](unsigned long long i) { return toHexString(i); });
encoders.push_back([](unsigned long long i) { return toDecimalString(i); });
encoders.push_back([](unsigned long long i) { return toOctalStringWrapper(i); });
encoders.push_back([](unsigned long long i) { return toBinaryString(i); });
// Start from 8^(mindigits - 1)
// In Rust, 8^(mindigits - 1) = 8u64.pow((mindigits - 1) as u32)
// We'll compute that in C++:
unsigned long long start = 1ULL;
for (int p = 0; p < mindigits - 1; ++p) {
start *= 8ULL;
}
// Infinite loop (press Ctrl+C to stop)
for (unsigned long long i = start; /* no upper limit */; ++i) {
// Generate encoded representations
std::vector<std::string> encodedValues;
for (const auto &encoder : encoders) {
encodedValues.push_back(encoder(i));
}
// Check how many encodings are palindromic
int palindromeCount = 0;
for (const auto &val : encodedValues) {
if (isPalindrome(val, mindigits)) {
palindromeCount++;
}
}
// If we have enough palindromic encodings, print them
if (palindromeCount >= minpalins) {
// Printing in columns similar to Rust code
// Count, Base64, Hexa, Decimal, Octal, Binary
std::cout
<< std::left << std::setw(5) << palindromeCount << " "
<< std::left << std::setw(6) << encodedValues[0] << " "
<< std::left << std::setw(6) << encodedValues[1] << " "
<< std::left << std::setw(8) << encodedValues[2] << " "
<< std::left << std::setw(8) << encodedValues[3] << " "
<< encodedValues[4]
<< "\n";
}
}
return 0;
}
Rust
Rust port of @Reinstate Monica's Python code.
use std::collections::HashMap;
fn main() {
let mindigits = 2;
let minpalins = 3;
println!("Count Base64 Hexa Decimal Octal Binary");
// Build the oct_to_64 mapping
let base64_chars: Vec<char> = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ@_"
.chars()
.collect();
let mut oct_to_64 = HashMap::new();
for i in 0..64 {
let key = format!("{:02o}", i);
oct_to_64.insert(key, base64_chars[i]);
}
// Define the base64 function
fn base64(i: u64, oct_to_64: &HashMap<String, char>) -> String {
let mut octalstring = format!("{:o}", i);
if octalstring.len() % 2 != 0 {
octalstring = format!("0{}", octalstring);
}
let mut result = String::new();
let chars: Vec<char> = octalstring.chars().collect();
for chunk in chars.chunks(2) {
let key: String = chunk.iter().collect();
if let Some(&val) = oct_to_64.get(&key) {
result.push(val);
}
}
result
}
// Create a reference to oct_to_64 that lives long enough
let oct_to_64_ref = &oct_to_64;
// Use Box to store the closures and move to capture the reference
let encoders: Vec<Box<dyn Fn(u64) -> String>> = vec![
Box::new(move |i| base64(i, oct_to_64_ref)), // Custom base64
Box::new(|i| format!("{:x}", i)), // Hexadecimal
Box::new(|i| format!("{}", i)), // Decimal
Box::new(|i| format!("{:o}", i)), // Octal
Box::new(|i| format!("{:b}", i)), // Binary
];
let mut i = 8u64.pow((mindigits - 1) as u32);
loop {
let encodeds: Vec<String> = encoders.iter().map(|encoder| encoder(i)).collect();
let palindromes: Vec<&String> = encodeds
.iter()
.filter(|encoded| {
let rev: String = encoded.chars().rev().collect();
*encoded == &rev && encoded.len() >= mindigits
})
.collect();
let num_palins = palindromes.len();
if num_palins >= minpalins {
println!(
"{:<5} {:<6} {:<6} {:<8} {:<8} {}",
num_palins,
encodeds[0],
encodeds[1],
encodeds[2],
encodeds[3],
encodeds[4]
);
}
i += 1;
}
}
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]]
...
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;
}();
}
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).
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
@@ -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
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 HaskellWhithout 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 - 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
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.
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
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]
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...