Product of min and max prime factors

From Rosetta Code
Task
Product of min and max prime factors
You are encouraged to solve this task according to the task description, using any language you may know.

Exactly as the task title implies.


Task
  • Find and display the product of the minimum and maximum prime factors for the terms 1 through 100, inclusive.


For some reason, the term for 1 is defined to be 1
A equal case could be made that it should be 0, undefined, or -∞. ¯\_(ツ)_/¯


See also


11l

Translation of: BASIC
V m = 100
V c = [0B] * (m + 1)

L(p) 2 .. Int(m ^ 0.5)
   L(ci) (p * p .. m).step(p)
      c[ci] = 1B

print(‘ #4’.format(1), end' ‘’)

L(i) 2 .. m
   L(l) 2 .. i
      I !(c[l] | i % l > 0)
         L(h) (i .. 2).step(-1)
            I !(c[h] | i % h > 0)
               print(‘ #4’.format(l * h), end' I i % 10 == 0 {"\n"} E ‘’)
               L(l).break
Output:
    1    4    9    4   25    6   49    4    9   10
  121    6  169   14   15    4  289    6  361   10
   21   22  529    6   25   26    9   14  841   10
  961    4   33   34   35    6 1369   38   39   10
 1681   14 1849   22   15   46 2209    6   49   10
   51   26 2809    6   55   14   57   58 3481   10
 3721   62   21    4   65   22 4489   34   69   14
 5041    6 5329   74   15   38   77   26 6241   10
    9   82 6889   14   85   86   87   22 7921   10
   91   46   93   94   95    6 9409   14   33   10

ALGOL 68

Constructs a tables if min and max prime factors.

BEGIN # find the product of the min and max prime factors of some numbers #
    INT max number = 100; # maximum number we will consider               #
    # sieve the primes to max number                                      #
    [ 0 : max number ]BOOL prime;
    prime[ 0 ] := prime[ 1 ] := FALSE;
    prime[ 2 ] := TRUE;
    FOR i FROM 3 BY 2 TO UPB prime DO prime[ i ] := TRUE  OD;
    FOR i FROM 4 BY 2 TO UPB prime DO prime[ i ] := FALSE OD;
    FOR i FROM 3 BY 2 TO ENTIER sqrt( UPB prime ) DO
        IF prime[ i ] THEN
            FOR s FROM i * i BY i + i TO UPB prime DO prime[ s ] := FALSE OD
        FI
    OD;
    # construct tables of the minimum and maximum prime factors of        #
    # numbers up to max number                                            #
    [ 1 : max number ]INT min pf; FOR i TO UPB min pf DO min pf[ i ] := 0 OD;
    [ 1 : max number ]INT max pf; FOR i TO UPB min pf DO max pf[ i ] := 0 OD;
    min pf[ 1 ] := 1;
    max pf[ 1 ] := 1;
    FOR i TO max number DO
        IF prime[ i ] THEN
            FOR j FROM i BY i TO UPB min pf DO
                IF min pf[ j ] = 0 THEN min pf[ j ] := i FI;
                max pf[ j ] := i
            OD
        FI
    OD;
    # print the products of the min and max prime factors                 #
    FOR i TO max number DO
        print( ( whole( min pf[ i ] * max pf[ i ], -5 ) ) );
        IF i MOD 10 = 0 THEN print( ( newline ) ) FI
    OD
END
Output:
    1    4    9    4   25    6   49    4    9   10
  121    6  169   14   15    4  289    6  361   10
   21   22  529    6   25   26    9   14  841   10
  961    4   33   34   35    6 1369   38   39   10
 1681   14 1849   22   15   46 2209    6   49   10
   51   26 2809    6   55   14   57   58 3481   10
 3721   62   21    4   65   22 4489   34   69   14
 5041    6 5329   74   15   38   77   26 6241   10
    9   82 6889   14   85   86   87   22 7921   10
   91   46   93   94   95    6 9409   14   33   10

AppleScript

Procedural

on isPrime(n)
    if (n < 4) then return (n > 1)
    if ((n mod 2 is 0) or (n mod 3 is 0)) then return false
    repeat with i from 5 to (n ^ 0.5) div 1 by 6
        if ((n mod i is 0) or (n mod (i + 2) is 0)) then return false
    end repeat
    
    return true
end isPrime

on primeFactors(n)
    if (isPrime(n)) then return {n}
    set output to {}
    set sqrt to n ^ 0.5
    if ((sqrt = sqrt div 1) and (isPrime(sqrt))) then
        set end of output to sqrt div 1
        set sqrt to sqrt - 1
    end if
    repeat with i from (sqrt div 1) to 2 by -1
        if (n mod i is 0) then
            if (isPrime(i)) then set beginning of output to i
            if (isPrime(n div i)) then set end of output to n div i
        end if
    end repeat
    
    return output
end primeFactors

on join(lst, delim)
    set astid to AppleScript's text item delimiters
    set AppleScript's text item delimiters to delim
    set txt to lst as text
    set AppleScript's text item delimiters to astid
    return txt
end join

on task()
    set output to {""}
    set thisLine to {"     1"}
    repeat with n from 2 to 100
        tell primeFactors(n) to set product to (its end) * (its beginning)
        set end of thisLine to text -6 thru end of ("     " & product)
        if (n mod 10 is 0) then
            set end of output to join(thisLine, "")
            set thisLine to {}
        end if
    end repeat
    return join(output, linefeed)
end task

task()
Output:
"
     1     4     9     4    25     6    49     4     9    10
   121     6   169    14    15     4   289     6   361    10
    21    22   529     6    25    26     9    14   841    10
   961     4    33    34    35     6  1369    38    39    10
  1681    14  1849    22    15    46  2209     6    49    10
    51    26  2809     6    55    14    57    58  3481    10
  3721    62    21     4    65    22  4489    34    69    14
  5041     6  5329    74    15    38    77    26  6241    10
     9    82  6889    14    85    86    87    22  7921    10
    91    46    93    94    95     6  9409    14    33    10"

Functional

use framework "Foundation"


----------- PRODUCT OF MIN AND MAX PRIME FACTORS ---------

on OEISA066048()
    -- Infinite series of the terms of OEISA066048
    script f
        on |λ|(n)
            set xs to primeFactors(n)
            (item 1 of xs) * (item -1 of xs)
        end |λ|
    end script
    
    cons(1, fmapGen(f, enumFrom(2)))
end OEISA066048


--------------------------- TEST -------------------------
on run
    
    table(10, take(100, OEISA066048()))
    
end run


------------------------- DISPLAY ------------------------

-- table :: Int -> [Int] -> String
on table(n, xs)
    -- A list of strings formatted as
    -- right-justified rows of n columns.
    set w to length of str(maximum(xs))
    unlines(map(my unwords, ¬
        chunksOf(n, ¬
            map(compose(justifyRight(w, space), my str), xs))))
end table


------------------------- GENERIC ------------------------

-- compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
on compose(f, g)
    script
        property mf : mReturn(f)
        property mg : mReturn(g)
        on |λ|(x)
            mf's |λ|(mg's |λ|(x))
        end |λ|
    end script
end compose


-- cons :: a -> [a] -> [a]
on cons(x, xs)
    script
        property pRead : false
        on |λ|()
            if pRead then
                |λ|() of xs
            else
                set pRead to true
                return x
            end if
        end |λ|
    end script
end cons


-- enumFrom :: Enum a => a -> [a]
on enumFrom(x)
    script
        property v : missing value
        property blnNum : class of x is not text
        on |λ|()
            if missing value is not v then
                if blnNum then
                    set v to 1 + v
                else
                    set v to succ(v)
                end if
            else
                set v to x
            end if
            return v
        end |λ|
    end script
end enumFrom


-- fmapGen <$> :: (a -> b) -> Gen [a] -> Gen [b]
on fmapGen(f, gen)
    script
        property g : mReturn(f)
        on |λ|()
            set v to gen's |λ|()
            if v is missing value then
                v
            else
                g's |λ|(v)
            end if
        end |λ|
    end script
end fmapGen


-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    -- 2nd class handler function lifted into 1st class script wrapper. 
    if script is class of f then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn


-- maximum :: Ord a => [a] -> a
on maximum(xs)
    set ca to current application
    unwrap((ca's NSArray's arrayWithArray:xs)'s ¬
        valueForKeyPath:"@max.self")
end maximum


-- primeFactors :: Int -> [Int]
on primeFactors(n)
    -- A list of the prime factors of n.    
    script go
        on |λ|(x)
            set sqroot to (x ^ 0.5) as integer
            if 0 = x mod 2 then
                set {q, r} to {2, 1}
            else
                set {q, r} to {3, 1}
            end if
            
            repeat until (sqroot < q) or (0 = (x mod q))
                set {q, r} to {1 + (r * 4) - (((r / 2) as integer) * 2), 1 + r}
            end repeat
            
            if q > sqroot then
                {x}
            else
                {q} & |λ|((x / q) as integer)
            end if
        end |λ|
    end script
    
    |λ|(n) of go
end primeFactors


-- str :: a -> String
on str(x)
    x as string
end str


-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
    set ys to {}
    repeat with i from 1 to n
        set v to |λ|() of xs
        if missing value is v then
            return ys
        else
            set end of ys to v
        end if
    end repeat
    return ys
end take


-- chunksOf :: Int -> [a] -> [[a]]
on chunksOf(k, xs)
    script
        on go(ys)
            set ab to splitAt(k, ys)
            set a to item 1 of ab
            if {}  a then
                {a} & go(item 2 of ab)
            else
                a
            end if
        end go
    end script
    result's go(xs)
end chunksOf


-- justifyRight :: Int -> Char -> String -> String
on justifyRight(n, cFiller)
    script go
        on |λ|(s)
            if n > length of s then
                text -n thru -1 of ((replicate(n, cFiller) as text) & s)
            else
                s
            end if
        end |λ|
    end script
end justifyRight


-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    -- The list obtained by applying f
    -- to each element of xs.
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map


-- Egyptian multiplication - progressively doubling a list, appending
-- stages of doubling to an accumulator where needed for binary 
-- assembly of a target length
-- replicate :: Int -> String -> String
on replicate(n, s)
    -- Egyptian multiplication - progressively doubling a list, 
    -- appending stages of doubling to an accumulator where needed 
    -- for binary assembly of a target length
    script p
        on |λ|({n})
            n  1
        end |λ|
    end script
    
    script f
        on |λ|({n, dbl, out})
            if (n mod 2) > 0 then
                set d to out & dbl
            else
                set d to out
            end if
            {n div 2, dbl & dbl, d}
        end |λ|
    end script
    
    set xs to |until|(p, f, {n, s, ""})
    item 2 of xs & item 3 of xs
end replicate


-- splitAt :: Int -> [a] -> ([a], [a])
on splitAt(n, xs)
    if n > 0 and n < length of xs then
        if class of xs is text then
            {items 1 thru n of xs as text, ¬
                items (n + 1) thru -1 of xs as text}
        else
            {items 1 thru n of xs, items (n + 1) thru -1 of xs}
        end if
    else
        if n < 1 then
            {{}, xs}
        else
            {xs, {}}
        end if
    end if
end splitAt


-- unlines :: [String] -> String
on unlines(xs)
    -- A single string formed by the intercalation
    -- of a list of strings with the newline character.
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, linefeed}
    set s to xs as text
    set my text item delimiters to dlm
    s
