I'm working on modernizing Rosetta Code's infrastructure. Starting with communications. Please accept this time-limited open invite to RC's Slack.. --Michael Mol (talk) 20:59, 30 May 2020 (UTC)

Composite numbers k with no single digit factors whose factors are all substrings of k

From Rosetta Code
Task
Composite numbers k with no single digit factors whose factors are all substrings of k
You are encouraged to solve this task according to the task description, using any language you may know.

Find the composite numbers k in base 10, that have no single digit prime factors and whose prime factors are all a substring of k.


Task
  • Find and show here, on this page, the first ten elements of the sequence.


Stretch
  • Find and show the next ten elements.



ALGOL 68[edit]

BEGIN # find composite k with no single digit factors whose factors are all substrings of k #
# returns TRUE if the string representation of f is a substring of k str, FALSE otherwise #
PROC is substring = ( STRING k str, INT f )BOOL:
BEGIN
STRING f str = whole( f, 0 );
INT f len = ( UPB f str - LWB f str ) + 1;
BOOL result := FALSE;
INT f end := ( LWB k str + f len ) - 2;
FOR f pos FROM LWB k str TO ( UPB k str + 1 ) - f len WHILE NOT result DO
f end +:= 1;
result := k str[ f pos : f end ] = f str
OD;
result
END # is substring # ;
# task #
INT required numbers = 20;
INT k count := 0;
# k must be odd and > 9 #
FOR k FROM 11 BY 2 WHILE k count < required numbers DO
IF k MOD 3 /= 0 AND k MOD 5 /= 0 AND k MOD 7 /= 0 THEN
# no single digit odd prime factors #
BOOL is candidate := TRUE;
STRING k str = whole( k, 0 );
INT v := k;
INT f count := 0;
FOR f FROM 11 BY 2 TO ENTIER sqrt( k ) + 1 WHILE v > 1 AND is candidate DO
IF v MOD f = 0 THEN
# have a factor #
is candidate := is substring( k str, f );
IF is candidate THEN
# the digits of f ae a substring of v #
WHILE v OVERAB f;
f count +:= 1;
v MOD f = 0
DO SKIP OD
FI
FI
OD;
IF is candidate AND ( f count > 1 OR ( v /= k AND v > 1 ) ) THEN
# have a composite whose factors are up to the root are substrings #
IF v > 1 THEN
# there was a factor > the root #
is candidate := is substring( k str, v )
FI;
IF is candidate THEN
print( ( " ", whole( k, -8 ) ) );
k count +:= 1;
IF k count MOD 10 = 0 THEN print( ( newline ) ) FI
FI
FI
FI
OD
END
Output:
    15317    59177    83731   119911   183347   192413  1819231  2111317  2237411  3129361
  5526173 11610313 13436683 13731373 13737841 13831103 15813251 17692313 19173071 28118827

Arturo[edit]

valid?: function [n][
pf: factors.prime n
every? pf 'f ->
and? [contains? to :string n to :string f]
[1 <> size digits f]
]
 
cnt: 0
i: new 3
 
while [cnt < 10][
if and? [not? prime? i][valid? i][
print i
cnt: cnt + 1
]
'i + 2
]
Output:
15317
59177
83731
119911
183347
192413
1819231
2111317
2237411
3129361

F#[edit]

Can anything be described as a translation of J? I use a wheel as described in J's comments, but of course I use numerical methods not euyuk! strings.

 
// Composite numbers k with no single digit factors whose factors are all substrings of k. Nigel Galloway: January 28th., 2022
let fG n g=let rec fN i g e l=match i<g,g=0L,i%10L=g%10L with (true,_,_)->false |(_,true,_)->true |(_,_,true)->fN(i/10L)(g/10L) e l |_->fN l e e (l/10L) in fN n g g (n/10L)
let fN(g:int64)=Open.Numeric.Primes.Prime.Factors g|>Seq.skip 1|>Seq.distinct|>Seq.forall(fun n->fG g n)
Seq.unfold(fun n->Some(n|>List.filter(fun(n:int64)->not(Open.Numeric.Primes.Prime.Numbers.IsPrime &n) && fN n),n|>List.map((+)210L)))([1L..2L..209L]
|>List.filter(fun n->n%3L>0L && n%5L>0L && n%7L>0L))|>Seq.concat|>Seq.skip 1|>Seq.take 20|>Seq.iter(printfn "%d")
 
