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 

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 

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

C 

#include <stdio.h>
#include <stdbool.h>

bool is_substring(unsigned n, unsigned k) {
    unsigned startMatch = 0;

    for (unsigned pfx = k; n > 0; n /= 10) {
        if (pfx % 10 == n % 10) {
            pfx /= 10;
            if (startMatch == 0) startMatch = n;
        } else {
            pfx = k;
            if (startMatch != 0) n = startMatch;
            startMatch = 0;
        }

        if (pfx == 0) return true;
    }
    return false;
}

bool factors_are_substrings(unsigned n) {
    if (n%2==0 || n%3==0 || n%5==0 || n%7==0) return false;

    unsigned factor_count = 0;
    for (unsigned factor = 11, n_rest = n; factor <= n_rest; factor += 2) {
        if (n_rest % factor != 0) continue;
        while (n_rest % factor == 0) n_rest /= factor;
        if (!is_substring(n, factor)) return false;
        factor_count++;
    }
    return factor_count > 1;
}

int main(void) {
    unsigned amount = 10;
    for (unsigned n = 11; amount > 0; n += 2) {
        if (factors_are_substrings(n)) {
            printf("%u\n", n);
            amount--;
        }
    }
    return 0;
}
Output:
15317
59177
83731
119911
183347
192413
1819231
2111317
2237411
3129361

C++ 

#include <algorithm>
#include <cstdint>
#include <iostream>
#include <string>
#include <unordered_set>
#include <vector>

std::vector<uint32_t> primes;

void sieve_primes(const uint32_t& limit) {
	std::vector<bool> marked_prime(limit + 1, true);

	for ( uint32_t p = 2; p * p <= limit; ++p ) {
		if ( marked_prime[p] ) {
			for ( uint32_t i = p * p; i <= limit; i += p ) {
				marked_prime[i] = false;
			}
		}
	}

	for ( uint32_t p = 2; p <= limit; ++p ) {
		if ( marked_prime[p] ) {
			primes.emplace_back(p);
		}
	}
}

bool is_substring(const uint32_t& k, const uint32_t& factor) {
	const std::string string_k = std::to_string(k);
	const std::string string_factor = std::to_string(factor);
	return string_k.find(string_factor) != std::string::npos;
}

int main() {
	sieve_primes(30'000'000);

	std::unordered_set<uint32_t> distinct_factors;
	std::vector<uint32_t> result;
	uint32_t k = 11 * 11;

	while ( result.size() < 10 ) {
		while ( k % 3 == 0 || k % 5 == 0 || k % 7 == 0 ) {
			k += 2;
		}

		distinct_factors.clear();
		uint32_t copy_k = k;
		uint32_t index = 4;

		while ( copy_k > 1 ) {
			while ( copy_k % primes[index] == 0 ) {
				distinct_factors.insert(primes[index]);
				copy_k /= primes[index];
			}
			index += 1;
		}

		if ( distinct_factors.size() > 1 ) {
			if ( std::all_of(distinct_factors.begin(), distinct_factors.end(),
					[&k](uint32_t factor) { return is_substring(k, factor); }) ) {
				result.emplace_back(k);
			}
		}

		k += 2;
	}

	for ( uint64_t i = 0; i < result.size(); ++i ) {
		std::cout << result[i] << "  ";
	}
	std::cout << std::endl;
}
Output:
15317  59177  83731  119911  183347  192413  1819231  2111317  2237411  3129361

Delphi

Works with: Delphi version 6.0
Library: SysUtils,StdCtrls

Brute force method with a few obvious optimizations. Could be speeded up a lot, with some work. 