end unlines


-- until :: (a -> Bool) -> (a -> a) -> a -> a
on |until|(p, f, x)
    set v to x
    set mp to mReturn(p)
    set mf to mReturn(f)
    repeat until mp's |λ|(v)
        set v to mf's |λ|(v)
    end repeat
    v
end |until|


-- unwords :: [String] -> String
on unwords(xs)
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, space}
    set s to xs as text
    set my text item delimiters to dlm
    return s
end unwords


-- unwrap :: NSValue -> a
on unwrap(nsValue)
    if nsValue is missing value then
        missing value
    else
        set ca to current application
        item 1 of ((ca's NSArray's arrayWithObject:nsValue) as list)
    end if
end unwrap
Output:
   1    4    9    4   25    6   49    4    9   10
 121    6  169   14   15    4  289    6  361   10
  21   22  529    6   25   26    9   14  841   10
 961    4   33   34   35    6 1369   38   39   10
1681   14 1849   22   15   46 2209    6   49   10
  51   26 2809    6   55   14   57   58 3481   10
3721   62   21    4   65   22 4489   34   69   14
5041    6 5329   74   15   38   77   26 6241   10
   9   82 6889   14   85   86   87   22 7921   10
  91   46   93   94   95    6 9409   14   33   10

Arturo

prints "    1"  ; special case 1 since the result is normally null
                ; for the factors of 1

loop 2..100 'i [
    f: factors.prime i
    prints to :string .format:"5d" mul min f max f
    if 0 = i%10 -> print ""
]
Output:
    1    4    9    4   25    6   49    4    9   10
  121    6  169   14   15    4  289    6  361   10
   21   22  529    6   25   26    9   14  841   10
  961    4   33   34   35    6 1369   38   39   10
 1681   14 1849   22   15   46 2209    6   49   10
   51   26 2809    6   55   14   57   58 3481   10
 3721   62   21    4   65   22 4489   34   69   14
 5041    6 5329   74   15   38   77   26 6241   10
    9   82 6889   14   85   86   87   22 7921   10
   91   46   93   94   95    6 9409   14   33   10

BASIC

10 DEFINT A-Z: M=100
20 DIM C(M)
30 FOR P=2 TO SQR(M): FOR C=P*P TO M STEP P: C(C)=-1: NEXT C,P
40 PRINT USING " ####";1;
50 FOR I=2 TO M
60 FOR L=2 TO I: IF C(L) OR I MOD L>0 THEN NEXT L
70 FOR H=I TO 2 STEP -1: IF C(H) OR I MOD H>0 THEN NEXT H
80 PRINT USING " ####";L*H;
90 IF I MOD 10=0 THEN PRINT
100 NEXT I
Output:
    1    4    9    4   25    6   49    4    9   10
  121    6  169   14   15    4  289    6  361   10
   21   22  529    6   25   26    9   14  841   10
  961    4   33   34   35    6 1369   38   39   10
 1681   14 1849   22   15   46 2209    6   49   10
   51   26 2809    6   55   14   57   58 3481   10
 3721   62   21    4   65   22 4489   34   69   14
 5041    6 5329   74   15   38   77   26 6241   10
    9   82 6889   14   85   86   87   22 7921   10
   91   46   93   94   95    6 9409   14   33   10

BCPL

get "libhdr"

manifest $( MAX = 100 $)

let sieve(prime, max) be
$(  let p = 2
    0!prime := false
    1!prime := false
    for i = p to max do i!prime := true

    while p*p <= max
    $(  let c = p*p
        while c <= max
        $(  c!prime := false
            c := c + p
        $)
        p := p + 1
    $)
$)

let lofac(prime, n) =
    n=1 -> 1, 
    valof for f = 2 to n 
        if f!prime & n rem f=0 resultis f

let hifac(prime, n) =
    n=1 -> 1,
    valof for f = n to 2 by -1 
        if f!prime & n rem f=0 resultis f

let start() be
$(  let prime = vec MAX
    sieve(prime, MAX)
    for i = 1 to MAX
    $(  writed(lofac(prime, i) * hifac(prime, i), 6)
        if i rem 10 = 0 do wrch('*N')
    $)
$)
Output:
     1     4     9     4    25     6    49     4     9    10
   121     6   169    14    15     4   289     6   361    10
    21    22   529     6    25    26     9    14   841    10
   961     4    33    34    35     6  1369    38    39    10
  1681    14  1849    22    15    46  2209     6    49    10
    51    26  2809     6    55    14    57    58  3481    10
  3721    62    21     4    65    22  4489    34    69    14
  5041     6  5329    74    15    38    77    26  6241    10
     9    82  6889    14    85    86    87    22  7921    10
    91    46    93    94    95     6  9409    14    33    10

C

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

#define MAX 100

void sieve(bool *prime, int max) {
    memset(prime, true, max+1);
    prime[0] = prime[1] = false;
    
    for (int p=2; p*p<=max; p++)
        for (int c=p*p; c<=max; c+=p)
            prime[c] = false; 
}

int lo_fac(bool *prime, int n) {
    if (n==1) return 1;
    for (int f=2; f<=n; f++) 
        if (prime[f] && n%f == 0) return f;
    return n;
}

int hi_fac(bool *prime, int n) {
    if (n==1) return 1;
    for (int f=n; f>=2; f--)
        if (prime[f] && n%f == 0) return f;
    return n;
}