Output:
15317
59177
83731
119911
183347
192413
1819231
2111317
2237411
3129361
5526173
11610313
13436683
13731373
13737841
13831103
15813251
17692313
19173071
28118827
Real: 00:00:26.059

Go[edit]

Translation of: Wren
Library: Go-rcu
package main
 
import (
"fmt"
"rcu"
"strconv"
"strings"
)
 
func main() {
count := 0
k := 11 * 11
var res []int
for count < 20 {
if k%3 == 0 || k%5 == 0 || k%7 == 0 {
k += 2
continue
}
factors := rcu.PrimeFactors(k)
if len(factors) > 1 {
s := strconv.Itoa(k)
includesAll := true
prev := -1
for _, f := range factors {
if f == prev {
continue
}
fs := strconv.Itoa(f)
if strings.Index(s, fs) == -1 {
includesAll = false
break
}
}
if includesAll {
res = append(res, k)
count++
}
}
k += 2
}
for _, e := range res[0:10] {
fmt.Printf("%10s ", rcu.Commatize(e))
}
fmt.Println()
for _, e := range res[10:20] {
fmt.Printf("%10s ", rcu.Commatize(e))
}
fmt.Println()
}
Output:
    15,317     59,177     83,731    119,911    183,347    192,413  1,819,231  2,111,317  2,237,411  3,129,361 
 5,526,173 11,610,313 13,436,683 13,731,373 13,737,841 13,831,103 15,813,251 17,692,313 19,173,071 28,118,827 

J[edit]

  */2 3 5 7
210
#1+I.0=+/|:4 q:1+i.210
48

Or: 48 out of every 210 positive numbers have no single digit factors.

So, we can generate a few hundred thousand lists of 48 numbers, discard the primes (and 1), then check what's left using substring matching on the factors. (We allow '0' as a 'factor' in our substring test so that we can work with a padded array of factors, avoiding variable length factor lists.)

   2{._10 ]\(#~ */"1@((+./@(E. '0 ',])~&>)&:(":&.>)q:))(#~ 1-1&p:)}.,(1+I.0=+/|:4 q:1+i.210)+/~210*i.2e5
15317 59177 83731 119911 183347 192413 1819231 2111317 2237411 3129361
5526173 11610313 13436683 13731373 13737841 13831103 15813251 17692313 19173071 28118827

Most of the time here is the substring testing, so this could be better optimized.

Julia[edit]

using Lazy
using Primes
 
function containsitsonlytwodigfactors(n)
s = string(n)
return !isprime(n) && all(t -> length(t) > 1 && contains(s, t), map(string, collect(keys(factor(n)))))
end
 
seq = @>> Lazy.range(2) filter(containsitsonlytwodigfactors)
 
foreach(p -> print(lpad(last(p), 9), first(p) == 10 ? "\n" : ""), enumerate(take(20, seq)))
 
Output:
    15317    59177    83731   119911   183347   192413  1819231  2111317  2237411  3129361
  5526173 11610313 13436683 13731373 13737841 13831103 15813251 17692313 19173071 28118827

Pascal[edit]

Free Pascal[edit]

modified Factors_of_an_integer#using_Prime_decomposition

program FacOfInt;
// gets factors of consecutive integers fast
// limited to 1.2e11
{$IFDEF FPC}
{$MODE DELPHI} {$OPTIMIZATION ON,ALL} {$COPERATORS ON}
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}
uses
sysutils,
strutils //Numb2USA
{$IFDEF WINDOWS},Windows{$ENDIF}
;
//######################################################################
//prime decomposition
const
//HCN(86) > 1.2E11 = 128,501,493,120 count of divs = 4096 7 3 1 1 1 1 1 1 1
HCN_DivCnt = 4096;
type
tItem = Uint64;
tDivisors = array [0..HCN_DivCnt] of tItem;
tpDivisor = pUint64;
const
//used odd size for test only
SizePrDeFe = 32768;//*72 <= 64kb level I or 2 Mb ~ level 2 cache
type
tdigits = array [0..31] of Uint32;
//the first number with 11 different prime factors =
//2*3*5*7*11*13*17*19*23*29*31 = 2E11
//56 byte
tprimeFac = packed record
pfSumOfDivs,
pfRemain : Uint64;
pfDivCnt : Uint32;
pfMaxIdx : Uint32;
pfpotPrimIdx : array[0..9] of word;
pfpotMax : array[0..11] of byte;
end;
tpPrimeFac = ^tprimeFac;
 
