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

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


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


Stretch
  • Find and show the next ten elements.



ALGOL 68Edit

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

ArturoEdit

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

GoEdit

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 

JEdit

  */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.

JuliaEdit

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

Mathematica/Wolfram LanguageEdit

ClearAll[CompositeAndContainsPrimeFactor]
CompositeAndContainsPrimeFactor[k_Integer] := Module[{id, pf},
  If[CompositeQ[k],
   pf = FactorInteger[k][[All, 1]];
   If[AllTrue[pf, GreaterThan[10]],
    id = IntegerDigits[k];
    AllTrue[pf, SequenceCount[id, IntegerDigits[#]] > 0 &]
    ,
    False
    ]
   ,
   False
   ]
  ]
out = Select[Range[30000000], CompositeAndContainsPrimeFactor]
Output:
{15317, 59177, 83731, 119911, 183347, 192413, 1819231, 2111317, 2237411, 3129361, 5526173, 11610313, 13436683, 13731373, 13737841, 13831103, 15813251, 17692313, 19173071, 28118827}

PascalEdit

Free PascalEdit

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

PerlEdit

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

PhixEdit

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 fasterEdit

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)})

PythonEdit

from sympy import isprime, factorint

def contains_its_prime_factors_all_over_7(n):
    if n < 10 or isprime(n):
        return False
    strn = str(n)
    pfacs = factorint(n).keys()
    return all(f > 9 and str(f) in strn for f in pfacs)

found = 0
for n in range(1_000_000_000):
    if contains_its_prime_factors_all_over_7(n):
        found += 1
        print(f'{n: 12,}', end = '\n' if found % 10 == 0 else '')
        if found == 20:
            break
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

RakuEdit

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

SidefEdit

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

WrenEdit

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

XPL0Edit

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