int main() {
    bool prime[MAX+1];
    sieve(prime, MAX);
    
    for (int i=1; i<=MAX; i++) {
        printf("%6d", lo_fac(prime, i) * hi_fac(prime, i));
        if (i%10 == 0) printf("\n");
    }
    return 0;
}
Output:
     1     4     9     4    25     6    49     4     9    10
   121     6   169    14    15     4   289     6   361    10
    21    22   529     6    25    26     9    14   841    10
   961     4    33    34    35     6  1369    38    39    10
  1681    14  1849    22    15    46  2209     6    49    10
    51    26  2809     6    55    14    57    58  3481    10
  3721    62    21     4    65    22  4489    34    69    14
  5041     6  5329    74    15    38    77    26  6241    10
     9    82  6889    14    85    86    87    22  7921    10
    91    46    93    94    95     6  9409    14    33    10

C++

#include <iomanip>
#include <iostream>
#include <utility>

auto min_max_prime_factors(unsigned int n) {
    unsigned int min_factor = 1;
    unsigned int max_factor = 1;
    if ((n & 1) == 0) {
        while ((n & 1) == 0)
            n >>= 1;
        min_factor = 2;
        max_factor = 2;
    }
    for (unsigned int p = 3; p * p <= n; p += 2) {
        if (n % p == 0) {
            while (n % p == 0)
                n /= p;
            if (min_factor == 1)
                min_factor = p;
            max_factor = p;
        }
    }
    if (n > 1) {
        if (min_factor == 1)
            min_factor = n;
        max_factor = n;
    }
    return std::make_pair(min_factor, max_factor);
}

int main() {
    std::cout << "Product of smallest and greatest prime factors of n for 1 to "
                 "100:\n";
    for (unsigned int n = 1; n <= 100; ++n) {
        auto p = min_max_prime_factors(n);
        std::cout << std::setw(4) << p.first * p.second
                  << (n % 10 == 0 ? '\n' : ' ');
    }
}
Output:
Product of smallest and greatest prime factors of n for 1 to 100:
   1    4    9    4   25    6   49    4    9   10
 121    6  169   14   15    4  289    6  361   10
  21   22  529    6   25   26    9   14  841   10
 961    4   33   34   35    6 1369   38   39   10
1681   14 1849   22   15   46 2209    6   49   10
  51   26 2809    6   55   14   57   58 3481   10
3721   62   21    4   65   22 4489   34   69   14
5041    6 5329   74   15   38   77   26 6241   10
   9   82 6889   14   85   86   87   22 7921   10
  91   46   93   94   95    6 9409   14   33   10

CLU

sieve = proc (max: int) returns (sequence[int])
    prime: array[bool] := array[bool]$fill(2,max-1,true)    
    p: int := 2
    while p*p <= max do 
        for c: int in int$from_to_by(p*p, max, p) do
            prime[c] := false
        end
        p := p + 1
    end

    primes: array[int] := array[int]$[]
    for i: int in array[bool]$indexes(prime) do
        if prime[i] then array[int]$addh(primes, i) end
    end
    return(sequence[int]$a2s(primes))
end sieve

factors = proc (primes: sequence[int], n: int) returns (sequence[int])
    if n=1 then return(sequence[int]$[1]) end 

    fac: array[int] := array[int]$[]
    for p: int in sequence[int]$elements(primes) do
        if n // p = 0 then array[int]$addh(fac, p) end
    end
    return(sequence[int]$a2s(fac))
end factors

start_up = proc () 
    MAX = 100
    po: stream := stream$primary_output()    
    primes: sequence[int] := sieve(MAX)
    for i: int in int$from_to(1, MAX) do
        facs: sequence[int] := factors(primes, i)
        prod: int := sequence[int]$bottom(facs) * sequence[int]$top(facs)
        stream$putright(po, int$unparse(prod), 6)
        if i//10 = 0 then stream$putl(po, "") end
    end
end start_up
Output:
     1     4     9     4    25     6    49     4     9    10
   121     6   169    14    15     4   289     6   361    10
    21    22   529     6    25    26     9    14   841    10
   961     4    33    34    35     6  1369    38    39    10
  1681    14  1849    22    15    46  2209     6    49    10
    51    26  2809     6    55    14    57    58  3481    10
  3721    62    21     4    65    22  4489    34    69    14
  5041     6  5329    74    15    38    77    26  6241    10
     9    82  6889    14    85    86    87    22  7921    10
    91    46    93    94    95     6  9409    14    33    10

COBOL

       IDENTIFICATION DIVISION.
       PROGRAM-ID. MIN-MAX-PRIME-FACTOR-PRODUCT.

       DATA DIVISION.
       WORKING-STORAGE SECTION. 
       01 SIEVE-DATA.
          03 FLAG-DATA          PIC X(100) VALUE SPACES.
          03 FLAGS              REDEFINES FLAG-DATA, 
                                PIC X OCCURS 100 TIMES.
             88 PRIME           VALUE SPACE.
          03 CUR-PRIME          PIC 9(3).
          03 CUR-PRIME-SQ       PIC 9(6) VALUE ZERO.
          03 CUR-COMP           PIC 9(3).

       01 MAIN-VARS.
          03 CUR                PIC 9(3).
          03 STEP               PIC S9.
          03 LOW-FACTOR         PIC 9(3).
          03 HIGH-FACTOR        PIC 9(3).
          03 PRODUCT            PIC 9(6).
          03 CUR-FACTOR         PIC 9(3).
          03 FACTOR-TEST        PIC 9(3)V9(3) VALUE 0.1.
          03 FILLER             REDEFINES FACTOR-TEST.
             05 FILLER          PIC 9(3).
             05 FILLER          PIC 9(3).
                88 FACTOR       VALUE ZERO.

       01 OUT-VARS. 
          03 PRODUCT-FMT        PIC Z(5)9.
          03 TABLE-LINE         PIC X(60) VALUE SPACES.
          03 TABLE-POS          PIC 99 VALUE 1.

       PROCEDURE DIVISION.
       BEGIN. 
           PERFORM SIEVE.       
           PERFORM FACTORS-PRODUCT VARYING CUR FROM 1 BY 1
           UNTIL CUR IS NOT LESS THAN 100.

       FACTORS-PRODUCT.
           IF CUR IS EQUAL TO 1,
               MOVE 1 TO LOW-FACTOR, HIGH-FACTOR,
           ELSE
               PERFORM FIND-LOW-FACTOR,
               PERFORM FIND-HIGH-FACTOR.
           MULTIPLY LOW-FACTOR BY HIGH-FACTOR GIVING PRODUCT.
           PERFORM WRITE-PRODUCT.

       FIND-LOW-FACTOR.
           MOVE 2 TO CUR-FACTOR.
           MOVE 1 TO STEP.
           PERFORM FIND-FACTOR.
           MOVE CUR-FACTOR TO LOW-FACTOR.

       FIND-HIGH-FACTOR.
           MOVE CUR TO CUR-FACTOR.
           MOVE -1 TO STEP.
           PERFORM FIND-FACTOR.
           MOVE CUR-FACTOR TO HIGH-FACTOR.

       FIND-FACTOR.
           DIVIDE CUR BY CUR-FACTOR GIVING FACTOR-TEST.
           IF NOT (PRIME(CUR-FACTOR) AND FACTOR), 
               ADD STEP TO CUR-FACTOR, 
               GO TO FIND-FACTOR.

       WRITE-PRODUCT.
           MOVE PRODUCT TO PRODUCT-FMT.
           STRING PRODUCT-FMT DELIMITED BY SIZE INTO TABLE-LINE
           WITH POINTER TABLE-POS.
           IF TABLE-POS IS GREATER THAN 60,
               DISPLAY TABLE-LINE,
               MOVE 1 TO TABLE-POS.

       SIEVE.
           MOVE 'C' TO FLAGS(1).
           PERFORM MARK-COMPOSITES VARYING CUR-PRIME FROM 2 BY 1
           UNTIL CUR-PRIME-SQ IS GREATER THAN 100. 

       MARK-COMPOSITES.
           MULTIPLY CUR-PRIME BY CUR-PRIME GIVING CUR-PRIME-SQ.
           PERFORM MARK-COMPOSITE
           VARYING CUR-COMP FROM CUR-PRIME-SQ BY CUR-PRIME
           UNTIL CUR-COMP IS GREATER THAN 100.
    
       MARK-COMPOSITE.
           MOVE 'C' TO FLAGS(CUR-COMP).