procedure MultidigitComposites(Memo: TMemo);
var I,Cnt: integer;
var IA: TIntegerDynArray;
var Sieve: TPrimeSieve;


	function MatchCriteria(N: integer): boolean;
	{Test N against Criteria}
	var I,L: integer;
	var SN,ST: string;
	begin
	Result:=False;
	{No even numbers}
	if (N and 1)=0 then exit;
	{N can't be prime}
	if Sieve[N] then exit;
	I:=3;
	SN:=IntToStr(N);
	repeat
		begin
		{Is it a factor }
		if (N mod I) = 0 then
			begin
			{No one-digit numbers}
			if I<10 then exit;
			{Factor string must be found in N's string}
			ST:=IntToStr(I);
			if Pos(ST,SN)<1 then exit;
			N:=N div I;
			end
		else I:=I+2;
		end
	until N<=1;
	Result:=True;
	end;


begin
Sieve:=TPrimeSieve.Create;
try
{Create 30 million primes}
Sieve.Intialize(30000000);
Cnt:=0;
{Smallest prime factor}
I:=11*11;
while I<High(integer) do
	begin
	{Test if I matches criteria}
	 if MatchCriteria(I) then
		begin
		Inc(Cnt);
		Memo.Lines.Add(IntToStr(Cnt)+' - '+FloatToStrF(I,ffNumber,18,0));
		if Cnt>=20 then break;
		end;
	Inc(I,2);
	end;
finally Sieve.Free; end;
end;
Output:
1 - 15,317
2 - 59,177
3 - 83,731
4 - 119,911
5 - 183,347
6 - 192,413
7 - 1,819,231
8 - 2,111,317
9 - 2,237,411
10 - 3,129,361
11 - 5,526,173
12 - 11,610,313
13 - 13,436,683
14 - 13,731,373
15 - 13,737,841
16 - 13,831,103
17 - 15,813,251
18 - 17,692,313
19 - 19,173,071
20 - 28,118,827
Elapsed Time: 02:39.291 min

EasyLang

Translation of: C

(optimized) 

fastfunc isin n k .
   h = k
   while n > 0
      if h mod 10 = n mod 10
         h = h div 10
         if match = 0
            match = n
         .
      else
         h = k
         if match <> 0
            n = match
         .
         match = 0
      .
      if h = 0
         return 1
      .
      n = n div 10
   .
   return 0
.

fastfunc test n .
   if n mod 2 = 0 or n mod 3 = 0 or n mod 5 = 0 or n mod 7 = 0
      return 0
   .
   rest = n
   fact = 11
   while fact <= rest
      if rest mod fact = 0
         while rest mod fact = 0
            rest /= fact
         .
         if isin  n fact = 0
            return 0
         .
         nfacts += 1
      .
      fact += 2
      if fact > sqrt n and nfacts = 0
         return 0
      .
   .
   if nfacts > 1
      return 1
   .
   return 0
.
n = 11
while count < 10
   if test n = 1
      print n
      count += 1
   .
   n += 2
.

F#

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

FreeBASIC

Translation of: ALGOL 68
Function isSubstring(kStr As String, f As Integer) As Integer
    Dim As String fStr = Str(f)
    Dim As Integer fLen = Len(fStr)
    Dim As Integer result = 0
    Dim As Integer fEnd = Len(kStr) - fLen + 1
    For fPos As Integer = 1 To Len(kStr) - fLen + 1
        If Mid(kStr, fPos, fLen) = fStr Then
            result = -1
            Exit For
        End If
    Next fPos
    Return result
End Function

Dim As Integer requiredNumbers = 20
Dim As Integer kCount = 0
For k As Integer = 11 To 99999999 Step 2
    If k Mod 3 <> 0 And k Mod 5 <> 0 And k Mod 7 <> 0 Then
        Dim As Integer isCandidate = -1
        Dim As String kStr = Str(k)
        Dim As Integer v = k
        Dim As Integer fCount = 0
        For f As Integer = 11 To Sqr(k) + 1
            If v Mod f = 0 Then
                isCandidate = isSubstring(kStr, f)
                If isCandidate Then
                    While v Mod f = 0
                        fCount += 1
                        v \= f
                    Wend
                Else
                    Exit For
                End If
            End If
        Next f
        If isCandidate And (fCount > 1 Or (v <> k And v > 1)) Then
            If v > 1 Then isCandidate = isSubstring(kStr, v)
            If isCandidate Then
                Print Using "#######,###"; k;
                kCount += 1
                If kCount Mod 10 = 0 Then Print
            End If
        End If
    End If
    If kCount >= requiredNumbers Then Exit For
Next k
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

Go

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 

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

Java 

import java.math.BigInteger;
import java.util.ArrayList;
import java.util.Collections;
import java.util.List;
import java.util.concurrent.ThreadLocalRandom;

public final class CompositeNumbersK {

	public static void main(String[] aArgs) {
		int k = 11 * 11;
		List<Integer> result = new ArrayList<Integer>();
		while ( result.size() < 20 ) {
		    while ( k % 3 == 0 || k % 5 == 0 || k % 7 == 0 ) {
		        k += 2;
		    }
		    
		    List<Integer> factors = primeFactors(k);
    	    if ( factors.size() > 1 ) {
    	        String stringK = String.valueOf(k);
    	        if ( factors.stream().allMatch( factor -> stringK.indexOf(String.valueOf(factor)) >= 0 ) ) {
    	            result.add(k);
    	        }
    	    }
    	    k += 2;		    
		}
		
		for ( int i = 0; i < result.size(); i++ ) {
			System.out.print(String.format("%10d%s", result.get(i), ( i == 9 || i == 19 ? "\n" : "" )));
		}
	}
	
	private static List<Integer> primeFactors(int aK) {		
		List<Integer> result = new ArrayList<Integer>(); 
		if ( aK <= 1 ) { 
			return result;
		}
		
		BigInteger bigK = BigInteger.valueOf(aK);
		if ( bigK.isProbablePrime(CERTAINTY_LEVEL) ) {
			result.add(aK);
			return result;
		}
		
		final int divisor = pollardsRho(bigK).intValueExact();
		result.addAll(primeFactors(divisor));
		result.addAll(primeFactors(aK / divisor));
		Collections.sort(result);
		return result;
	}		
	
	private static BigInteger pollardsRho(BigInteger aN) {
		final BigInteger constant  = new BigInteger(aN.bitLength(), RANDOM);
		BigInteger x  = new BigInteger(aN.bitLength(), RANDOM);
		BigInteger xx = x;
		BigInteger divisor = null;
		
		if ( aN.mod(BigInteger.TWO).signum() == 0 ) {
			return BigInteger.TWO;
		}
		
		do {
			x = x.multiply(x).mod(aN).add(constant).mod(aN);
			xx = xx.multiply(xx).mod(aN).add(constant).mod(aN);
			xx = xx.multiply(xx).mod(aN).add(constant).mod(aN);
			divisor = x.subtract(xx).gcd(aN);
		} while ( divisor.compareTo(BigInteger.ONE) == 0 );
		
		return divisor;
	}	
	
	private static final ThreadLocalRandom RANDOM = ThreadLocalRandom.current();
	private static final int CERTAINTY_LEVEL = 10;

}
Output:
     15317     59177     83731    119911    183347    192413   1819231   2111317   2237411   3129361
   5526173  11610313  13436683  13731373  13737841  13831103  15813251  17692313  19173071  28118827

Julia 

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 Language 

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}

Nim

We use a sieve to build a list of prime factors. This is more efficient than computing the list of prime factors on the fly.

To find the 20 first elements of the sequence, the program takes less than 10 seconds on an Intel Core I5-8250U 4×1.6GHz. 

import std/[strformat, strutils]

const Max = 80_000_000  # Maximal value for composite number.

# Prime factors of odd numbers.
# If a number is prime, its factor list is empty.
var factors: array[0..(Max - 3) div 2, seq[uint32]]

template primeFactors(n: Natural): seq[uint32] =
  factors[(n - 3) shr 1]

# Build the list of factors.
for n in countup(3u32, Max div 11, 2):
  if primeFactors(n).len == 0:
    # "n" is prime.
    for k in countup(n + n + n, Max, 2 * n):
      primeFactors(k).add n

const N = 20  # Number of results.
var n = 11 * 11
var count = 0
while count < N:
  if primeFactors(n).len > 0:
    let nStr = $n
    block Check:
      for f in primeFactors(n):
        if f < 11 or $f notin nStr: break Check
      inc count
      echo &"{count:2}: {insertSep($n)}"
  inc n, 2
Output:
 1: 15_317
 2: 59_177
 3: 83_731
 4: 119_911
 5: 183_347
 6: 192_413
 7: 1_819_231
 8: 2_111_317
 9: 2_237_411
10: 3_129_361
11: 5_526_173
12: 11_610_313
13: 13_436_683
14: 13_731_373
15: 13_737_841
16: 13_831_103
17: 15_813_251
18: 17_692_313
19: 19_173_071
20: 28_118_827

PARI/GP 

/* Returns a substring of str starting at s with length n */
ssubstr(str, s = 1, n = 0) = {
    my(vt = Vecsmall(str), ve, vr, vtn = #str, n1);
    if (vtn == 0, return(""));
    if (s < 1 || s > vtn, return(str));
    n1 = vtn - s + 1; if (n == 0, n = n1); if (n > n1, n = n1);
    ve = vector(n, z, z - 1 + s); vr = vecextract(vt, ve); return(Strchr(vr));
}

/* Checks if subStr is a substring of mainStr */
isSubstring(mainStr, subStr) = {
    mainLen = #Vecsmall(mainStr);
    subLen = #Vecsmall(subStr);
    for (startPos = 1, mainLen - subLen + 1,
        if (ssubstr(mainStr, startPos, subLen) == subStr,
            return(1); /* True: subStr found in mainStr */
        )
    );
    return(0); /* False: subStr not found */
}

/* Determines if a number's factors, all > 9, are substrings of its decimal representation */
contains_its_prime_factors_all_over_9(n) = {
    if (n < 10 || isprime(n), return(0)); /* Skip if n < 10 or n is prime */
    strn = Str(n); /* Convert n to string */
    pfacs = factor(n)[, 1]; /* Get unique prime factors of n */
    for (i = 1, #pfacs,
        if (pfacs[i] <= 9, return(0)); /* Skip factors ≤ 9 */
        if (!isSubstring(strn, Str(pfacs[i])), return(0)); /* Check if factor is a substring */
    );
    return(1); /* All checks passed */
}

/* Main loop to find and print numbers meeting the criteria */
{
    found = 0; /* Counter for numbers found */
    for (n = 0, 30 * 10^6, /* Iterate from 0 to 30 million */
        if (contains_its_prime_factors_all_over_9(n),
            found += 1; /* Increment counter if n meets criteria */
            print1(n, " "); /* Print n followed by a space */
            if (found % 10 == 0, print("")); /* Newline every 10 numbers */
            if (found == 20, break); /* Stop after finding 20 numbers */
        );
    );
}
Output:
    15317    59177    83731   119911   183347   192413  1819231  2111317  2237411  3129361
  5526173 11610313 13436683 13731373 13737841 13831103 15813251 17692313 19173071 28118827

Pascal

Free Pascal

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

PascalABC.NET 

function Factors(n: integer): List<integer>;
begin
  var lst := new List<integer>;
  if n = 1 then  lst.Add(n);
  var i := 2;
  while i * i <= n  do
  begin
    while n mod i = 0 do
    begin
      lst.Add(i);
      n := n div i;
    end;
    i += 1;
  end;
  if n >= 2 then lst.Add(n);
  Result := lst;
end;

function composite(): sequence of integer;
begin
  var n := 11;
  while true do
  begin
    if (n mod 3 <> 0) and (n mod 5 <> 0) and (n mod 7 <> 0) then 
      for var i := 11 to n.Sqrt.floor step 2 do
        if n mod i = 0 then 
        begin
          yield n;
          break;
        end;
    n += 2;
  end;
end;

function allprimesubstr(n: integer): boolean;
begin
  result := true;
  foreach var i in factors(n) do
    if not n.tostring.contains(i.tostring) then 
    begin
      result := false;
      break;
    end;
end;

begin
  composite.where(x -> allprimesubstr(x)).take(20).Println;
  Println('Seconds:',milliseconds/1000);
end.
Output:
15317 59177 83731 119911 183347 192413 1819231 2111317 2237411 3129361 5526173 11610313 13436683 13731373 13737841 13831103 15813251 17692313 19173071 28118827
Seconds: 11.095

Perl

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

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

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

Python 

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

Raku 

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

RPL

Works with: HP version 49
≪ IF DUP ISPRIME? THEN DROP 0 ELSE
    DUP FACTORS DUP SIZE
    ROT →STR → n
    ≪ { }
       1 ROT FOR j
          OVER j GET →STR +                          @ extract prime factors and convert into strings
       2 STEP NIP
       ≪ n SWAP POS ≫ MAP 1 + ΠLIST                 @ + 1 to avoid arror with singletons
    ≫
  END
≫ 'MATRIOSHKA?' STO

≪ 999999999 → max
   ≪ { } 
      11 max FOR j
         IF j 105 GCD 1 == THEN                       @ if no single digit factor
            IF j MATRIOSHKA? THEN 
               j + 
               IF DUP SIZE 6 == THEN max 'j' STO END
            END
         END
      2 STEP
≫ 'TASK' STO
Output:
1: {15317 59177 83731 119911 183347 192413}

Finding the first six numbers takes 4 minutes 20 seconds with an iOS HP-49 emulator, meaning that about two hours would be required to get ten. We're gonna need a bigger boat.

Ruby 

require 'prime'

generator2357 = Enumerator.new do |y|
  gen23 = Prime::Generator23.new
  gen23.each {|n| y << n unless (n%5 == 0 || n%7 == 0) }
end

res = generator2357.lazy.select do |n|
  primes, exp = n.prime_division.transpose
  next if exp.sum < 2 #exclude primes
  s = n.to_s
  primes.all?{|pr| s.match?(-pr.to_s) }
end

res.take(10).each{|n| puts n}
Output:
15317
59177
83731
119911
183347
192413
1819231
2111317
2237411
3129361

Rust 

use primes::{is_prime,factors_uniq};

/// True if non-prime n's factors, all > 9, are all substrings of its representation in base 10
fn contains_its_prime_factors_all_over_7(n: u64) -> bool {
    if n < 10 || is_prime(n) {
        return false;
    }
    let strn = &n.to_string();
    let pfacs = factors_uniq(n);
    return pfacs.iter().all(|f| f > &9 && strn.contains(&f.to_string()));
}

fn main() {
    let mut found = 0;
    // 20 of these < 30 million
    for n in 0..30_000_000 {
        if contains_its_prime_factors_all_over_7(n) {
            found += 1;
            print!("{:12}{}", n, {if found % 10 == 0 {"\n"} else {""}});
            if found == 20 {
                break;
            }
        }
    }
}
Output:
   15317       59177       83731      119911      183347      192413     1819231     2111317     2237411     3129361
 5526173    11610313    13436683    13731373    13737841    13831103    15813251    17692313    19173071    28118827

Scala

for Scala3 

def isComposite(num: Int): Boolean = {
    val numStr = num.toString
    def iter(n: Int, start: Int): Boolean = {
        val limit = math.sqrt(n).floor.toInt
       (start to limit by 2).dropWhile(n % _ > 0).headOption match {
            case Some(v) if v < 10 => false
            case Some(v) => 
                    if (v == start || numStr.contains(v.toString)) iter(n / v, v)
                    else false
            case None => n < num && numStr.contains(n.toString)
        }
    }
    iter(num, 3)
}

def composites = Iterator.from(121, 2).filter(isComposite(_))

@main def main = {
    val start = System.currentTimeMillis
    composites.take(20)
        .grouped(10)
        .foreach(grp => println(grp.map("%8d".format(_)).mkString(" ")))
    val time = System.currentTimeMillis - start
    println(s"time elapsed: $time ms")
}
Output:
   15317    59177    83731   119911   183347   192413  1819231  2111317  2237411  3129361
 5526173 11610313 13436683 13731373 13737841 13831103 15813251 17692313 19173071 28118827
time elapsed: 59821 ms

Sidef 

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

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

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
Retrieved from "https://rosettacode.org/wiki/Composite_numbers_k_with_no_single_digit_factors_whose_factors_are_all_substrings_of_k?oldid=370866"