tPrimeDecompField = array[0..SizePrDeFe-1] of tprimeFac;
tPrimes = array[0..65535] of Uint32;
 
var
{$ALIGN 8}
SmallPrimes: tPrimes;
{$ALIGN 32}
PrimeDecompField :tPrimeDecompField;
pdfIDX,pdfOfs: NativeInt;
 
procedure InitSmallPrimes;
//get primes. #0..65535.Sieving only odd numbers
const
MAXLIMIT = (821641-1) shr 1;
var
pr : array[0..MAXLIMIT] of byte;
p,j,d,flipflop :NativeUInt;
Begin
SmallPrimes[0] := 2;
fillchar(pr[0],SizeOf(pr),#0);
p := 0;
repeat
repeat
p +=1
until pr[p]= 0;
j := (p+1)*p*2;
if j>MAXLIMIT then
BREAK;
d := 2*p+1;
repeat
pr[j] := 1;
j += d;
until j>MAXLIMIT;
until false;
 
SmallPrimes[1] := 3;
SmallPrimes[2] := 5;
j := 3;
d := 7;
flipflop := (2+1)-1;//7+2*2,11+2*1,13,17,19,23
p := 3;
repeat
if pr[p] = 0 then
begin
SmallPrimes[j] := d;
inc(j);
end;
d += 2*flipflop;
p+=flipflop;
flipflop := 3-flipflop;
until (p > MAXLIMIT) OR (j>High(SmallPrimes));
end;
 
function OutPots(pD:tpPrimeFac;n:NativeInt):Ansistring;
var
s: String[31];
chk,p,i: NativeInt;
Begin
str(n,s);
result := Format('%15s : ',[Numb2USA(s)]);
 
with pd^ do
begin
chk := 1;
For n := 0 to pfMaxIdx-1 do
Begin
if n>0 then
result += '*';
p := SmallPrimes[pfpotPrimIdx[n]];
chk *= p;
str(p,s);
result += s;
i := pfpotMax[n];
if i >1 then
Begin
str(pfpotMax[n],s);
result += '^'+s;
repeat
chk *= p;
dec(i);
until i <= 1;
end;
 
end;
p := pfRemain;
If p >1 then
Begin
str(p,s);
chk *= p;
result += '*'+s;
end;
end;
end;
 
function CnvtoBASE(var dgt:tDigits;n:Uint64;base:NativeUint):NativeInt;
//n must be multiple of base aka n mod base must be 0
var
q,r: Uint64;
i : NativeInt;
Begin
fillchar(dgt,SizeOf(dgt),#0);
i := 0;
n := n div base;
result := 0;
repeat
r := n;
q := n div base;
r -= q*base;
n := q;
dgt[i] := r;
inc(i);
until (q = 0);
//searching lowest pot in base
result := 0;
while (result<i) AND (dgt[result] = 0) do
inc(result);
inc(result);
end;
 
function IncByBaseInBase(var dgt:tDigits;base:NativeInt):NativeInt;
var
q :NativeInt;
Begin
result := 0;
q := dgt[result]+1;
if q = base then
repeat
dgt[result] := 0;
inc(result);
q := dgt[result]+1;
until q <> base;
dgt[result] := q;
result +=1;
end;
 
function SieveOneSieve(var pdf:tPrimeDecompField):boolean;
var
dgt:tDigits;
i,j,k,pr,fac,n,MaxP : Uint64;
begin
n := pdfOfs;
if n+SizePrDeFe >= sqr(SmallPrimes[High(SmallPrimes)]) then
EXIT(FALSE);
//init
for i := 0 to SizePrDeFe-1 do
begin
with pdf[i] do
Begin
pfDivCnt := 1;
pfSumOfDivs := 1;
pfRemain := n+i;
pfMaxIdx := 0;
pfpotPrimIdx[0] := 0;
pfpotMax[0] := 0;
end;
end;
//first factor 2. Make n+i even
i := (pdfIdx+n) AND 1;
IF (n = 0) AND (pdfIdx<2) then
i := 2;
 
repeat
with pdf[i] do
begin
j := BsfQWord(n+i);
pfMaxIdx := 1;
pfpotPrimIdx[0] := 0;
pfpotMax[0] := j;
pfRemain := (n+i) shr j;
pfSumOfDivs := (Uint64(1) shl (j+1))-1;
pfDivCnt := j+1;
end;
i += 2;
until i >=SizePrDeFe;
//i now index in SmallPrimes
i := 0;
maxP := trunc(sqrt(n+SizePrDeFe))+1;
repeat
//search next prime that is in bounds of sieve
if n = 0 then
begin
repeat
inc(i);
pr := SmallPrimes[i];
k := pr-n MOD pr;
if k < SizePrDeFe then
break;
until pr > MaxP;
end
else
begin
repeat
inc(i);
pr := SmallPrimes[i];
k := pr-n MOD pr;
if (k = pr) AND (n>0) then
k:= 0;
if k < SizePrDeFe then
break;
until pr > MaxP;
end;
 
//no need to use higher primes
if pr*pr > n+SizePrDeFe then
BREAK;
 
//j is power of prime
j := CnvtoBASE(dgt,n+k,pr);
repeat
with pdf[k] do
Begin
pfpotPrimIdx[pfMaxIdx] := i;
pfpotMax[pfMaxIdx] := j;
pfDivCnt *= j+1;
fac := pr;
repeat
pfRemain := pfRemain DIV pr;
dec(j);
fac *= pr;
until j<= 0;
pfSumOfDivs *= (fac-1)DIV(pr-1);
inc(pfMaxIdx);
k += pr;
j := IncByBaseInBase(dgt,pr);
end;
until k >= SizePrDeFe;
until false;
 
//correct sum of & count of divisors
for i := 0 to High(pdf) do
Begin
with pdf[i] do
begin
j := pfRemain;
if j <> 1 then
begin
pfSumOFDivs *= (j+1);
pfDivCnt *=2;
end;
end;
end;
result := true;
end;
 
function NextSieve:boolean;
begin
dec(pdfIDX,SizePrDeFe);
inc(pdfOfs,SizePrDeFe);
result := SieveOneSieve(PrimeDecompField);
end;
 
function GetNextPrimeDecomp:tpPrimeFac;
begin
if pdfIDX >= SizePrDeFe then
if Not(NextSieve) then
EXIT(NIL);
result := @PrimeDecompField[pdfIDX];
inc(pdfIDX);
end;
 
function Init_Sieve(n:NativeUint):boolean;
//Init Sieve pdfIdx,pdfOfs are Global
begin
pdfIdx := n MOD SizePrDeFe;
pdfOfs := n-pdfIdx;
result := SieveOneSieve(PrimeDecompField);
end;
 
var
s,pr : string[31];
pPrimeDecomp :tpPrimeFac;
 
T0:Int64;
n,i,cnt : NativeUInt;
checked : boolean;
Begin
InitSmallPrimes;
 
T0 := GetTickCount64;
cnt := 0;
n := 0;
Init_Sieve(n);
repeat
pPrimeDecomp:= GetNextPrimeDecomp;
with pPrimeDecomp^ do
begin
//composite with smallest factor 11
if (pfDivCnt>=4) AND (pfpotPrimIdx[0]>3) then
begin
str(n,s);
for i := 0 to pfMaxIdx-1 do
begin
str(smallprimes[pfpotPrimIdx[i]],pr);
checked := (pos(pr,s)>0);
if Not(checked) then
Break;
end;
if checked then
begin
//writeln(cnt:4,OutPots(pPrimeDecomp,n));
if pfRemain >1 then
begin
str(pfRemain,pr);
checked := (pos(pr,s)>0);
end;
if checked then
begin
inc(cnt);
writeln(cnt:4,OutPots(pPrimeDecomp,n));
end;
end;
end;
end;
inc(n);
until n > 28118827;//10*1000*1000*1000+1;//
T0 := GetTickCount64-T0;
writeln('runtime ',T0/1000:0:3,' s');
end.
 
@TIO.RUN:
Real time: 2.166 s CPU share: 99.20 %//500*1000*1000 Real time: 38.895 s CPU share: 99.28 %
   1         15,317 : 17^2*53
   2         59,177 : 17*59^2
   3         83,731 : 31*37*73
   4        119,911 : 11^2*991
   5        183,347 : 47^2*83
   6        192,413 : 13*19^2*41
   7      1,819,231 : 19*23^2*181
   8      2,111,317 : 13^3*31^2
   9      2,237,411 : 11^3*41^2
  10      3,129,361 : 29^2*61^2
  11      5,526,173 : 17*61*73^2
  12     11,610,313 : 11^4*13*61
  13     13,436,683 : 13^2*43^3
  14     13,731,373 : 73*137*1373
  15     13,737,841 : 13^5*37
  16     13,831,103 : 11*13*311^2
  17     15,813,251 : 251^3
  18     17,692,313 : 23*769231
  19     19,173,071 : 19^2*173*307
  20     28,118,827 : 11^2*281*827
runtime 2.011 s

//@home til 1E10 ..  188  9,898,707,359 : 59^2*89^2*359
  21     31,373,137 : 73*137*3137
  22     47,458,321 : 83^4
  23     55,251,877 : 251^2*877
  24     62,499,251 : 251*499^2
  25     79,710,361 : 103*797*971
  26     81,227,897 : 89*97^3
  27     97,337,269 : 37^2*97*733
  28    103,192,211 : 19^2*31*9221
  29    107,132,311 : 11^2*13^4*31
  30    119,503,483 : 11*19*83^3
  31    119,759,299 : 11*19*29*19759
  32    124,251,499 : 499^3
  33    131,079,601 : 107^4
  34    142,153,597 : 59^2*97*421
  35    147,008,443 : 43^5
  36    171,197,531 : 17^2*31*97*197
  37    179,717,969 : 71*79*179^2
  38    183,171,409 : 71*1409*1831
  39    215,797,193 : 19*1579*7193
  40    241,153,517 : 11*17*241*5351
  41    248,791,373 : 73*373*9137
  42    261,113,281 : 11^2*13^2*113^2
  43    272,433,191 : 19*331*43319
  44    277,337,147 : 71*73^2*733
  45    291,579,719 : 19*1579*9719
  46    312,239,471 : 31^3*47*223
  47    344,972,429 : 29*3449^2
  48    364,181,311 : 13^4*41*311
  49    381,317,911 : 13^6*79
  50    385,494,799 : 47^4*79
  51    392,616,923 : 23^5*61
  52    399,311,341 : 11*13^4*31*41
  53    410,963,311 : 11^2*31*331^2
  54    413,363,353 : 13^4*41*353
  55    423,564,751 : 751^3
  56    471,751,831 : 31*47^2*83^2
  57    492,913,739 : 73*739*9137
  58    501,225,163 : 163*251*12251
  59    591,331,169 : 11*13^2*31^2*331
  60    592,878,929 : 29^2*89^3
  61    594,391,193 : 11*19^2*43*59^2
  62    647,959,343 : 47^3*79^2
  63    717,528,911 : 11^2*17^4*71
  64    723,104,383 : 23^2*43*83*383
  65    772,253,089 : 53^2*89*3089
  66    799,216,219 : 79^3*1621
  67    847,253,389 : 53^2*89*3389
  68    889,253,557 : 53^2*89*3557
  69    889,753,559 : 53^2*89*3559
  70    892,753,571 : 53^2*89*3571
  71    892,961,737 : 17^2*37^3*61
  72    895,253,581 : 53^2*89*3581
  73    895,753,583 : 53^2*89*3583
  74    898,253,593 : 53^2*89*3593
  75    972,253,889 : 53^2*89*3889
  76    997,253,989 : 53^2*89*3989
  77  1,005,371,999 : 53^2*71^3
  78  1,011,819,919 : 11*101*919*991
  79  1,019,457,337 : 37^2*73*101^2
  80  1,029,761,609 : 29^2*761*1609
  81  1,031,176,157 : 11^2*17*31*103*157
  82  1,109,183,317 : 11*31^2*317*331
  83  1,119,587,711 : 11^2*19^4*71
  84  1,137,041,971 : 13^4*41*971
  85  1,158,169,331 : 11*31^2*331^2
  86  1,161,675,547 : 47^3*67*167
  87  1,189,683,737 : 11^5*83*89
  88  1,190,911,909 : 11*9091*11909
  89  1,193,961,571 : 11^3*571*1571
  90  1,274,418,211 : 11*41^5
  91  1,311,979,279 : 13^2*19*131*3119
  92  1,316,779,217 : 13^2*17*677^2
  93  1,334,717,327 : 47*73^4
  94  1,356,431,947 : 13*43^2*56431
  95  1,363,214,333 : 13^3*433*1433
  96  1,371,981,127 : 11^2*19*37*127^2
  97  1,379,703,847 : 47^3*97*137
  98  1,382,331,137 : 11*31*37*331^2
  99  1,389,214,193 : 41*193*419^2
 100  1,497,392,977 : 97*3929^2
 101  1,502,797,333 : 733^2*2797
 102  1,583,717,977 : 17^2*71*79*977
 103  1,593,519,731 : 59*5197^2
 104  1,713,767,399 : 17^6*71
 105  1,729,719,587 : 17*19^2*29*9719
 106  1,733,793,487 : 79^2*379*733
 107  1,761,789,373 : 17^2*37^2*61*73
 108  1,871,688,013 : 13^5*71^2
 109  1,907,307,719 : 71^3*73^2
 110  1,948,441,249 : 1249^3
 111  1,963,137,527 : 13*31^3*37*137
 112  1,969,555,417 : 17*41^5
 113  1,982,119,441 : 211^4
 114  1,997,841,197 : 11*97^3*199
 115  2,043,853,681 : 53^2*853^2
 116  2,070,507,919 : 19^2*79^2*919
 117  2,073,071,593 : 73^5
 118  2,278,326,179 : 17*83*617*2617
 119  2,297,126,743 : 29^3*97*971
 120  2,301,131,209 : 13^4*23*31*113
 121  2,323,519,823 : 19^2*23^5
 122  2,371,392,959 : 13^2*29*59^2*139
 123  2,647,985,311 : 31*47*53^2*647
 124  2,667,165,611 : 11^5*16561
 125  2,722,413,361 : 241*3361^2
 126  2,736,047,519 : 19^2*47^3*73
 127  2,881,415,311 : 31^3*311^2
 128  2,911,317,539 : 13^2*31*317*1753
 129  2,924,190,611 : 19^3*29*61*241
 130  3,015,962,419 : 41*419^3
 131  3,112,317,013 : 13^2*23^2*31*1123
 132  3,131,733,761 : 13^2*17^2*37*1733
 133  3,150,989,441 : 41*509*150989
 134  3,151,811,881 : 31^2*1811^2
 135  3,423,536,177 : 17*23^2*617^2
 136  3,461,792,569 : 17^2*3461^2
 137  3,559,281,161 : 281*3559^2
 138  3,730,774,997 : 499*997*7499
 139  3,795,321,361 : 13*37*53^4
 140  3,877,179,289 : 71^2*877^2
 141  4,070,131,949 : 13^2*19*31^2*1319
 142  4,134,555,661 : 41^2*61^2*661
 143  4,143,189,277 : 31*41^2*43^3
 144  4,162,322,419 : 19^5*41^2
 145  4,311,603,593 : 11*43^2*59*3593
 146  4,339,091,119 : 11*4339*90911
 147  4,340,365,711 : 11^3*571*5711
 148  4,375,770,311 : 11^4*31^2*311
 149  4,427,192,717 : 17*19*71^2*2719
 150  4,530,018,503 : 503*3001^2
 151  4,541,687,137 : 13*37*41^3*137
 152  4,541,938,631 : 41*419^2*631
 153  4,590,757,613 : 13*613*757*761
 154  4,750,104,241 : 41^6
 155  4,796,438,239 : 23^3*479*823
 156  4,985,739,599 : 59*8573*9857
 157  5,036,760,823 : 23^3*503*823
 158  5,094,014,879 : 79*401^3
 159  5,107,117,543 : 11^4*17^3*71
 160  5,137,905,383 : 13^2*53^2*79*137
 161  5,181,876,331 : 31^5*181
 162  5,276,191,811 : 11^5*181^2
 163  5,319,967,909 : 19*53^2*99679
 164  5,411,964,371 : 11*41^2*541^2
 165  5,445,241,447 : 41^5*47
 166  5,892,813,173 : 13^3*17^2*9281
 167  6,021,989,371 : 19^3*937^2
 168  6,122,529,619 : 19*29^2*619^2
 169  6,138,239,333 : 23^3*613*823
 170  6,230,438,329 : 23*29^4*383
 171  6,612,362,989 : 23^4*23629
 172  6,645,125,311 : 11^8*31
 173  7,155,432,157 : 43^2*157^3
 174  7,232,294,717 : 17*29^2*47^2*229
 175  7,293,289,141 : 29*41^4*89
 176  7,491,092,411 : 11*41^4*241
 177  8,144,543,377 : 433*4337^2
 178  8,194,561,699 : 19*4561*94561
 179  8,336,743,231 : 23^4*31^3
 180  8,413,553,317 : 13*17*53^2*13553
 181  8,435,454,179 : 17*43^3*79^2
 182  8,966,127,229 : 29^2*127^2*661
 183  9,091,190,911 : 11*9091*90911
 184  9,373,076,171 : 37^2*937*7307
 185  9,418,073,141 : 31*41^2*180731
 186  9,419,992,843 : 19^4*41^2*43
 187  9,523,894,717 : 17^3*23*89*947
 188  9,898,707,359 : 59^2*89^2*359
runtime 539.800 s

Perl[edit]

Translation of: Raku
Library: ntheory
 use strict;
use warnings;
use ntheory qw<is_prime factor gcd>;
 
my($values,$cnt);
LOOP: for (my $k = 11; $k < 1E10; $k += 2) {
next if 1 < gcd($k,2*3*5*7) or is_prime $k;
map { next if index($k, $_) < 0 } factor $k;
$values .= sprintf "%10d", $k;
last LOOP if ++$cnt == 20;
}
print $values =~ s/.{1,100}\K/\n/gr;
Output:
     15317     59177     83731    119911    183347    192413   1819231   2111317   2237411   3129361
   5526173  11610313  13436683  13731373  13737841  13831103  15813251  17692313  19173071  28118827

Phix[edit]

Translation of: Wren
with javascript_semantics
integer count = 0, n = 11*11,
        limit = iff(platform()=JS?10:20)
atom t0 = time(), t1 = time()
while count<limit do
    if gcd(n,3*5*7)=1 then
        sequence f = prime_factors(n,true,-1)
        if length(f)>1 then
            string s = sprintf("%d",n)
            bool valid = true
            for i=1 to length(f) do
                if (i=1 or f[i]!=f[i-1])
                and not match(sprintf("%d",f[i]),s) then
                    valid = false
                    exit
                end if
            end for
            if valid then
                count += 1
                string t = join(apply(f,sprint),"x"),
                       e = elapsed(time()-t1)
                printf(1,"%2d: %,10d = %-17s (%s)\n",{count,n,t,e})
                t1 = time()
            end if
        end if
    end if
    n += 2
end while
printf(1,"Total time:%s\n",{elapsed(time()-t0)})
Output:

(As usual, limiting to the first 10 under pwa/p2js keeps the time staring at a blank screen under 10s)

 1:     15,317 = 17x17x53          (0s)
 2:     59,177 = 17x59x59          (0.1s)
 3:     83,731 = 31x37x73          (0.0s)
 4:    119,911 = 11x11x991         (0.0s)
 5:    183,347 = 47x47x83          (0.1s)
 6:    192,413 = 13x19x19x41       (0.0s)
 7:  1,819,231 = 19x23x23x181      (3.5s)
 8:  2,111,317 = 13x13x13x31x31    (0.7s)
 9:  2,237,411 = 11x11x11x41x41    (0.4s)
10:  3,129,361 = 29x29x61x61       (2.6s)
11:  5,526,173 = 17x61x73x73       (7.5s)
12: 11,610,313 = 11x11x11x11x13x61 (23.2s)
13: 13,436,683 = 13x13x43x43x43    (7.9s)
14: 13,731,373 = 73x137x1373       (1.3s)
15: 13,737,841 = 13x13x13x13x13x37 (0.0s)
16: 13,831,103 = 11x13x311x311     (0.4s)
17: 15,813,251 = 251x251x251       (8.9s)
18: 17,692,313 = 23x769231         (9.0s)
19: 19,173,071 = 19x19x173x307     (7.1s)
20: 28,118,827 = 11x11x281x827     (46.2s)
Total time:1 minute and 59s

slightly faster[edit]

Translation of: XPL0

The obvious problem with the above is that prime_factors() quite literally does not know when to quit. Output as above, except Total time is reduced to 47s.

with javascript_semantics
integer count = 0, n = 11*11,
        limit = iff(platform()=JS?10:20)
atom t0 = time(), t1 = time()
while count<limit do
    string s = sprintf("%d",n)
    integer l = floor(sqrt(n)), k = n, f = 3
    bool valid = true
    while true do
        if remainder(k,f)=0 then
            if f<10 or not match(sprintf("%d",f),s) then
                valid = false
                exit
            end if
            if f=k then exit end if
            k /= f
        else
            f += 2
            if f>l then
                if k=n or not match(sprintf("%d",k),s) then
                    valid = false
                end if
                exit
            end if
        end if
    end while
    if valid then
        count += 1;
        string t = join(apply(prime_factors(n,true,-1),sprint),"x"),
               e = elapsed(time()-t1)
        printf(1,"%2d: %,10d = %-17s (%s)\n",{count,n,t,e})
        t1 = time()
    end if
    n += 2
end while
printf(1,"Total time:%s\n",{elapsed(time()-t0)})

Raku[edit]

use Prime::Factor;
use Lingua::EN::Numbers;
 
put (2..).hyper(:5000batch).map( {
next if (1 < $_ gcd 210) || .is-prime || any .&prime-factors.map: -> $n { !.contains: $n };
$_
} )[^20].batch(10)».&comma».fmt("%10s").join: "\n";
Output:
    15,317     59,177     83,731    119,911    183,347    192,413  1,819,231  2,111,317  2,237,411  3,129,361
 5,526,173 11,610,313 13,436,683 13,731,373 13,737,841 13,831,103 15,813,251 17,692,313 19,173,071 28,118,827

Sidef[edit]

var e = Enumerator({|f|
 
var c = (9.primorial)
var a = (1..c -> grep { .is_coprime(c) })
 
loop {
var n = a.shift
 
a.push(n + c)
n.is_composite || next
 
f(n) if n.factor.all {|p| Str(n).contains(p) }
}
})
 
var count = 10
 
e.each {|n|
say n
break if (--count <= 0)
}
Output:
15317
59177
83731
119911
183347
192413
1819231
2111317
2237411
3129361

Wren[edit]

Library: Wren-math
Library: Wren-seq
Library: Wren-fmt
import "/math" for Int
import "/seq" for Lst
import "/fmt" for Fmt
 
var count = 0
var k = 11 * 11
var res = []
while (count < 20) {
if (k % 3 == 0 || k % 5 == 0 || k % 7 == 0) {
k = k + 2
continue
}
var factors = Int.primeFactors(k)
if (factors.count > 1) {
Lst.prune(factors)
var s = k.toString
var includesAll = true
for (f in factors) {
if (s.indexOf(f.toString) == -1) {
includesAll = false
break
}
}
if (includesAll) {
res.add(k)
count = count + 1
}
}
k = k + 2
}
Fmt.print("$,10d", res[0..9])
Fmt.print("$,10d", res[10..19])
Output:
    15,317     59,177     83,731    119,911    183,347    192,413  1,819,231  2,111,317  2,237,411  3,129,361
 5,526,173 11,610,313 13,436,683 13,731,373 13,737,841 13,831,103 15,813,251 17,692,313 19,173,071 28,118,827

XPL0[edit]

Runs in 33.6 seconds on Raspberry Pi 4.

include xpllib;         \for ItoA, StrFind and RlOutC
int K, C;
 
proc Factor; \Show certain K factors
int L, N, F, Q;
char SA(10), SB(10);
[ItoA(K, SB);
L:= sqrt(K); \limit for speed
N:= K; F:= 3;
if (N&1) = 0 then return; \reject if 2 is a factor
loop [Q:= N/F;
if rem(0) = 0 then \found a factor, F
[if F < 10 then return; \reject if too small (3, 5, 7)
ItoA(F, SA); \reject if not a sub-string
if StrFind(SB, SA) = 0 then return;
N:= Q;
if F>N then quit; \all factors found
]
else [F:= F+2; \try next prime factor
if F>L then
[if N=K then return; \reject prime K
ItoA(N, SA); \ (it's not composite)
if StrFind(SB, SA) = 0 then return;
quit; \passed all restrictions
];
];
];
Format(9, 0);
RlOutC(0, float(K));
C:= C+1;
if rem(C/10) = 0 then CrLf(0);
];
 
[C:= 0; \initialize element counter
K:= 11*11; \must have at least two 2-digit composites
repeat Factor;
K:= K+2; \must be odd because all factors > 2 are odd primes
until C >= 20;
]
Output:
     15,317     59,177     83,731    119,911    183,347    192,413  1,819,231  2,111,317  2,237,411  3,129,361
  5,526,173 11,610,313 13,436,683 13,731,373 13,737,841 13,831,103 15,813,251 17,692,313 19,173,071 28,118,827