Output:
     1     4     9     4    25     6    49     4     9    10
   121     6   169    14    15     4   289     6   361    10
    21    22   529     6    25    26     9    14   841    10
   961     4    33    34    35     6  1369    38    39    10
  1681    14  1849    22    15    46  2209     6    49    10
    51    26  2809     6    55    14    57    58  3481    10
  3721    62    21     4    65    22  4489    34    69    14
  5041     6  5329    74    15    38    77    26  6241    10
     9    82  6889    14    85    86    87    22  7921    10
    91    46    93    94    95     6  9409    14    33    10

Cowgol

include "cowgol.coh";

const MAX := 100;
var prime: uint8[MAX+1];
typedef N is @indexof prime;

sub Sieve() is
    prime[0] := 0;
    prime[1] := 0;
    MemSet(&prime[2], 1, @bytesof prime-2);    

    var p: N := 2;
    while p*p <= MAX loop
        var c: N := p*p;
        while c <= MAX loop
            prime[c] := 0;  
            c := c + p;
        end loop;
        p := p + 1;
    end loop;
end sub;

sub LowFactor(n: N): (f: N) is
    if n == 1 then f := 1; return; end if;
    f := 2;
    while f <= n loop
        if prime[f] == 1 and n%f == 0 then return; end if;
        f := f + 1;
    end loop;
end sub;

sub HighFactor(n: N): (f: N) is
    if n == 1 then f := 1; return; end if;
    f := n;
    while f >= 2 loop
        if prime[f] == 1 and n%f == 0 then return; end if;
        f := f - 1;
    end loop;
end sub;

Sieve();
var i: N := 1;
while i <= MAX loop
    print_i16(LowFactor(i) as uint16 * HighFactor(i) as uint16);
    if i % 10 == 0
        then print_nl();
        else print_char('\t');
    end if;
    i := i + 1;
end loop;
Output:
1	4	9	4	25	6	49	4	9	10
121	6	169	14	15	4	289	6	361	10
21	22	529	6	25	26	9	14	841	10
961	4	33	34	35	6	1369	38	39	10
1681	14	1849	22	15	46	2209	6	49	10
51	26	2809	6	55	14	57	58	3481	10
3721	62	21	4	65	22	4489	34	69	14
5041	6	5329	74	15	38	77	26	6241	10
9	82	6889	14	85	86	87	22	7921	10
91	46	93	94	95	6	9409	14	33	10

D

import std.stdio : writef;

void main() {
    auto sieve = sieve(100);
    for(ulong i = 1; i <= 100; i++) {
        writef("%4d ", min_prime_factor(i, sieve) * max_prime_factor(i, sieve));
        if(i % 10 == 0)
            writef("\n");
    }
}
bool []sieve(ulong max) {
    bool []sieve = new bool[](max + 1);
    sieve[] = true;
    sieve[0] = false;
    sieve[1] = false;

    for(ulong i = 2; i <= max; i++)
        if(sieve[i])
            for(ulong j = i * 2; j <= max; j += i)
                sieve[j] = false;

    return sieve;
}
ulong min_prime_factor(ulong number, bool []sieve) {
    if (number <= 1)
        return 1;

    for(ulong index = 2; index <= number; index++) 
        if(sieve[index] && number % index == 0)
            return index;

    assert(0 && "Sieve was not initialized correctly");
}
ulong max_prime_factor(ulong number, bool []sieve) {
    if (number <= 1)
        return 1;

    for(ulong index = number; index >= 2; index--) 
        if(sieve[index] && number % index == 0)
            return index;

    assert(0 && "Sieve was not initialized correctly");
}
Output:
    1    4    9    4   25    6   49    4    9   10
  121    6  169   14   15    4  289    6  361   10
   21   22  529    6   25   26    9   14  841   10
  961    4   33   34   35    6 1369   38   39   10
 1681   14 1849   22   15   46 2209    6   49   10
   51   26 2809    6   55   14   57   58 3481   10
 3721   62   21    4   65   22 4489   34   69   14
 5041    6 5329   74   15   38   77   26 6241   10
    9   82 6889   14   85   86   87   22 7921   10
   91   46   93   94   95    6 9409   14   33   10

Delphi

Works with: Delphi version 6.0

Another example of code reuse by creating subroutines to that get used for more than one Rosetta Code task.

procedure StoreNumber(N: integer; var IA: TIntegerDynArray);
{Expand and store number in array}
begin
SetLength(IA,Length(IA)+1);
IA[High(IA)]:=N;
end;


procedure GetPrimeFactors(N: integer; var Facts: TIntegerDynArray);
{Get all the prime factors of a number}
var I: integer;
begin
I:=2;
SetLength(Facts,0);
repeat
	begin
	if (N mod I) = 0 then
		begin
		StoreNumber(I,Facts);
		N:=N div I;
		end
	else I:=GetNextPrime(I);
	end
until N=1;
end;



procedure ProductMinMaxFactors(Memo: TMemo);
var I,Cnt,P: integer;
var IA: TIntegerDynArray;
var S: string;
begin
Cnt:=1;
S:='    1';
for I:=2 to 100 do
	begin
	GetPrimeFactors(I,IA);
	P:=IA[0] * IA[High(IA)];
	Inc(Cnt);
	S:=S+Format('%5D',[P]);
	If (Cnt mod 10)=0 then S:=S+CRLF;
	 end;
Memo.Lines.Add(S);
Memo.Lines.Add('Count = '+IntToStr(Cnt));
end;
Output:
    1    4    9    4   25    6   49    4    9   10
  121    6  169   14   15    4  289    6  361   10
   21   22  529    6   25   26    9   14  841   10
  961    4   33   34   35    6 1369   38   39   10
 1681   14 1849   22   15   46 2209    6   49   10
   51   26 2809    6   55   14   57   58 3481   10
 3721   62   21    4   65   22 4489   34   69   14
 5041    6 5329   74   15   38   77   26 6241   10
    9   82 6889   14   85   86   87   22 7921   10
   91   46   93   94   95    6 9409   14   33   10

Count = 100
Elapsed Time: 2.961 ms.


Draco

proc sieve([*]bool prime) void:
    word p, c, max;
    max := dim(prime,1)-1;

    prime[0] := false;      
    prime[1] := false;    
    for p from 2 upto max do prime[p] := true od;
    for p from 2 upto max/2 do
        for c from p*2 by p upto max do
            prime[c] := false
        od
    od
corp

proc lo_fac([*]bool prime; word n) word:
    word i;
    if n=1 then 1
    else 
        i := 2;
        while i<=n and not (prime[i] and n%i=0) do i := i + 1 od;
        i
    fi
corp

proc hi_fac([*]bool prime; word n) word:
    word i;
    if n=1 then 1
    else
        i := n;
        while i>=2 and not (prime[i] and n%i=0) do i := i - 1 od;
        i
    fi
corp

proc main() void:
    word i, MAX = 100;
    [MAX+1]bool prime;
    sieve(prime);
    
    for i from 1 upto MAX do
        write(lo_fac(prime, i) * hi_fac(prime, i):6);
        if i%10 = 0 then writeln() fi
    od
corp
Output:
     1     4     9     4    25     6    49     4     9    10
   121     6   169    14    15     4   289     6   361    10
    21    22   529     6    25    26     9    14   841    10
   961     4    33    34    35     6  1369    38    39    10
  1681    14  1849    22    15    46  2209     6    49    10
    51    26  2809     6    55    14    57    58  3481    10
  3721    62    21     4    65    22  4489    34    69    14
  5041     6  5329    74    15    38    77    26  6241    10
     9    82  6889    14    85    86    87    22  7921    10
    91    46    93    94    95     6  9409    14    33    10

Factor

Works with: Factor version 0.99 2022-04-03
USING: grouping math math.primes.factors math.statistics
prettyprint ranges sequences ;

2 100 [a..b] [ factors minmax * ] map 1 prefix 10 group simple-table.
Output:
1    4  9    4  25 6  49   4  9    10
121  6  169  14 15 4  289  6  361  10
21   22 529  6  25 26 9    14 841  10
961  4  33   34 35 6  1369 38 39   10
1681 14 1849 22 15 46 2209 6  49   10
51   26 2809 6  55 14 57   58 3481 10
3721 62 21   4  65 22 4489 34 69   14
5041 6  5329 74 15 38 77   26 6241 10
9    82 6889 14 85 86 87   22 7921 10
91   46 93   94 95 6  9409 14 33   10

FreeBASIC

Translation of: ALGOL 68
Const maxNumber = 100 ' maximum number we will consider
' sieve the primes to maxNumber
Dim As Boolean prime(0 To maxNumber)
prime(0) = False
prime(1) = False
prime(2) = True

Dim As Integer i, j, s, ub = Ubound(prime)
For i = 3 To ub Step 2
    prime(i) = True  
Next i
For i = 4 To ub Step 2
    prime(i) = False 
Next
For i = 3 To Abs(Sqr(ub)) Step 2
    If prime(i) Then
        For s = i * i To ub Step i + i
            prime(s) = False 
        Next s
    End If
Next i
' construct tables of the minimum and maximum prime factors
' of numbers up to max number
Dim As Integer minPF(1 To maxNumber)
For i = 1 To Ubound(minPF)
    minPF(i) = 0 
Next i
Dim As Integer maxPF(1 To maxNumber)
For i = 1 To Ubound(minPF)
    maxPF(i) = 0 
Next i
minPF(1) = 1
maxPF(1) = 1

For i = 1 To maxNumber
    If prime(i) Then
        For j = i To Ubound(minPF) Step i
            If minPF(j) = 0 Then minPF(j) = i
            maxPF(j) = i
        Next j
    End If
Next i

' print the products of the min and max prime factors
For i = 1 To maxNumber
    Print Using "#####"; minPF(i) * maxPF(i);
    If i Mod 10 = 0 Then Print
Next i
Output:
Same as ALGOL 68 entry.

FOCAL

01.10 S M=100
01.20 D 2
01.30 T %6
01.40 F I=1,M;D 3
01.50 Q

02.10 S P(1)=0
02.20 F P=2,M;S P(P)=-1
02.30 F P=2,FSQT(M);F C=P*P,P,M;S P(C)=0

03.10 I (1-I)3.2;T I;R
03.20 S L=2;D 4
03.30 S H=I;D 5
03.40 T L*H
03.50 I (FITR(I/10)*10-I)3.7,3.6
03.60 T !
03.70 R

04.10 I (P(L))4.2,4.3
04.20 I (FITR(I/L)*L-I)4.3;R
04.30 S L=L+1
04.40 G 4.1

05.10 I (P(H))5.2,5.3
05.20 I (FITR(I/H)*H-I)5.3;R
05.30 S H=H-1
05.40 G 5.1
Output:
=      1=      4=      9=      4=     25=      6=     49=      4=      9=     10
=    121=      6=    169=     14=     15=      4=    289=      6=    361=     10
=     21=     22=    529=      6=     25=     26=      9=     14=    841=     10
=    961=      4=     33=     34=     35=      6=   1369=     38=     39=     10
=   1681=     14=   1849=     22=     15=     46=   2209=      6=     49=     10
=     51=     26=   2809=      6=     55=     14=     57=     58=   3481=     10
=   3721=     62=     21=      4=     65=     22=   4489=     34=     69=     14
=   5041=      6=   5329=     74=     15=     38=     77=     26=   6241=     10
=      9=     82=   6889=     14=     85=     86=     87=     22=   7921=     10
=     91=     46=     93=     94=     95=      6=   9409=     14=     33=     10

Go

Translation of: Wren
Library: Go-rcu
package main

import (
    "fmt"
    "rcu"
)

func main() {
    prods := make([]int, 100)
    prods[0] = 1
    for i := 2; i <= 100; i++ {
        factors := rcu.PrimeFactors(i)
        prods[i-1] = factors[0] * factors[len(factors)-1]
    }
    fmt.Println("Product of smallest and greatest prime factors of n for 1 to 100:")
    rcu.PrintTable(prods, 10, 4, false)
}
Output:
Product of smallest and greatest prime factors of n for 1 to 100:
   1    4    9    4   25    6   49    4    9   10 
 121    6  169   14   15    4  289    6  361   10 
  21   22  529    6   25   26    9   14  841   10 
 961    4   33   34   35    6 1369   38   39   10 
1681   14 1849   22   15   46 2209    6   49   10 
  51   26 2809    6   55   14   57   58 3481   10 
3721   62   21    4   65   22 4489   34   69   14 
5041    6 5329   74   15   38   77   26 6241   10 
   9   82 6889   14   85   86   87   22 7921   10 
  91   46   93   94   95    6 9409   14   33   10

Haskell

import Data.List (intercalate, transpose)
import Data.List.Split (chunksOf)
import Data.Numbers.Primes (primeFactors)
import Text.Printf (printf)

----------- PRODUCT OF MIN AND MAX PRIME FACTORS ---------

oeisA066048 :: [Integer]
oeisA066048 = 1 : fmap f [2 ..]
  where
    f = ((*) . head <*> last) . primeFactors

--------------------------- TEST -------------------------
main :: IO ()
main = putStrLn $ 
  table "  " $ (chunksOf 10 . take 100) $ 
    fmap show oeisA066048

------------------------- DISPLAY ------------------------

table :: String -> [[String]] -> String
table gap rows =
  let ws = maximum . fmap length <$> transpose rows
      pw = printf . flip intercalate ["%", "s"] . show
   in unlines $ intercalate gap . zipWith pw ws <$> rows
Output:
   1   4     9   4  25   6    49   4     9  10
 121   6   169  14  15   4   289   6   361  10
  21  22   529   6  25  26     9  14   841  10
 961   4    33  34  35   6  1369  38    39  10
1681  14  1849  22  15  46  2209   6    49  10
  51  26  2809   6  55  14    57  58  3481  10
3721  62    21   4  65  22  4489  34    69  14
5041   6  5329  74  15  38    77  26  6241  10
   9  82  6889  14  85  86    87  22  7921  10
  91  46    93  94  95   6  9409  14    33  10

J

   1>.(>./*<./)@q:"0 >:i.10 10
   1  4    9  4 25  6   49  4    9 10
 121  6  169 14 15  4  289  6  361 10
  21 22  529  6 25 26    9 14  841 10
 961  4   33 34 35  6 1369 38   39 10
1681 14 1849 22 15 46 2209  6   49 10
  51 26 2809  6 55 14   57 58 3481 10
3721 62   21  4 65 22 4489 34   69 14
5041  6 5329 74 15 38   77 26 6241 10
   9 82 6889 14 85 86   87 22 7921 10
  91 46   93 94 95  6 9409 14   33 10

Or, more efficiently:

   1>.({.*{:)@q:"0 >:i.10 10
   1  4    9  4 25  6   49  4    9 10
 121  6  169 14 15  4  289  6  361 10
  21 22  529  6 25 26    9 14  841 10
 961  4   33 34 35  6 1369 38   39 10
1681 14 1849 22 15 46 2209  6   49 10
  51 26 2809  6 55 14   57 58 3481 10
3721 62   21  4 65 22 4489 34   69 14
5041  6 5329 74 15 38   77 26 6241 10
   9 82 6889 14 85 86   87 22 7921 10
  91 46   93 94 95  6 9409 14   33 10

jq

Works with: jq

The following program will also work with gojq if the def of `_nwise/2` is uncommented.

# Uncomment for gojq
# def _nwise($n):
#   def nw: if length <= $n then . else .[0:$n] , (.[$n:] | nw) end;
#   nw;

def lpad($len): tostring | ($len - length) as $l | (" " * $l)[:$l] + .;

# Input: an integer
def isPrime:
  . as $n
  | if   ($n < 2)       then false
    elif ($n % 2 == 0)  then $n == 2
    elif ($n % 3 == 0)  then $n == 3
    else 5
    | until( . <= 0;
        if .*. > $n then -1
	elif ($n % . == 0) then 0
        else . + 2
        |  if ($n % . == 0) then 0
           else . + 4
           end
        end)
    | . == -1
    end;

# Input: an integer
# Output: a stream of the prime divisors of the input, in order
def prime_divisors:
  . as $n
  | if . < 2 then empty
    elif . == 2 then 2
    else (select(. % 2 == 0) | 2),
         (range(3; ($n / 2) + 1; 2) | select( ($n % . == 0) and isPrime)),
         ($n | select(isPrime))
    end;

def greatest_prime_divisor:
  def odd: if . % 2 == 1 then . else . + 1 end;
  . as $n
  | if . < 2 then empty
    elif . == 2 then 2
    else first(
           ($n | select(isPrime)),
           ((( (($n|odd) - 1) / 2) | odd) as $odd
            | range( $odd; 2; -2) | select( ($n % . == 0) and isPrime)),
           (select(. % 2 == 0) | 2) )
    end;

# Output: a stream of the products
def productMinMaxPrimeFactors:
  1,
  (range(2; infinite)
   | [ first(prime_divisors), greatest_prime_divisor] | .[0] * .[-1]);

"Product of the smallest and greatest prime factors of n for 1 to 100:",
([limit(100; productMinMaxPrimeFactors)]
 | _nwise(10) | map(lpad(4)) | join(" "))

Invocation jq -nr -f product-of-min-and-max-prime-factors.jq

Output:
Product of the smallest and greatest prime factors of n for 1 to 100:
   1    4    9    4   25    6   49    4    9   10
 121    6  169   14   15    4  289    6  361   10
  21   22  529    6   25   26    9   14  841   10
 961    4   33   34   35    6 1369   38   39   10
1681   14 1849   22   15   46 2209    6   49   10
  51   26 2809    6   55   14   57   58 3481   10
3721   62   21    4   65   22 4489   34   69   14
5041    6 5329   74   15   38   77   26 6241   10
   9   82 6889   14   85   86   87   22 7921   10
  91   46   93   94   95    6 9409   14   33   10

Julia

using Primes

function firstlastprimeprod(number_wanted)
    for num in 1:number_wanted
        fac = collect(factor(num))
        product = isempty(fac) ? 1 : fac[begin][begin] * fac[end][begin]
        print(rpad(product, 6), num % 10 == 0 ? "\n" : "")
    end
end

firstlastprimeprod(100)
Output:
1     4     9     4     25    6     49    4     9     10    
121   6     169   14    15    4     289   6     361   10
21    22    529   6     25    26    9     14    841   10
961   4     33    34    35    6     1369  38    39    10
1681  14    1849  22    15    46    2209  6     49    10
51    26    2809  6     55    14    57    58    3481  10
3721  62    21    4     65    22    4489  34    69    14
5041  6     5329  74    15    38    77    26    6241  10
9     82    6889  14    85    86    87    22    7921  10
91    46    93    94    95    6     9409  14    33    10

MAD

            NORMAL MODE IS INTEGER
            BOOLEAN PRIME
            DIMENSION O(10),PRIME(100)
            VECTOR VALUES PRLIN = $10(I6)*$

            INTERNAL FUNCTION REM.(A,B) = A-(A/B)*B

            PRIME(0) = 0B
            PRIME(1) = 0B
            THROUGH SVINI, FOR P=2, 1, P.G.100 
SVINI       PRIME(P) = 1B

            THROUGH SIEVE, FOR P=2, 1, P*P.G.100
            THROUGH SIEVE, FOR C=P*P, P, C.G.100
SIEVE       PRIME(C) = 0B

            THROUGH LINE, FOR Y=0, 10, Y.GE.100
            THROUGH CLMN, FOR X=1, 1, X.G.10
            O(X)=1
            WHENEVER X+Y.E.1, TRANSFER TO CLMN 
FLO         THROUGH FLO, FOR LO=2, 1, PRIME(LO).AND.REM.(X+Y,LO).E.0
FHI         THROUGH FHI, FOR HI=X+Y, -1, PRIME(HI).AND.REM.(X+Y,HI).E.0
            O(X)=LO*HI
CLMN        CONTINUE
LINE        PRINT FORMAT PRLIN,O(1),O(2),O(3),O(4),O(5),
          0                    O(6),O(7),O(8),O(9),O(10)
            END OF PROGRAM
Output:
     1     4     9     4    25     6    49     4     9    10
   121     6   169    14    15     4   289     6   361    10
    21    22   529     6    25    26     9    14   841    10
   961     4    33    34    35     6  1369    38    39    10
  1681    14  1849    22    15    46  2209     6    49    10
    51    26  2809     6    55    14    57    58  3481    10
  3721    62    21     4    65    22  4489    34    69    14
  5041     6  5329    74    15    38    77    26  6241    10
     9    82  6889    14    85    86    87    22  7921    10
    91    46    93    94    95     6  9409    14    33    10

Modula-2

MODULE MinMaxPrimeFactors;
FROM InOut IMPORT WriteCard, WriteLn;

CONST Max = 100;
VAR isPrime: ARRAY [2..Max] OF BOOLEAN;
    n: CARDINAL;

PROCEDURE Sieve;
    VAR prime, composite: CARDINAL;
BEGIN
    FOR prime := 1 TO Max DO isPrime[prime] := TRUE END;
    prime := 2;
    WHILE prime * prime <= Max DO
        composite := prime * prime;
        WHILE composite <= Max DO
            isPrime[composite] := FALSE;
            composite := composite + prime
        END;
        INC(prime)
    END
END Sieve;

PROCEDURE LowFactor(n: CARDINAL): CARDINAL;
    VAR factor: CARDINAL;
BEGIN
    IF n = 1 THEN RETURN 1 END;
    FOR factor := 2 TO Max DO
        IF isPrime[factor] AND (n MOD factor = 0) THEN RETURN factor END
    END
END LowFactor;

PROCEDURE HighFactor(n: CARDINAL): CARDINAL;
    VAR factor: CARDINAL;
BEGIN
    IF n = 1 THEN RETURN 1 END;
    FOR factor := n TO 2 BY -1 DO
        IF isPrime[factor] AND (n MOD factor = 0) THEN RETURN factor END
    END
END HighFactor;

BEGIN
    Sieve;
    FOR n := 1 TO Max DO
        WriteCard(LowFactor(n) * HighFactor(n), 6);
        IF n MOD 10 = 0 THEN WriteLn END
    END
END MinMaxPrimeFactors.
Output:
     1     4     9     4    25     6    49     4     9    10
   121     6   169    14    15     4   289     6   361    10
    21    22   529     6    25    26     9    14   841    10
   961     4    33    34    35     6  1369    38    39    10
  1681    14  1849    22    15    46  2209     6    49    10
    51    26  2809     6    55    14    57    58  3481    10
  3721    62    21     4    65    22  4489    34    69    14
  5041     6  5329    74    15    38    77    26  6241    10
     9    82  6889    14    85    86    87    22  7921    10
    91    46    93    94    95     6  9409    14    33    10

Nim

import std/strformat

func primeFactors(n: Positive): seq[Natural] =
  if n == 1: return @[1]
  var n = n
  var d = 2
  while d * d <= n:
    if n mod d == 0:
      result.add d
      while n mod d == 0:
        n = n div d
    inc d
  if n != 1: result.add n

for n in 1..100:
  let pf = n.primeFactors
  stdout.write &"{pf[0] * pf[^1]:4}"
  stdout.write if n mod 10 == 0: '\n' else: ' '
Output:
   1    4    9    4   25    6   49    4    9   10
 121    6  169   14   15    4  289    6  361   10
  21   22  529    6   25   26    9   14  841   10
 961    4   33   34   35    6 1369   38   39   10
1681   14 1849   22   15   46 2209    6   49   10
  51   26 2809    6   55   14   57   58 3481   10
3721   62   21    4   65   22 4489   34   69   14
5041    6 5329   74   15   38   77   26 6241   10
   9   82 6889   14   85   86   87   22 7921   10
  91   46   93   94   95    6 9409   14   33   10


Perl

Library: ntheory
use v5.36;
use ntheory 'factor';
use List::Util <min max>;

sub table ($c, @V) { my $t = $c * (my $w = 2 + length max @V); ( sprintf( ('%'.$w.'d')x@V, @V) ) =~ s/.{1,$t}\K/\n/gr }

my @p = 1;
for (2..100) {
    my @f = factor $_;
    push @p, min(@f) * max(@f);
}

say "Product of smallest and greatest prime factors of n for 1 to 100:\n" . table 10, @p;
Output:
Product of smallest and greatest prime factors of n for 1 to 100:
     1     4     9     4    25     6    49     4     9    10
   121     6   169    14    15     4   289     6   361    10
    21    22   529     6    25    26     9    14   841    10
   961     4    33    34    35     6  1369    38    39    10
  1681    14  1849    22    15    46  2209     6    49    10
    51    26  2809     6    55    14    57    58  3481    10
  3721    62    21     4    65    22  4489    34    69    14
  5041     6  5329    74    15    38    77    26  6241    10
     9    82  6889    14    85    86    87    22  7921    10
    91    46    93    94    95     6  9409    14    33    10

Phix

with javascript_semantics
sequence prods = repeat(0,100)
for i=1 to 100 do
    sequence f = prime_factors(i,true)
    prods[i] = f[1] * f[$]
end for
printf(1,"Product of smallest and greatest prime factors of n for 1 to 100:\n%s\n",
         {join_by(prods,1,10," ",fmt:="%5d")})
Output:
Product of smallest and greatest prime factors of n for 1 to 100:
    1     4     9     4    25     6    49     4     9    10
  121     6   169    14    15     4   289     6   361    10
   21    22   529     6    25    26     9    14   841    10
  961     4    33    34    35     6  1369    38    39    10
 1681    14  1849    22    15    46  2209     6    49    10
   51    26  2809     6    55    14    57    58  3481    10
 3721    62    21     4    65    22  4489    34    69    14
 5041     6  5329    74    15    38    77    26  6241    10
    9    82  6889    14    85    86    87    22  7921    10
   91    46    93    94    95     6  9409    14    33    10

PL/M

Translation of: ALGOL 68
Works with: 8080 PL/M Compiler
... under CP/M (or an emulator)
100H: /* FIND THE PRODUCT OF THE MIN AND MAX PRIME FACTORS OF SOME NUMBERS   */

   DECLARE FALSE LITERALLY '0', TRUE LITERALLY '0FFH';

   /* CP/M SYSTEM CALL AND I/O ROUTINES                                      */
   BDOS:      PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
   PR$CHAR:   PROCEDURE( C ); DECLARE C BYTE;    CALL BDOS( 2, C );  END;
   PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S );  END;
   PR$NL:     PROCEDURE;   CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END;
   PR$NUMBER: PROCEDURE( N ); /* PRINTS A NUMBER IN THE MINIMUN FIELD WIDTH  */
      DECLARE N ADDRESS;
      DECLARE V ADDRESS, N$STR ( 6 )BYTE, W BYTE;
      V = N;
      W = LAST( N$STR );
      N$STR( W ) = '$';
      N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
      DO WHILE( ( V := V / 10 ) > 0 );
         N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
      END;
      CALL PR$STRING( .N$STR( W ) );
   END PR$NUMBER;
   /* END SYSTEM CALL AND I/O ROUTINES                                       */

   DECLARE MAX$N        LITERALLY '100',   /* MAXIMUM NUMBER TO CONSIDER     */
           MAX$N$PLUS$1 LITERALLY '101';    /* MAX$N + 1 FOR ARRAY BOUNDS    */

   /* SIEVE THE PRIMES TO MAX$N                                              */
   DECLARE PRIME ( MAX$N$PLUS$1 )BYTE;
   DO;
      DECLARE ( I, S ) ADDRESS;
      PRIME( 0 ),  PRIME( 1 ) = FALSE;
      PRIME( 2 ) = TRUE;
      DO I = 3 TO LAST( PRIME ) BY 2; PRIME( I ) = TRUE;  END;
      DO I = 4 TO LAST( PRIME ) BY 2; PRIME( I ) = FALSE; END;
      DO I = 3 TO LAST( PRIME ) / 2 BY 2;
         IF PRIME( I ) THEN DO;
            DO S = I + I TO LAST( PRIME ) BY I; PRIME( S ) = FALSE; END;
         END;
      END;
   END;

   /* CONSTRUCT TABLES OF THE MINIMUM AND MAXIMUM PRIME FACTORS OF NUMBERS   */
   /* UP TO MAX$N                                                            */
   DECLARE ( MIN$PF, MAX$PF ) ( MAX$N$PLUS$1 )ADDRESS;
   DECLARE ( I, J ) BYTE;
   DECLARE PRODUCT  ADDRESS;

   DO I = 1 TO LAST( MIN$PF );
      MIN$PF( I ), MAX$PF( I ) = 0;
   END;
   MIN$PF( 1 ) = 1;
   MAX$PF( 1 ) = 1;
   DO I = 1 TO MAX$N;
      IF PRIME( I ) THEN DO;
         DO J = I TO MAX$N BY I;
            IF MIN$PF( J ) = 0 THEN MIN$PF( J ) = I;
            MAX$PF( J ) = I;
         END;
      END;
   END;
   /* PRINT THE PRODUCTS OF THE MIN AND MAX PRIME FACTORS                    */
   DO I = 1 TO MAX$N;
      PRODUCT = MIN$PF( I ) * MAX$PF( I );
      IF PRODUCT <   10 THEN CALL PR$CHAR( ' ' );
      IF PRODUCT <  100 THEN CALL PR$CHAR( ' ' );
      IF PRODUCT < 1000 THEN CALL PR$CHAR( ' ' );
      CALL PR$CHAR( ' ' );
      CALL PR$NUMBER( PRODUCT );
      IF I MOD 10 = 0 THEN CALL PR$NL;
   END;

EOF
Output:
    1    4    9    4   25    6   49    4    9   10
  121    6  169   14   15    4  289    6  361   10
   21   22  529    6   25   26    9   14  841   10
  961    4   33   34   35    6 1369   38   39   10
 1681   14 1849   22   15   46 2209    6   49   10
   51   26 2809    6   55   14   57   58 3481   10
 3721   62   21    4   65   22 4489   34   69   14
 5041    6 5329   74   15   38   77   26 6241   10
    9   82 6889   14   85   86   87   22 7921   10
   91   46   93   94   95    6 9409   14   33   10

Python

Procedural

''' Rosetta code rosettacode.org/wiki/Product_of_min_and_max_prime_factors '''


from sympy import factorint

NUM_WANTED = 100

for num in range(1, NUM_WANTED + 1):
    fac = factorint(num, multiple=True)
    product = fac[0] * fac[-1] if len(fac) > 0 else 1
    print(f'{product:5}', end='\n' if num % 10 == 0 else '')
Output:
    1    4    9    4   25    6   49    4    9   10
  121    6  169   14   15    4  289    6  361   10
   21   22  529    6   25   26    9   14  841   10
  961    4   33   34   35    6 1369   38   39   10
 1681   14 1849   22   15   46 2209    6   49   10
   51   26 2809    6   55   14   57   58 3481   10
 3721   62   21    4   65   22 4489   34   69   14
 5041    6 5329   74   15   38   77   26 6241   10
    9   82 6889   14   85   86   87   22 7921   10
   91   46   93   94   95    6 9409   14   33   10

Functional

Defining an infinite series, tabulating with flexible column widths for larger samples,

and writing (rather than importing) a primeFactors function:

'''Produce of min and max prime factors'''

from itertools import chain, count, islice
from math import floor, sqrt


# oeisA066048 :: [Int]
def oeisA066048():
    '''Infinite series of terms in OEIS A066048.
    '''
    def f(x):
        ns = primeFactors(x)
        return ns[0] * ns[-1]

    return chain([1], map(f, count(2)))


# ------------------------- TEST -------------------------
# main :: IO ()
def main():
    '''First 100 terms in OEIS A066048.
    '''
    print(table(10)(
        list(map(
            str, islice(
                oeisA066048(),
                100
            )
        ))
    ))


# ----------------------- GENERIC ------------------------

# chunksOf :: Int -> [a] -> [[a]]
def chunksOf(n):
    '''A series of lists of length n, subdividing the
       contents of xs. Where the length of xs is not evenly
       divisible, the final list will be shorter than n.
    '''
    def go(xs):
        return (
            xs[i:n + i] for i in range(0, len(xs), n)
        ) if 0 < n else None
    return go


# primeFactors :: Int -> [Int]
def primeFactors(n):
    '''A list of the prime factors of n.
    '''
    def f(qr):
        r = qr[1]
        return step(r), 1 + r

    def step(x):
        return 1 + (x << 2) - ((x >> 1) << 1)

    def go(x):
        root = floor(sqrt(x))

        def p(qr):
            q = qr[0]
            return root < q or 0 == (x % q)

        q = until(p)(f)(
            (2 if 0 == x % 2 else 3, 1)
        )[0]
        return [x] if q > root else [q] + go(x // q)

    return go(n)


# table :: Int -> [String] -> String
def table(n):
    '''A list of strings formatted as
       right-justified rows of n columns.
    '''
    def go(xs):
        w = len(max(xs, key=len))
        return '\n'.join(
            ' '.join(row) for row in chunksOf(n)([
                s.rjust(w, ' ') for s in xs
            ])
        )
    return go


# until :: (a -> Bool) -> (a -> a) -> a -> a
def until(p):
    '''The result of repeatedly applying f until p holds.
       The initial seed value is x.
    '''
    def go(f):
        def g(x):
            v = x
            while not p(v):
                v = f(v)
            return v
        return g
    return go


# MAIN ---
if __name__ == '__main__':
    main()
Output:
   1    4    9    4   25    6   49    4    9   10
 121    6  169   14   15    4  289    6  361   10
  21   22  529    6   25   26    9   14  841   10
 961    4   33   34   35    6 1369   38   39   10
1681   14 1849   22   15   46 2209    6   49   10
  51   26 2809    6   55   14   57   58 3481   10
3721   62   21    4   65   22 4489   34   69   14
5041    6 5329   74   15   38   77   26 6241   10
   9   82 6889   14   85   86   87   22 7921   10
  91   46   93   94   95    6 9409   14   33   10

Quackery

primefactors is defined at Prime decomposition#Quackery.

  ' [ 1 ]
  99 times
    [ i^ 2 + primefactors
      dup 0 peek
      swap -1 peek *
      join ]
  witheach
    [ number$
      space 4 of
      swap join
      -5 split nip
      echo$
      i^ 10 mod 9 =
      if cr else sp ]
Output:
    1    4    9    4   25    6   49    4    9   10
  121    6  169   14   15    4  289    6  361   10
   21   22  529    6   25   26    9   14  841   10
  961    4   33   34   35    6 1369   38   39   10
 1681   14 1849   22   15   46 2209    6   49   10
   51   26 2809    6   55   14   57   58 3481   10
 3721   62   21    4   65   22 4489   34   69   14
 5041    6 5329   74   15   38   77   26 6241   10
    9   82 6889   14   85   86   87   22 7921   10
   91   46   93   94   95    6 9409   14   33   10

Raku

use Prime::Factor;
put "Product of smallest and greatest prime factors of n for 1 to 100:\n" ~
  (1..100).map({ 1 max .max × .min given cache .&prime-factors })».fmt("%4d").batch(10).join: "\n";
Output:
Product of smallest and greatest prime factors of n for 1 to 100:
   1    4    9    4   25    6   49    4    9   10
 121    6  169   14   15    4  289    6  361   10
  21   22  529    6   25   26    9   14  841   10
 961    4   33   34   35    6 1369   38   39   10
1681   14 1849   22   15   46 2209    6   49   10
  51   26 2809    6   55   14   57   58 3481   10
3721   62   21    4   65   22 4489   34   69   14
5041    6 5329   74   15   38   77   26 6241   10
   9   82 6889   14   85   86   87   22 7921   10
  91   46   93   94   95    6 9409   14   33   10

RPL

Works with: HP version 49g
≪ {1} 
   2 100 FOR j
      j FACTORS
      DUP 1 GET
      SWAP REVLIST 2 GET 
      * +
   NEXT 
≫ 'TASK' STO

{{out}

1: {1 4 9 4 25 6 49 4 9 10 121 6 169 14 15 4 289 6 361 10 21 22 529 6 25 26 9 14 841 10 961 4 33 34 35 6 1369 38 39 10 1681 14 1849 22 15 46 2209 6 49 10 51 26 2809 6 55 14 57 58 3481 10 3721 62 21 4 65 22 4489 34 69 14 5041 6 5329 74 15 38 77 26 6241 10 9 82 6889 14 85 86 87 22 7921 10 91 46 93 94 95 6 9409 14 33 10}

Ruby

require 'prime'

res = [1]+ (2..100).map{|n| n.prime_division.map(&:first).minmax.inject(&:*)}
res.each_slice(10){|slice| puts '%5d'*slice.size % slice}
Output:
    1    4    9    4   25    6   49    4    9   10
  121    6  169   14   15    4  289    6  361   10
   21   22  529    6   25   26    9   14  841   10
  961    4   33   34   35    6 1369   38   39   10
 1681   14 1849   22   15   46 2209    6   49   10
   51   26 2809    6   55   14   57   58 3481   10
 3721   62   21    4   65   22 4489   34   69   14
 5041    6 5329   74   15   38   77   26 6241   10
    9   82 6889   14   85   86   87   22 7921   10
   91   46   93   94   95    6 9409   14   33   10

Sidef

1..100 -> map {|n| lpf(n) * gpf(n) }.slices(10).each {|a|
    a.map{ '%5s' % _ }.join(' ').say
}
Output:
    1     4     9     4    25     6    49     4     9    10
  121     6   169    14    15     4   289     6   361    10
   21    22   529     6    25    26     9    14   841    10
  961     4    33    34    35     6  1369    38    39    10
 1681    14  1849    22    15    46  2209     6    49    10
   51    26  2809     6    55    14    57    58  3481    10
 3721    62    21     4    65    22  4489    34    69    14
 5041     6  5329    74    15    38    77    26  6241    10
    9    82  6889    14    85    86    87    22  7921    10
   91    46    93    94    95     6  9409    14    33    10

VTL-2

10 M=100
20 :1)=0
30 P=2
40 :P)=1
50 P=P+1
60 #=M>P*40
70 P=2
80 C=P*P
90 #=M>C=0*150
100 :C)=0
110 C=C+P
120 #=M>C*100
130 P=P+1
140 #=80
150 I=1
160 L=1
170 H=I
180 #=I=1*240
190 L=L+1
200 #=I/L*0+%=0*:L)=0*190
210 H=H+1
220 H=H-1
230 #=I/H*0+%=0*:H)=0*220
240 ?=L*H
250 #=I/10*0+%=0*280
260 $=9
270 #=290
280 ?=""
290 I=I+1
300 #=M>I*160
Output:
1	4	9	4	25	6	49	4	9	10
121	6	169	14	15	4	289	6	361	10
21	22	529	6	25	26	9	14	841	10
961	4	33	34	35	6	1369	38	39	10
1681	14	1849	22	15	46	2209	6	49	10
51	26	2809	6	55	14	57	58	3481	10
3721	62	21	4	65	22	4489	34	69	14
5041	6	5329	74	15	38	77	26	6241	10
9	82	6889	14	85	86	87	22	7921	10
91	46	93	94	95	6	9409	14	33	10

Wren

Library: Wren-math
Library: Wren-fmt
import "./math" for Int
import "./fmt" for Fmt

var prods = List.filled(100, 0)
prods[0] = 1
for (i in 2..100) {
    var factors = Int.primeFactors(i)
    prods[i-1] = factors[0] * factors[-1]
}
System.print("Product of smallest and greatest prime factors of n for 1 to 100:")
Fmt.tprint("$4d", prods, 10)
Output:
Product of smallest and greatest prime factors of n for 1 to 100:
   1    4    9    4   25    6   49    4    9   10 
 121    6  169   14   15    4  289    6  361   10 
  21   22  529    6   25   26    9   14  841   10 
 961    4   33   34   35    6 1369   38   39   10 
1681   14 1849   22   15   46 2209    6   49   10 
  51   26 2809    6   55   14   57   58 3481   10 
3721   62   21    4   65   22 4489   34   69   14 
5041    6 5329   74   15   38   77   26 6241   10 
   9   82 6889   14   85   86   87   22 7921   10 
  91   46   93   94   95    6 9409   14   33   10 

XPL0

Translation of: C++
func MinMaxPrimeFactors(N);
int N, Min, Max, P;     \(Min and Max must be in order shown)
[Min:= 1;  Max:= 1;
if (N&1) = 0 then
    [while (N&1) = 0 do
        N:= N>>1;
    Min:= 2;
    Max:= 2;
    ];
P:= 3;
while P*P <= N do
    [if rem(N/P) = 0 then
        [while rem(N/P) = 0 do
            N:= N/P;
        if Min = 1 then
            Min:= P;
        Max:= P;
        ];
    P:= P+2;
    ];
if N > 1 then
    [if Min = 1 then
        Min:= N;
    Max:= N;
    ];
return @Min;     \risky
];

int N, P;
[Text(0, "Product of smallest and greatest prime factors of N for 1 to 100:^m^j");
Format(5, 0);
for N:= 1 to 100 do
    [P:= MinMaxPrimeFactors(N);
    RlOut(0, float(P(0)*P(1)));
    if rem(N/10) = 0 then CrLf(0);
    ]
]
Output:
Product of smallest and greatest prime factors of N for 1 to 100:
    1    4    9    4   25    6   49    4    9   10
  121    6  169   14   15    4  289    6  361   10
   21   22  529    6   25   26    9   14  841   10
  961    4   33   34   35    6 1369   38   39   10
 1681   14 1849   22   15   46 2209    6   49   10
   51   26 2809    6   55   14   57   58 3481   10
 3721   62   21    4   65   22 4489   34   69   14
 5041    6 5329   74   15   38   77   26 6241   10
    9   82 6889   14   85   86   87   22 7921   10
   91   46   93   94   95    6 9409   14   33   10