Rosetta Code

Prime decomposition: Difference between revisions

Page Discussion

Prime decomposition (view source)

Revision as of 10:25, 31 March 2024

12,439 bytes added ,  1 month ago
→‎{{header|PowerShell}}
m (→‎{{header|Tiny BASIC}}: Works with (Tom Pittman's) TinyBasic.)
 
(37 intermediate revisions by 14 users not shown)
Line 759:
</pre>
 
=={{header|ApplesoftALGOL BASICW}}==
Algol W procedures can't return arrays, so an array to store the factors in must be passed as a parameter.
<syntaxhighlight lang="applesoftbasic">9040 PF(0) = 0 : SC = 0
<syntaxhighlight lang="algolw">
9050 FOR CA = 2 TO INT( SQR(I))
begin % find the prime decompositionmtion of some integers %
9060 IF I = 1 THEN RETURN
% increments n and returns the new value %
9070 IF INT(I / CA) * CA = I THEN GOSUB 9200 : GOTO 9060
integer procedure inc ( integer value result n ) ; begin n := n + 1; n end;
9080 CA = CA + SC : SC = 1
% divides n by d and returns the result %
9090 NEXT CA
integer procedure over ( integer value result n
9100 IF I = 1 THEN RETURN
; integer value d
9110 CA = I
) ; begin n := n div d; n end;
% sets the elements of f to the prime factors of n %
% the bounds of f should be 0 :: x where x is large enough to hold %
% all the factors, f( 0 ) will contain 6he number of factors %
procedure decompose ( integer value n; integer array f ( * ) ) ;
begin
integer d, v;
f( 0 ) := 0;
v := abs n;
if v > 0 and v rem 2 = 0 then begin
f( inc( f( 0 ) ) ) := 2;
while over( v, 2 ) > 0 and v rem 2 = 0 do f( inc( f( 0 ) ) ) := 2;
end if_2_divides_v ;
d := 3;
while d * d <= v do begin
if v rem d = 0 then begin
f( inc( f( 0 ) ) ) := d;
while over( v, d ) > 0 and v rem d = 0 do f( inc( f( 0 ) ) ) := d;
end if_d_divides_v ;
d := d + 2
end while_d_squared_le_v ;
if v > 1 then f( inc( f( 0 ) ) ) := v
end factorise ;
 
% some test cases %
9200 PF(0) = PF(0) + 1
for n := 0, 1, 7, 31, 127, 2047, 8191, 131071, 524287, 2520, 32767, 8855, 441421750 do begin
9210 PF(PF(0)) = CA
integer array f( 0 :: 20 );
9220 I = I / CA
decompose( n, f );
9230 RETURN</syntaxhighlight>
write( s_w := 0, n, ": " );
for fPos := 1 until f( 0 ) do writeon( i_w := 1, s_w := 0, " ", f( fPos ) );
end for_n ;
end.
</syntaxhighlight>
{{out}}
<pre>
0:
1:
7: 7
31: 31
127: 127
2047: 23 89
8191: 8191
131071: 131071
524287: 524287
2520: 2 2 2 3 3 5 7
32767: 7 31 151
8855: 5 7 11 23
441421750: 2 5 5 5 7 11 23 997
</pre>
 
=={{header|Arturo}}==
 
<syntaxhighlight lang="rebol">decompose: function [num][
facts: to [:string] factors.prime num
Line 898 ⟶ 941:
{{out}}
<pre>8388607 = 47 * 178481</pre>
 
 
=={{header|AWK}}==
Line 929 ⟶ 971:
8796093022207
431 9719 2099863</pre>
 
=={{header|BASIC}}==
==={{header|ANSI BASIC}}===
{{trans|XPL0}}
{{works with|Decimal BASIC}}
<syntaxhighlight lang="basic">
100 PROGRAM PrimeDecomposition
110 REM -(2^31) has most prime factors (31 twos) than other 32-bit signed integer.
120 DIM Facs(0 TO 30)
130 INPUT PROMPT "Enter a number: ": N
140 CALL CalcFacs(N, Facs, FacsCnt)
150 REM There is at least one factor
160 FOR I = 0 TO FacsCnt - 1
170 PRINT Facs(I);
180 NEXT I
190 PRINT
200 END
210 REM **
220 EXTERNAL SUB CalcFacs(N, Facs(), FacsCnt)
230 LET N = ABS(N)
240 LET FacsCnt = 0
250 IF N >= 2 THEN
260 LET I = 2
270 DO WHILE I * I <= N
280 IF MOD(N, I) = 0 THEN
290 LET N = INT(N / I)
300 LET Facs(FacsCnt) = I
310 LET FacsCnt = FacsCnt + 1
320 LET I = 2
330 ELSE
340 LET I = I + 1
350 END IF
360 LOOP
370 LET Facs(FacsCnt) = N
380 LET FacsCnt = FacsCnt + 1
390 END IF
400 END SUB
</syntaxhighlight>
{{out}} 3 runs.
<pre>
Enter a number: 32
2 2 2 2 2
</pre>
<pre>
Enter a number: 2520
2 2 2 3 3 5 7
</pre>
<pre>
Enter a number: 13
13
</pre>
 
==={{header|Applesoft BASIC}}===
<syntaxhighlight lang="applesoftbasic">9040 PF(0) = 0 : SC = 0
9050 FOR CA = 2 TO INT( SQR(I))
9060 IF I = 1 THEN RETURN
9070 IF INT(I / CA) * CA = I THEN GOSUB 9200 : GOTO 9060
9080 CA = CA + SC : SC = 1
9090 NEXT CA
9100 IF I = 1 THEN RETURN
9110 CA = I
 
9200 PF(0) = PF(0) + 1
9210 PF(PF(0)) = CA
9220 I = I / CA
9230 RETURN</syntaxhighlight>
 
==={{header|ASIC}}===
{{trans|XPL0}}
<syntaxhighlight lang="basic">
REM Prime decomposition
DIM Facs(14)
REM -(2^15) has most prime factors (15 twos) than other 16-bit signed integer.
PRINT "Enter a number";
INPUT N
GOSUB CalcFacs:
FacsCntM1 = FacsCnt - 1
FOR I = 0 TO FacsCntM1
PRINT Facs(I);
NEXT I
PRINT
END
 
CalcFacs:
N = ABS(N)
FacsCnt = 0
IF N >= 2 THEN
I = 2
SqrI = I * I
WHILE SqrI <= N
NModI = N MOD I
IF NModI = 0 THEN
N = N / I
Facs(FacsCnt) = I
FacsCnt = FacsCnt + 1
I = 2
ELSE
I = I + 1
ENDIF
SqrI = I * I
WEND
Facs(FacsCnt) = N
FacsCnt = FacsCnt + 1
ENDIF
RETURN
</syntaxhighlight>
{{out}}
3 runs.
<pre>
Enter a number?32
2 2 2 2 2
</pre>
<pre>
Enter a number?2520
2 2 2 3 3 5 7
</pre>
<pre>
Enter a number?13
13
</pre>
 
==={{header|Commodore BASIC}}===
{{works_with|Commodore BASIC|2.0}}
It's not easily possible to have arbitrary precision integers in PET basic, so here is at least a version using built-in data types (reals). On return from the subroutine starting at 9000 the global array pf contains the number of factors followed by the factors themselves:
<syntaxhighlight lang="zxbasic">9000 REM ----- function generate
9010 REM in ... i ... number
9020 REM out ... pf() ... factors
9030 REM mod ... ca ... pf candidate
9040 pf(0)=0 : ca=2 : REM special case
9050 IF i=1 THEN RETURN
9060 IF INT(i/ca)*ca=i THEN GOSUB 9200 : GOTO 9050
9070 FOR ca=3 TO INT( SQR(i)) STEP 2
9080 IF i=1 THEN RETURN
9090 IF INT(i/ca)*ca=i THEN GOSUB 9200 : GOTO 9080
9100 NEXT
9110 IF i>1 THEN ca=i : GOSUB 9200
9120 RETURN
9200 pf(0)=pf(0)+1
9210 pf(pf(0))=ca
9220 i=i/ca
9230 RETURN</syntaxhighlight>
 
==={{header|Craft Basic}}===
<syntaxhighlight lang="basic">define limit = 20, loops = 0
 
dim list[limit]
 
input "loops?", loops
 
for x = 1 to loops
 
let n = x
print n, " : ",
gosub collectprimefactors
 
for y = 0 to c
 
if list[y] then
 
print list[y], " ",
let list[y] = 0
 
endif
 
next y
 
print ""
 
next x
 
end
 
sub collectprimefactors
 
let c = 0
 
do
 
if int(n mod 2) = 0 then
 
let n = int(n / 2)
let list[c] = 2
let c = c + 1
 
endif
 
wait
 
loop int(n mod 2) = 0
 
for i = 3 to sqrt(n) step 2
 
do
 
if int(n mod i) = 0 then
 
let n = int(n / i)
let list[c] = i
let c = c + 1
 
endif
 
wait
 
loop int(n mod i) = 0
 
next i
 
if n > 2 then
 
let list[c] = n
let c = c + 1
 
endif
 
return</syntaxhighlight>
{{out| Output}}<pre>
loops? 20
1 :
2 : 2
3 : 3
4 : 2 2
5 : 5
6 : 2 3
7 : 7
8 : 2 2 2
9 : 3 3
10 : 2 5
11 : 11
12 : 2 2 3
13 : 13
14 : 2 7
15 : 3 5
16 : 2 2 2 2
17 : 17
18 : 2 3 3
19 : 19
20 : 2 2 5
</pre>
 
==={{header|FreeBASIC}}===
<syntaxhighlight lang="freebasic">' FB 1.05.0 Win64
 
Function isPrime(n As Integer) As Boolean
If n Mod 2 = 0 Then Return n = 2
If n Mod 3 = 0 Then Return n = 3
Dim d As Integer = 5
While d * d <= n
If n Mod d = 0 Then Return False
d += 2
If n Mod d = 0 Then Return False
d += 4
Wend
Return True
End Function
 
Sub getPrimeFactors(factors() As UInteger, n As UInteger)
If n < 2 Then Return
If isPrime(n) Then
Redim factors(0 To 0)
factors(0) = n
Return
End If
Dim factor As UInteger = 2
Do
If n Mod factor = 0 Then
Redim Preserve factors(0 To UBound(factors) + 1)
factors(UBound(factors)) = factor
n \= factor
If n = 1 Then Return
If isPrime(n) Then factor = n
Else
factor += 1
End If
Loop
End Sub
 
Dim factors() As UInteger
Dim primes(1 To 17) As UInteger = {2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59}
Dim n As UInteger
For i As UInteger = 1 To 17
Erase factors
n = 1 Shl primes(i) - 1
getPrimeFactors factors(), n
Print "2^";Str(primes(i)); Tab(5); " - 1 = "; Str(n); Tab(30);" => ";
For j As UInteger = LBound(factors) To UBound(factors)
Print factors(j);
If j < UBound(factors) Then Print " x ";
Next j
Print
Next i
Print
Print "Press any key to quit"
Sleep</syntaxhighlight>
 
{{out}}
<pre>
2^2 - 1 = 3 => 3
2^3 - 1 = 7 => 7
2^5 - 1 = 31 => 31
2^7 - 1 = 127 => 127
2^11 - 1 = 2047 => 23 x 89
2^13 - 1 = 8191 => 8191
2^17 - 1 = 131071 => 131071
2^19 - 1 = 524287 => 524287
2^23 - 1 = 8388607 => 47 x 178481
2^29 - 1 = 536870911 => 233 x 1103 x 2089
2^31 - 1 = 2147483647 => 2147483647
2^37 - 1 = 137438953471 => 223 x 616318177
2^41 - 1 = 2199023255551 => 13367 x 164511353
2^43 - 1 = 8796093022207 => 431 x 9719 x 2099863
2^47 - 1 = 140737488355327 => 2351 x 4513 x 13264529
2^53 - 1 = 9007199254740991 => 6361 x 69431 x 20394401
2^59 - 1 = 576460752303423487 => 179951 x 3203431780337
</pre>
 
==={{header|Palo Alto Tiny BASIC}}===
{{trans|Tiny BASIC|More structured composition is used (though created with <code>GOTO</code>s).}}
<syntaxhighlight lang="basic">
10 REM PRIME DECOMPOSITION
20 INPUT "ENTER A NUMBER"N
30 PRINT "--------------"
40 LET N=ABS(N)
50 IF N<2 STOP
60 LET I=2
70 IF I*I>N GOTO 150
80 LET M=N-(N/I)*I
90 IF M#0 GOTO 130
100 LET N=N/I
110 PRINT I
120 LET I=2
130 IF M#0 LET I=I+1
140 GOTO 70
150 PRINT N
160 STOP
</syntaxhighlight>
{{out}}
3 runs.
<pre>
ENTER A NUMBER:2520
--------------
2
2
2
3
3
5
7
</pre>
<pre>
ENTER A NUMBER:16384
--------------
2
2
2
2
2
2
2
2
2
2
2
2
2
2
</pre>
<pre>
ENTER A NUMBER:13
--------------
13
</pre>
 
==={{header|PureBasic}}===
{{works with|PureBasic|4.41}}
<syntaxhighlight lang="purebasic">
CompilerIf #PB_Compiler_Debugger
CompilerError "Turn off the debugger if you want reasonable speed in this example."
CompilerEndIf
 
Define.q
 
Procedure Factor(Number, List Factors())
Protected I = 3
While Number % 2 = 0
AddElement(Factors())
Factors() = 2
Number / 2
Wend
Protected Max = Number
While I <= Max And Number > 1
While Number % I = 0
AddElement(Factors())
Factors() = I
Number/I
Wend
I + 2
Wend
EndProcedure
 
Number = 9007199254740991
NewList Factors()
time = ElapsedMilliseconds()
Factor(Number, Factors())
time = ElapsedMilliseconds()-time
S.s = "Factored " + Str(Number) + " in " + StrD(time/1000, 2) + " seconds."
ForEach Factors()
S + #CRLF$ + Str(Factors())
Next
MessageRequester("", S)</syntaxhighlight>
{{out}}
<pre>Factored 9007199254740991 in 0.27 seconds.
6361
69431
20394401</pre>
 
==={{header|S-BASIC}}===
<syntaxhighlight lang="s-basic">
rem - return p mod q
function mod(p, q = integer) = integer
end = p - q * (p/q)
 
dim integer factors(16) rem log2(maxint) is sufficiently large
 
comment
Find the prime factors of n and store in global array factors
(arrays cannot be passed as parameters) and return the number
found. If n is prime, it will be stored as the only factor.
end
function primefactors(n = integer) = integer
var p, count = integer
p = 2
count = 1
while n >= (p * p) do
begin
if mod(n, p) = 0 then
begin
factors(count) = p
count = count + 1
n = n / p
end
else
p = p + 1
end
factors(count) = n
end = count
 
rem -- exercise the routine by checking odd numbers from 77 to 99
 
var i, k, nfound = integer
 
for i = 77 to 99 step 2
nfound = primefactors(i)
print i;"; ";
for k = 1 to nfound
print factors(k);
next k
print
next i
end
</syntaxhighlight>
{{out}}
<pre>
77: 7 11
79: 79
81: 3 3 3 3
83: 83
85: 5 17
87: 3 29
89: 89
91: 7 13
93: 3 31
95: 5 19
97: 97
99: 3 3 11
</pre>
 
==={{header|TI-83 BASIC}}===
<syntaxhighlight lang="ti83b">::prgmPREMIER
Disp "FACTEURS PREMIER"
Prompt N
If N<1:Stop
ClrList L1 ,L2
0→K
iPart(√(N))→L
N→M
For(I,2,L)
0→J
While fPart(M/I)=0
J+1→J
M/I→M
End
If J≠0
Then
K+1→K
I→L 1(K)
J→L2(K)
I→Z:prgmVSTR
" "+Str0→Str1
If J≠1
Then
J→Z:prgmVSTR
Str1+"^"+Str0→Str1
End
Disp Str1
End
If M=1:Stop
End
If M≠1
Then
If M≠N
Then
M→Z:prgmVSTR
" "+Str0→Str1
Disp Str1
Else
Disp "PREMIER"
End
End
::prgmVSTR
{Z,Z}→L5
{1,2}→L6
LinReg(ax+b)L6,L5,Y ₀
Equ►String(Y₀,Str0)
length(Str0)→O
sub(Str0,4,O-3)→Str0
ClrList L5,L6
DelVar Y </syntaxhighlight>
{{out}}
<pre>
FACTEURS PREMIER
N=?1047552
2^10
3
11
31
</pre>
 
==={{Header|Tiny BASIC}}===
{{works with|TinyBasic}}
<syntaxhighlight lang="basic">10 PRINT "Enter a number."
20 INPUT N
25 PRINT "------"
30 IF N<0 THEN LET N = -N
40 IF N<2 THEN END
50 LET I = 2
60 IF I*I > N THEN GOTO 200
70 IF (N/I)*I = N THEN GOTO 300
80 LET I = I + 1
90 GOTO 60
200 PRINT N
210 END
300 LET N = N / I
310 PRINT I
320 GOTO 50</syntaxhighlight>
{{out}}
<pre>
Enter a number.
32
------
2
2
2
2
2
 
Enter a number.
2520
------
2
2
2
3
3
5
7
 
Enter a number.
13
------
13
</pre>
 
==={{header|VBScript}}===
<syntaxhighlight lang="vb">Function PrimeFactors(n)
arrP = Split(ListPrimes(n)," ")
divnum = n
Do Until divnum = 1
'The -1 is to account for the null element of arrP
For i = 0 To UBound(arrP)-1
If divnum = 1 Then
Exit For
ElseIf divnum Mod arrP(i) = 0 Then
divnum = divnum/arrP(i)
PrimeFactors = PrimeFactors & arrP(i) & " "
End If
Next
Loop
End Function
 
Function IsPrime(n)
If n = 2 Then
IsPrime = True
ElseIf n <= 1 Or n Mod 2 = 0 Then
IsPrime = False
Else
IsPrime = True
For i = 3 To Int(Sqr(n)) Step 2
If n Mod i = 0 Then
IsPrime = False
Exit For
End If
Next
End If
End Function
 
Function ListPrimes(n)
ListPrimes = ""
For i = 1 To n
If IsPrime(i) Then
ListPrimes = ListPrimes & i & " "
End If
Next
End Function
 
WScript.StdOut.Write PrimeFactors(CInt(WScript.Arguments(0)))
WScript.StdOut.WriteLine</syntaxhighlight>
 
{{out}}
<pre>
C:\>cscript /nologo primefactors.vbs 12
2 3 2
 
C:\>cscript /nologo primefactors.vbs 50
2 5 5
</pre>
 
=={{header|Batch file}}==
Line 998 ⟶ 1,677:
1232126 ⟨ 2 7 17 31 167 ⟩
┘</syntaxhighlight>
 
=={{header|Bruijn}}==
{{trans|Haskell}}
<syntaxhighlight lang="bruijn">
:import std/Combinator .
:import std/List .
:import std/Math .
 
factors \divs primes
divs y [[&[[&[[3 ⋅ 3 >? 4 case-1 (=?0 case-2 case-3)]] (quot-rem 2 1)]]]]
case-1 4 >? (+1) {}4 empty
case-2 3 : (5 1 (3 : 2))
case-3 5 4 2
 
main [factors <$> ({ (+42) → (+50) })]
</syntaxhighlight>
{{out}}
<code>
?> {{2t, 3t, 7t}, {43t}, {2t, 2t, 11t}, {3t, 3t, 5t}, {2t, 23t}, {47t}, {2t, 2t, 2t, 2t, 3t}, {7t, 7t}, {2t, 5t, 5t}}
</code>
 
=={{header|Burlesque}}==
Line 1,686 ⟶ 2,385:
(recur (quot n k) k (cons k acc))
(recur n (inc k) acc)))))</syntaxhighlight>
 
=={{header|Commodore BASIC}}==
{{works_with|Commodore BASIC|2.0}}
It's not easily possible to have arbitrary precision integers in PET basic, so here is at least a version using built-in data types (reals). On return from the subroutine starting at 9000 the global array pf contains the number of factors followed by the factors themselves:
<syntaxhighlight lang="zxbasic">9000 REM ----- function generate
9010 REM in ... i ... number
9020 REM out ... pf() ... factors
9030 REM mod ... ca ... pf candidate
9040 pf(0)=0 : ca=2 : REM special case
9050 IF i=1 THEN RETURN
9060 IF INT(i/ca)*ca=i THEN GOSUB 9200 : GOTO 9050
9070 FOR ca=3 TO INT( SQR(i)) STEP 2
9080 IF i=1 THEN RETURN
9090 IF INT(i/ca)*ca=i THEN GOSUB 9200 : GOTO 9080
9100 NEXT
9110 IF i>1 THEN ca=i : GOSUB 9200
9120 RETURN
9200 pf(0)=pf(0)+1
9210 pf(pf(0))=ca
9220 i=i/ca
9230 RETURN</syntaxhighlight>
 
=={{header|Common Lisp}}==
Line 1,863 ⟶ 2,541:
return factors
}</syntaxhighlight>
 
=={{header|EasyLang}}==
<syntaxhighlight lang="easylang">
proc decompose num . primes[] .
primes[] = [ ]
t = 2
while t * t <= num
if num mod t = 0
primes[] &= t
num = num / t
else
t += 1
.
.
primes[] &= num
.
decompose 9007199254740991 r[]
print r[]
</syntaxhighlight>
 
=={{header|EchoLisp}}==
Line 1,940 ⟶ 2,637:
 
{{out}}<pre>[71,839,1471,6857]</pre>
 
=={{header|Elm}}==
<syntaxhighlight lang="elm" line="1">
module Main exposing (main)
 
import Html exposing (Html, div, h1, text)
import Html.Attributes exposing (style)
 
-- See live:
-- <nowiki>https://ellie-app.com/pMYxVPQ4fvca1</nowiki>
 
accumulator : List Int
accumulator =
    []
 
compositeNr = 84894624407
 
ts =
    showFactors compositeNr 2 accumulator
 
 
main =
        div
            [ style "margin" "5%"
            , style "font-size" "1.5em"
            , style "color" "blue"
            ]
            [ h1 [] [ text "Prime Factorizer" ]
            , text
                ("Prime factors: "
                    ++ listAsString ts
                    ++ " from number "
                    ++ String.fromInt (List.product ts)
                )
            ]
 
 
showFactors : Int -> Int -> List Int -> List Int
showFactors number factor acc =
    if number < 2 then
        acc
        -- returns the final result if number < 2
    else if
        modBy factor number == 0
        -- modulo used to get prime factors
then let
            v2 : List Int
            v2 =
                factor :: acc
            number2 : Int
            number2 =
                number // factor
        in
        showFactors number2 factor v2
        -- recursive call
        -- this modulus function is used
        -- in order to output factor !=2
    else
        let
            factor2 : Int
            factor2 =
                factor + 1
        in
        showFactors number factor2 acc
 
listAsString : List Int -> String
listAsString myList =
    List.map String.fromInt myList
        |> List.map (\el -> " " ++ el)
        |> List.foldl (++) " "
 
</syntaxhighlight>
{{out}}
Prime factors: 3067 4357 6353 from number 84894624407
 
=={{header|Elixir}}==
Line 1,992 ⟶ 2,763:
 
=={{header|ERRE}}==
{{trans|Commodore BASIC}}
<syntaxhighlight lang="erre">
PROGRAM DECOMPOSE
Line 2,043 ⟶ 2,815:
END PROGRAM
</syntaxhighlight>
This version is a translation from Commodore BASIC program.
 
=={{header|Ezhil}}==
Line 2,280 ⟶ 3,051:
end program Primes</syntaxhighlight>
 
=={{header|FreeBASIC}}==
<syntaxhighlight lang="freebasic">' FB 1.05.0 Win64
 
Function isPrime(n As Integer) As Boolean
If n Mod 2 = 0 Then Return n = 2
If n Mod 3 = 0 Then Return n = 3
Dim d As Integer = 5
While d * d <= n
If n Mod d = 0 Then Return False
d += 2
If n Mod d = 0 Then Return False
d += 4
Wend
Return True
End Function
 
Sub getPrimeFactors(factors() As UInteger, n As UInteger)
If n < 2 Then Return
If isPrime(n) Then
Redim factors(0 To 0)
factors(0) = n
Return
End If
Dim factor As UInteger = 2
Do
If n Mod factor = 0 Then
Redim Preserve factors(0 To UBound(factors) + 1)
factors(UBound(factors)) = factor
n \= factor
If n = 1 Then Return
If isPrime(n) Then factor = n
Else
factor += 1
End If
Loop
End Sub
 
Dim factors() As UInteger
Dim primes(1 To 17) As UInteger = {2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59}
Dim n As UInteger
For i As UInteger = 1 To 17
Erase factors
n = 1 Shl primes(i) - 1
getPrimeFactors factors(), n
Print "2^";Str(primes(i)); Tab(5); " - 1 = "; Str(n); Tab(30);" => ";
For j As UInteger = LBound(factors) To UBound(factors)
Print factors(j);
If j < UBound(factors) Then Print " x ";
Next j
Print
Next i
Print
Print "Press any key to quit"
Sleep</syntaxhighlight>
 
{{out}}
<pre>
2^2 - 1 = 3 => 3
2^3 - 1 = 7 => 7
2^5 - 1 = 31 => 31
2^7 - 1 = 127 => 127
2^11 - 1 = 2047 => 23 x 89
2^13 - 1 = 8191 => 8191
2^17 - 1 = 131071 => 131071
2^19 - 1 = 524287 => 524287
2^23 - 1 = 8388607 => 47 x 178481
2^29 - 1 = 536870911 => 233 x 1103 x 2089
2^31 - 1 = 2147483647 => 2147483647
2^37 - 1 = 137438953471 => 223 x 616318177
2^41 - 1 = 2199023255551 => 13367 x 164511353
2^43 - 1 = 8796093022207 => 431 x 9719 x 2099863
2^47 - 1 = 140737488355327 => 2351 x 4513 x 13264529
2^53 - 1 = 9007199254740991 => 6361 x 69431 x 20394401
2^59 - 1 = 576460752303423487 => 179951 x 3203431780337
</pre>
 
=={{header|Frink}}==
Line 3,244 ⟶ 3,940:
prime_dec(2^4*3^5*5*7^2);
/* [2, 2, 2, 2, 3, 3, 3, 3, 3, 5, 7, 7] */</syntaxhighlight>
 
=={{header|Modula-2}}==
{{trans|XPL0|<code>CARDINAL</code> (unsigned integer) used instead of signed integer.}}
{{works with|ADW Modula-2|any (Compile with the linker option ''Console Application'').}}
<syntaxhighlight lang="modula2">
MODULE PrimeDecomposition;
 
FROM STextIO IMPORT
SkipLine, WriteLn, WriteString;
FROM SWholeIO IMPORT
ReadCard, WriteInt;
 
CONST
MaxFacIndex = 31;
(* 2^31 has most prime factors (31 twos) than other 32-bit unsigned integer. *)
 
TYPE
TFacs = ARRAY [0 .. MaxFacIndex] OF CARDINAL;
 
VAR
Facs: TFacs;
I, N, FacsCnt: CARDINAL;
PROCEDURE CalcFacs(N: CARDINAL; VAR Facs: TFacs; VAR FacsCnt: CARDINAL);
VAR
I: CARDINAL;
BEGIN
FacsCnt := 0;
IF N >= 2 THEN
I := 2;
WHILE I * I <= N DO
IF N MOD I = 0 THEN
N := N DIV I;
Facs[FacsCnt] := I;
FacsCnt := FacsCnt + 1;
I := 2
ELSE
I := I + 1
END
END;
Facs[FacsCnt] := N;
FacsCnt := FacsCnt + 1
END;
END CalcFacs;
 
BEGIN
WriteString("Enter a number: ");
ReadCard(N);
SkipLine;
CalcFacs(N, Facs, FacsCnt);
(* There is at least one factor *)
IF FacsCnt > 1 THEN
FOR I := 0 TO FacsCnt - 2 DO
WriteInt(Facs[I], 1);
WriteString(" ")
END;
END;
WriteInt(Facs[FacsCnt - 1], 1);
WriteLn
END PrimeDecomposition.
</syntaxhighlight>
{{out}} 3 runs.
<pre>
Enter a number: 32
2 2 2 2 2
</pre>
<pre>
Enter a number: 2520
2 2 2 3 3 5 7
</pre>
<pre>
Enter a number: 13
13
</pre>
 
=={{header|MUMPS}}==
Line 3,598 ⟶ 4,368:
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"2^%d-1 = %s\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">pi</span><span style="color: #0000FF;">,</span><span style="color: #000000;">zs</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #004080008080;">stringfor</span> <span style="color: #000000;">s</span> <span style="color: #008080;">in</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"600851475143"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"600851475143100000000000000000037"</span><span style="color: #0000FF;">}</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">2</span> <span style="color: #008080;">do</span>
<span style="color: #7060A8;">mpz_set_str</span><span style="color: #0000FF;">(</span><span style="color: #000000;">z</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s = %s\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">s</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">mpz_factorstring</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">mpz_pollard_rho</span><span style="color: #0000FF;">(</span><span style="color: #000000;">z</span><span style="color: #0000FF;">))})</span>
<span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"100000000000000000037"</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #0000FF;">?</span><span style="color: #7060A8;">elapsed</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">time</span><span style="color: #0000FF;">()-</span><span style="color: #000000;">t0</span><span style="color: #0000FF;">)</span>
Line 3,635 ⟶ 4,403:
600851475143 = 71*839*1471*6857
100000000000000000037 = 31*821*59004541*66590107
"10.1s9s"
</pre>
 
Line 3,716 ⟶ 4,484:
{{out}}
<pre>-> (3 11 31 131 2731 8191 409891 7623851 145295143558111)</pre>
 
=={{header|PL/0}}==
{{trans|Tiny BASIC}}
The overlapping loops, created with <code>GOTO</code>s in the original version, have been replaced with structures with single entries and single exits (like in structured programming).
 
The program waits for a number, and then displays the prime factors of the number.
<syntaxhighlight lang="pascal">
var i, n, nmodi;
begin
? n;
if n < 0 then n := -n;
if n >= 2 then
begin
i := 2;
while i * i <= n do
begin
nmodi := n - (n / i) * i;
if nmodi = 0 then
begin
n := n / i;
! i;
i := 2
end;
if nmodi <> 0 then
i := i + 1
end;
! n
end;
end.
</syntaxhighlight>
3 runs.
{{in}}
<pre>2520</pre>
{{out}}
<pre>
2
2
2
3
3
5
7
</pre>
{{in}}
<pre>16384</pre>
{{out}}
<pre>
2
2
2
2
2
2
2
2
2
2
2
2
2
2
</pre>
{{in}}
<pre>13</pre>
{{out}}
<pre>
13
</pre>
 
=={{header|PL/I}}==
Line 3,800 ⟶ 4,636:
$prime
}
"$(prime-decomposition 12)"
"$(prime-decomposition 100)"
</syntaxhighlight>
<b>Output:</b>
Line 3,808 ⟶ 4,644:
2 2 5 5
</pre>
Alternative version, significantly faster with big numbers
<syntaxhighlight lang="powershell">
function prime-decomposition ($n) {
$values = [System.Collections.Generic.List[string]]::new()
while ((($n % 2) -eq 0) -and ($n -gt 2)) {
$values.Add(2)
$n /= 2
}
for ($i = 3; $n -ge ($i * $i); $i += 2) {
if (($n % $i) -eq 0){
$values.Add($i)
$n /= $i
$i -= 2
}
}
$values.Add($n)
return $values
}
"$(prime-decomposition 1000000)"
</syntaxhighlight>
 
=={{header|Prolog}}==
Line 3,949 ⟶ 4,805:
= factor (k+2) n otherwise;
end;</syntaxhighlight>
 
=={{header|PureBasic}}==
{{works with|PureBasic|4.41}}
<syntaxhighlight lang="purebasic">
CompilerIf #PB_Compiler_Debugger
CompilerError "Turn off the debugger if you want reasonable speed in this example."
CompilerEndIf
 
Define.q
 
Procedure Factor(Number, List Factors())
Protected I = 3
While Number % 2 = 0
AddElement(Factors())
Factors() = 2
Number / 2
Wend
Protected Max = Number
While I <= Max And Number > 1
While Number % I = 0
AddElement(Factors())
Factors() = I
Number/I
Wend
I + 2
Wend
EndProcedure
 
Number = 9007199254740991
NewList Factors()
time = ElapsedMilliseconds()
Factor(Number, Factors())
time = ElapsedMilliseconds()-time
S.s = "Factored " + Str(Number) + " in " + StrD(time/1000, 2) + " seconds."
ForEach Factors()
S + #CRLF$ + Str(Factors())
Next
MessageRequester("", S)</syntaxhighlight>
{{out}}
<pre>Factored 9007199254740991 in 0.27 seconds.
6361
69431
20394401</pre>
 
=={{header|Python}}==
 
===Python: Using Croft Spiral sieve===
Note: the program below is saved to file <code>prime_decomposition.py</code> and imported as a library [[Least_common_multiple#Python|here]], [[Semiprime#Python|here]], [[Almost_prime#Python|here]], [[Emirp primes#Python|here]] and [[Extensible_prime_generator#Python|here]].
Line 4,001 ⟶ 4,813:
 
import sys
from itertools import islice, cycle, count
 
try:
from itertools import compress
except ImportError:
def compress(data, selectors):
"""compress('ABCDEF', [1,0,1,0,1,1]) --> A C E F"""
return (d for d, s in zip(data, selectors) if s)
 
 
def is_prime(n):
return list(zip((True, False), decompose(n)))[-1][0]
 
class IsPrimeCached(dict):
def __missing__(self, n):
Line 4,019 ⟶ 4,823:
self[n] = r
return r
 
is_prime_cached = IsPrimeCached()
 
def croft():
"""Yield prime integers using the Croft Spiral sieve.
Line 4,037 ⟶ 4,841:
for p in (2, 3, 5):
yield p
roots = {9: 3, 25: 5} # Map x*d**2 -> 2*d.
primerootsnot_primeroot = frozenset(tuple(x not in {1, 7, 11, 13, 17, 19, 23, 29} for x in range(30))
q = 1
selectors = (1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 0, 1, 1, 0, 0)
for qx in compresscycle((6, 4, 2, 4, 2, 4, 6, 2)):
# Iterate over prime candidates 7, 911, 1113, 1317, ...
q += islice(count(7), 0, None, 2),x
# Mask out those that can't possibly be prime.
cycle(selectors)
):
# Using dict membership testing instead of pop gives a
# 5-10% speedup over the first three million primes.
if q in roots:
p = roots[.pop(q])
delx = roots[q] + p
while not_primeroot[x =% q30] or x +in 2*proots:
while x in roots or (x % 30) not in+= primeroots:p
x += 2*p
roots[x] = p
else:
roots[q * q] = q + q
yield q
primes = croft
 
def decompose(n):
for p in primes():
Line 4,072 ⟶ 4,872:
if __name__ == '__main__':
# Example: calculate factors of Mersenne numbers to M59 #
 
import time
 
for m in primes():
p = 2 ** m - 1
Line 4,082 ⟶ 4,882:
print(factor, end=' ')
sys.stdout.flush()
 
print( "=> {0:.2f}s".format( time.time()-start ) )
if m >= 59:
Line 4,154 ⟶ 4,954:
=={{header|Quackery}}==
 
<code>prime</code> is defined at [[Miller-Rabin primality test#Quackery]].
<syntaxhighlight lang="quackery"> [ [] swap
 
<syntaxhighlight lang="quackery"> [ dup prime iff
nested done
[] swap
dup times
[ [ dup i^ 2 + /modprime
not if done
[ dup i^ 2 + /mod
0 = while
nip dip
Line 4,163 ⟶ 4,969:
drop
dup 1 = if conclude ]
drop ] is primefactors ( n --> [ )</syntaxhighlight>
 
1047552 primefactors echo</syntaxhighlight>
 
{{out}}
Line 4,364 ⟶ 5,168:
A method exists in this REXX program to also test Mersenne-type numbers &nbsp; <big>(2<sup>n</sup> - 1)</big>.
 
Since the majority of computing time is spent looking for primes, that part of the program was
<br>optimized somewhat (but could be extended if more optimization is wanted).
<syntaxhighlight lang="rexx"></*REXX pgm does prime decomposition of a range of positive integers (with a prime count)*/syntaxhighlight>
/*REXX pgm does prime decomposition of a range of positive integers (with a prime count)*/
numeric digits 1000 /*handle thousand digits for the powers*/
parseNumeric argDigits 1000 bot top step base add /*gethandle optionalthousand argumentsdigits fromFor the C.L. powers*/
ifParse Arg bot=='' top then do;step bot=1; top=100; end base add /*noget optional BOTarguments given? Then usefrom the defaultC.L. */
If bot='?' Then Do
if top=='' then top=bot /* " TOP? " " " " " */
Say 'rexx pfoo bot top step base add'
if step=='' then step= 1 /* " STEP? " " " " " */
Exit
if add =='' then add= -1 /* " ADD? " " " " " */
End
tell= top>0; top=abs(top) /*if TOP is negative, suppress displays*/
wIf bot==length(top)'' Then /* no arguments given /*get maximum width for aligned display*/
Parse Value 1 100 With bot top /* set default range .*/
if base\=='' then w=length(base**top) /*will be testing powers of two later? */
If top=='' Then top=bot /* process one number */
@.=left('', 7); @.0="{unity}"; @.1='[prime]' /*some literals: pad; prime (or not).*/
numericIf digitsstep=='' max(9,Then w+step=1) /* step=2 to process only odd numbers /*maybe increase the digits precision. */
#=0If add =='' Then add=-1 /* for Mersenne tests /*#: is the number of primes found. */
tell=top>0 do n=bot to top by step /*process a single numberIf TOP oris negative, asuppress range.displays*/
top=abs(top)
?=n; if base\=='' then ?=base**n + add /*should we perform a "Mercenne" test? */
w=length(top) pf=factr(?); f=words(pf) /*get primemaximum factors;width numberFor ofaligned factors.display*/
If base\=='' Then
if f==1 then #=#+1 /*Is N prime? Then bump prime counter.*/
w=length(base**top) if tell then say right(?,w) right('('f")",9) 'prime/*will factors:be ' @.ftesting powers of two later? pf*/
tag.=left('', 7) /*some literals: pad; prime (or not).*/
end /*n*/
tag.0='{unity}'
say
tag.1='[prime]'
ps= 'primes'; if p==1 then ps= "prime" /*setup for proper English in sentence.*/
sayNumeric rightDigits max(#9, w+9+1) ps 'found.' /*displaymaybe increase the numberdigits of primes foundprecision. */
exit np=0 /*sticknp: a fork in it,is the we'renumber allof doneprimes found. */
Do n=bot To top by step /*process a single number or a range. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
?=n
factr: procedure; parse arg x 1 d,$ /*set X, D to argument 1; $ to null.*/
if x If base\==1 then return '' Then /*handleshould thewe specialperform casea of X = 1.'Mersenne' test? */
?=base**n+add
do while x//2==0; $=$ 2; x=x%2; end /*append all the 2 factors of new X.*/
pf=factr(?) do while x//3==0; $=$ 3; x=x%3; end /* " "/* get prime "factors 3 " " " " */
f=words(pf) do while x//5==0; $=$ 5; x=x%5; end /* " " " /* 5number of prime factors " " " " */
If f=1 Then do while x//7==0; $=$ 7; x=x%7; end /* " " /* " If the 7number is prime " " " " */
np=np+1 /* Then bump prime counter ___*/
If tell Then
q=1; do while q<=x; q=q*4; end /*these two lines compute integer √ X */
Say right(?,w) right('('f')',9) 'prime factors: ' tag.f pf
r=0; do while q>1; q=q%4; _=d-r-q; r=r%2; if _>=0 then do; d=_; r=r+q; end; end
End /*n*/
Say ''
ps='prime'
If f>1 Then ps=ps's' /*setup For proper English in sentence.*/
Say right(np, w+9+1) ps 'found.' /*display the number of primes found. */
Exit /*stick a fork in it, we're all done. */
/*---------------------------------------------------------------------------*/
factr: Procedure
Parse Arg x 1 d,pl /*set X, D to argument 1, pl to null */
If x==1 Then Return '' /*handle the special case of X=1. */
primes=2 3 5 7
Do While primes>'' /* first check the small primes */
Parse Var primes prime primes
Do While x//prime==0
pl=pl prime
x=x%prime
End
End
r=isqrt(x)
Do j=11 by 6 To r /*insure that J isn't divisible by 3. */
Parse var j '' -1 _ /*obtain the last decimal digit of J. */
If _\==5 Then Do
Do While x//j==0
pl=pl j
x=x%j
End /*maybe reduce by J. */
End
If _ ==3 Then Iterate /*If next Y is divisible by 5? Skip. */
y=j+2
Do While x//y==0
pl=pl y
x=x%y
End /*maybe reduce by y. */
End /*j*/
 
If do jx==11 by 6 to r 1 Then Return pl /*insureIs thatresidual=unity? Then J isndon't divisible by 3append.*/
parse var j '' -1 _ Return pl x /*obtainreturn the last decimalpl digit of with Jappended residual. */
 
if _\==5 then do while x//j==0; $=$ j; x=x%j; end /*maybe reduce by J. */
isqrt: Procedure
if _ ==3 then iterate /*Is next Y is divisible by 5? Skip.*/
Parse Arg x
y=j+2; do while x//y==0; $=$ y; x=x%y; end /*maybe reduce by J. */
x=abs(x)
end /*j*/
Parse Value 0 x with lo hi
/* [↓] The $ list has a leading blank.*/
Do While lo<=hi
if x==1 then return $ /*Is residual=unity? Then don't append.*/
t=(lo+hi)%2
return $ x /*return $ with appended residual. */</syntaxhighlight>
If t**2>x Then
hi=t-1
Else
lo=t+1
End
Return t
'''output''' &nbsp; when using the default input of: &nbsp; <tt> 1 &nbsp; 100 </tt>
 
Line 4,414 ⟶ 5,258:
 
<pre style="font-size:75%;height:160ex">
 
1 (0) prime factors: {unity}
2 (1) prime factors: [prime] 2
Line 4,540 ⟶ 5,385:
 
<pre style="font-size:75%>
 
3 (1) prime factors: [prime] 3
7 (1) prime factors: [prime] 7
Line 4,552 ⟶ 5,398:
4095 (5) prime factors: 3 3 5 7 13
8191 (1) prime factors: [prime] 8191
16383 (23) prime factors: 3 546143 127
32767 (23) prime factors: 7 468131 151
65535 (4) prime factors: 3 5 17 257
131071 (1) prime factors: [prime] 131071
262143 (56) prime factors: 3 3 3 7 138719 73
524287 (1) prime factors: [prime] 524287
1048575 (6) prime factors: 3 5 5 11 41 31 41
2097151 (34) prime factors: 7 7 42799127 337
4194303 (4) prime factors: 3 23 89 683
8388607 (2) prime factors: 47 178481
16777215 (7) prime factors: 3 3 5 7 13 17 241
33554431 (13) prime factors: [prime] 33554431 31 601 1801
67108863 (23) prime factors: 3 223696212731 8191
134217727 (23) prime factors: 7 1917396173 262657
268435455 (56) prime factors: 3 5 29 43 113 5461127
536870911 (3) prime factors: 233 1103 2089
1073741823 (57) prime factors: 3 3 7 11 154941131 151 331
2147483647 (1) prime factors: [prime] 2147483647
4294967295 (5) prime factors: 3 5 17 257 65537
8589934591 (4) prime factors: 7 23 89 599479
17179869183 (3) prime factors: 3 43691 131071
34359738367 (34) prime factors: 31 71 122921127 3937122921
68719476735 (710) prime factors: 3 3 3 5 7 13 559377119 37 73 109
137438953471 (12) prime factors: [prime] 137438953471 223 616318177
274877906943 (23) prime factors: 3 91625968981174763 524287
549755813887 (24) prime factors: 7 7853654484179 8191 121369
1099511627775 (78) prime factors: 3 5 5 11 17 31 41 191211161681
2199023255551 (2) prime factors: 13367 164511353
4398046511103 (58) prime factors: 3 3 7 7 997289458343 127 337 5419
8796093022207 (3) prime factors: 431 9719 2099863
17592186044415 (67) prime factors: 3 5 23 89 397 683 8388612113
35184372088831 (26) prime factors: 7 502633886983331 73 151 631 23311
70368744177663 (4) prime factors: 3 47 178481 2796203
140737488355327 (23) prime factors: 2351 598628193774513 13264529
281474976710655 (810) prime factors: 3 3 5 7 13 17 97 241 257 15732721673
562949953421311 (12) prime factors: [prime] 562949953421311 127 4432676798593
1125899906842623 (47) prime factors: 3 11 31 251 135928999981601 1801 4051
 
11 8 primes found.
</pre>
'''output''' &nbsp; when using the input of: &nbsp; <tt> 1 &nbsp; 50 &nbsp; 1 &nbsp; 2 &nbsp; +1 </tt>
Line 4,616 ⟶ 5,462:
65537 (1) prime factors: [prime] 65537
131073 (2) prime factors: 3 43691
262145 (34) prime factors: 5 13 403337 109
524289 (2) prime factors: 3 174763
1048577 (2) prime factors: 17 61681
2097153 (34) prime factors: 3 3 23301743 5419
4194305 (23) prime factors: 5 838861397 2113
8388609 (2) prime factors: 3 2796203
16777217 (23) prime factors: 97 257 65281673
33554433 (4) prime factors: 3 11 251 4051
67108865 (4) prime factors: 5 53 1613 157 1613
134217729 (56) prime factors: 3 3 3 3 165700919 87211
268435457 (2) prime factors: 17 15790321
536870913 (3) prime factors: 3 59 3033169
1073741825 (56) prime factors: 5 5 13 41 8058161 1321
2147483649 (2) prime factors: 3 715827883
4294967297 (2) prime factors: 641 6700417
8589934593 (45) prime factors: 3 3 67 683 139741920857
17179869185 (4) prime factors: 5 137 953 26317
34359738369 (5) prime factors: 3 11 43 281 86171 43
68719476737 (24) prime factors: 17 4042322161241 433 38737
137438953473 (23) prime factors: 3 458129844911777 25781083
274877906945 (24) prime factors: 5 54975581389229 457 525313
549755813889 (34) prime factors: 3 3 610839793212731 22366891
1099511627777 (2) prime factors: 257 4278255361
2199023255553 (3) prime factors: 3 83 8831418697
4398046511105 (56) prime factors: 5 13 29 113 206476211429 14449
8796093022209 (2) prime factors: 3 2932031007403
17592186044417 (3) prime factors: 17 353 2931542417
35184372088833 (57) prime factors: 3 3 3 11 11846589928919 331 18837001
70368744177665 (45) prime factors: 5 277 1013 302691657 45898930269
140737488355329 (23) prime factors: 3 46912496118443283 165768537521
281474976710657 (23) prime factors: 193 65537 429490176122253377
562949953421313 (23) prime factors: 3 18764998447377143 4363953127297
1125899906842625 (67) prime factors: 5 5 5 41 101 21751266018101 268501
 
5 primes found.
Line 4,656 ⟶ 5,502:
This REXX version is about &nbsp; '''20%''' &nbsp; faster than the 1<sup>st</sup> REXX version when factoring one million numbers.
<syntaxhighlight lang="rexx">/*REXX pgm does prime decomposition of a range of positive integers (with a prime count)*/
numericNumeric digitsDigits 1000 /*handle thousand digits forFor the powers*/
parseParse argArg bot top step base add /*get optional arguments from the C.L. */
If bot='?' Then Do
if bot=='' then do; bot=1; top=100; end /*no BOT given? Then use the default.*/
Say 'rexx pfoo bot top step base add'
if top=='' then top=bot /* " TOP? " " " " " */
Exit
if step=='' then step= 1 /* " STEP? " " " " " */
End
if add =='' then add= -1 /* " ADD? " " " " " */
tellIf bot=='' top>0;Then top=abs(top) /*if TOPno arguments given is negative, suppress displays*/
w=length(top) Parse Value 1 100 With bot top /* set default range /*get maximum width for aligned display.*/
ifIf base\top=='' Then then w=length(base**top)=bot /*will beprocess one number testing powers of two later? */
If step=='' Then step=1 /* step=2 to process only odd numbers */
@.=left('', 7); @.0="{unity}"; @.1='[prime]' /*some literals: pad; prime (or not).*/
numericIf digitsadd max(9,=='' w+Then add=-1) /* for Mersenne tests /*maybe increase the digits precision. */
#tell=top>0 /*#: If TOP is the number of primesnegative, found.suppress displays*/
top=abs(top)
do n=bot to top by step /*process a single number or a range.*/
w=length(top) ?=n; if base\=='' then ?=base**n + add /*should weget performmaximum awidth "Mercenne"For test?aligned display*/
If base\=='' Then
pf=factr(?); f=words(pf) /*get prime factors; number of factors.*/
if fw==1 then #=#+1 length(base**top) /*Iswill Nbe prime?testing powers Thenof bumptwo primelater? counter.*/
tag.=left('', 7) if tell then say right(?,w) right('('f")",9) 'prime factors: ' /*some literals: @.fpad; prime (or pfnot).*/
tag.0='{unity}'
end /*n*/
tag.1='[prime]'
say
ps=Numeric 'primes';Digits max(9,w+1) if p==1 then ps= "prime" /*setupmaybe forincrease properthe Englishdigits in sentenceprecision. */
saynp=0 right(#, w+9+1) ps 'found.' /*displaynp: is the number of primes found. */
exit Do n=bot To top by step /*stickprocess a forksingle innumber it,or a we'rerange. all done. */
?=n
/*──────────────────────────────────────────────────────────────────────────────────────*/
factr: procedure; If parsebase\=='' argThen x 1 d,$ /*set X, D /*should to argument 1;we perform $a 'Mersenne' totest? null.*/
?=base**n+add
if x==1 then return '' /*handle the special case of X = 1. */
pf=factr(?) do while x// 2==0; $=$ 2; x=x%2; end /*append allget prime factors the 2 factors of new X.*/
f=words(pf) do while x// 3==0; $=$ 3; x=x%3; end /* " " " /* 3number of prime factors " " " " */
If f=1 Then do while x// 5==0; $=$ 5; x=x%5; end /* " " /* " If the 5number is prime " " " " */
np=np+1 do while x// 7==0; $=$ 7; x=x%7; end /* " " " /* 7Then bump prime counter " " " " */
If tell Then
do while x//11==0; $=$ 11; x=x%11; end /* " " " 11 " " " " */ /* ◄■■■■ added.*/
Say right(?,w) right('('f')',9) 'prime factors: ' tag.f pf
do while x//13==0; $=$ 13; x=x%13; end /* " " " 13 " " " " */ /* ◄■■■■ added.*/
End /*n*/
do while x//17==0; $=$ 17; x=x%17; end /* " " " 17 " " " " */ /* ◄■■■■ added.*/
Say ''
do while x//19==0; $=$ 19; x=x%19; end /* " " " 19 " " " " */ /* ◄■■■■ added.*/
ps='prime'
do while x//23==0; $=$ 23; x=x%23; end /* " " " 23 " " " " */ /* ◄■■■■ added.*/
If f>1 Then ps=ps's' /*setup For proper English in ___sentence.*/
Say right(np, w+9+1) ps 'found.' /*display the number of primes found. */
q=1; do while q<=x; q=q*4; end /*these two lines compute integer √ X */
Exit /*stick a fork in it, we're all done. */
r=0; do while q>1; q=q%4; _=d-r-q; r=r%2; if _>=0 then do; d=_; r=r+q; end; end
/*---------------------------------------------------------------------------*/
factr: Procedure
Parse Arg x 1 d,pl /*set X, D to argument 1, pl to null */
If x==1 Then Return '' /*handle the special case of X=1. */
primes=2 3 5 7 11 13 17 19 23
Do While primes>'' /* first check the small primes */
Parse Var primes prime primes
Do While x//prime==0
pl=pl prime
x=x%prime
End
End
r=isqrt(x)
Do j=29 by 6 To r /*insure that J isn't divisible by 3.*/
Parse var j '' -1 _ /*obtain the last decimal digit of J. */
If _\==5 Then Do
Do While x//j==0
pl=pl j
x=x%j
End /*maybe reduce by J. */
End
If _ ==3 Then Iterate /*If next Y is divisible by 5? Skip. */
y=j+2
Do While x//y==0
pl=pl y
x=x%y
End /*maybe reduce by y. */
End /*j*/
If x==1 Then Return pl /*Is residual=unity? Then don't append.*/
Return pl x /*return pl with appended residual.*/
 
isqrt: Procedure
do j=29 by 6 to r /*insure that J isn't divisible by 3.*/ /* ◄■■■■ changed.*/
Parse Arg x
parse var j '' -1 _ /*obtain the last decimal digit of J. */
x=abs(x)
if _\==5 then do while x//j==0; $=$ j; x=x%j; end /*maybe reduce by J. */
Parse Value 0 x with lo hi
if _ ==3 then iterate /*Is next Y is divisible by 5? Skip.*/
Do While lo<=hi
y=j+2; do while x//y==0; $=$ y; x=x%y; end /*maybe reduce by J. */
end /*j*/t=(lo+hi)%2
If t**2>x Then
/* [↓] The $ list has a leading blank.*/
hi=t-1
if x==1 then return $ /*Is residual=unity? Then don't append.*/
Else
return $ x /*return $ with appended residual. */</syntaxhighlight>
lo=t+1
End
Return t</syntaxhighlight>
'''output''' &nbsp; is identical to the 1<sup>st</sup> REXX version. <br><br>
 
Line 4,728 ⟶ 5,607:
return 1
</syntaxhighlight>
 
=={{header|RPL}}==
≪ { } SWAP DUP √ CEIL → lim
≪ 2
'''WHILE''' OVER 1 > OVER lim ≤ AND '''REPEAT'''
DUP2 /
'''IF''' DUP FP
'''THEN''' DROP DUP 2 ≠ + 1 +
'''ELSE''' SWAP ROT DROP ROT OVER + ROT ROT '''END'''
'''END''' DROP
'''IF''' DUP 1 ≠ '''THEN''' + '''ELSE''' DROP '''END'''
≫ ≫ ‘'''PDIV'''’ STO
 
1048 '''PDIV'''
{{out}}
<pre>
1: { 2 2 2 131 }
</pre>
===Version for binary integers===
{{trans|Forth}}
≪ { } → pdiv
≪ #2
'''WHILE''' DUP2 DUP * ≥ '''REPEAT'''
'''IF''' DUP2 / LAST 3 PICK * -
'''THEN''' DROP 1 + #1 OR
'''ELSE''' ROT DROP SWAP pdiv OVER + 'pdiv' STO '''END'''
'''END''' DROP pdiv SWAP +
≫ ≫ ‘'''PDIVB'''’ STO
 
#1048 '''PDIVB'''
{{out}}
<pre>
1: { #2d #2d #2d #131d }
</pre>
 
=={{header|Ruby}}==
Line 4,923 ⟶ 5,836:
}
</syntaxhighlight>
 
=={{header|S-BASIC}}==
<syntaxhighlight lang="s-basic">
rem - return p mod q
function mod(p, q = integer) = integer
end = p - q * (p/q)
 
dim integer factors(16) rem log2(maxint) is sufficiently large
 
comment
Find the prime factors of n and store in global array factors
(arrays cannot be passed as parameters) and return the number
found. If n is prime, it will be stored as the only factor.
end
function primefactors(n = integer) = integer
var p, count = integer
p = 2
count = 1
while n >= (p * p) do
begin
if mod(n, p) = 0 then
begin
factors(count) = p
count = count + 1
n = n / p
end
else
p = p + 1
end
factors(count) = n
end = count
 
rem -- exercise the routine by checking odd numbers from 77 to 99
 
var i, k, nfound = integer
 
for i = 77 to 99 step 2
nfound = primefactors(i)
print i;"; ";
for k = 1 to nfound
print factors(k);
next k
print
next i
end
</syntaxhighlight>
{{out}}
<pre>
77: 7 11
79: 79
81: 3 3 3 3
83: 83
85: 5 17
87: 3 29
89: 89
91: 7 13
93: 3 31
95: 5 19
97: 97
99: 3 3 11
</pre>
 
=={{header|Scala}}==
Line 5,543 ⟶ 6,394:
2**59-1 = 576460752303423487 = 179951*3203431780337 => 316009 microseconds per iteration</pre>
 
=={{header|TI-83 BASIC}}==
<syntaxhighlight lang="ti83b">::prgmPREMIER
Disp "FACTEURS PREMIER"
Prompt N
If N<1:Stop
ClrList L1�,L2
0→K
iPart(√(N))→L
N→M
For(I,2,L)
0→J
While fPart(M/I)=0
J+1→J
M/I→M
End
If J≠0
Then
K+1→K
I→L�1(K)
J→L2(K)
I→Z:prgmVSTR
" "+Str0→Str1
If J≠1
Then
J→Z:prgmVSTR
Str1+"^"+Str0→Str1
End
Disp Str1
End
If M=1:Stop
End
If M≠1
Then
If M≠N
Then
M→Z:prgmVSTR
" "+Str0→Str1
Disp Str1
Else
Disp "PREMIER"
End
End
::prgmVSTR
{Z,Z}→L5
{1,2}→L6
LinReg(ax+b)L6,L5,Y�₀
Equ►String(Y₀,Str0)
length(Str0)→O
sub(Str0,4,O-3)→Str0
ClrList L5,L6
DelVar Y�</syntaxhighlight>
{{out}}
<pre>
FACTEURS PREMIER
N=?1047552
2^10
3
11
31
</pre>
 
=={{Header|Tiny BASIC}}==
{{works with|TinyBasic}}
<syntaxhighlight lang="basic">10 PRINT "Enter a number."
20 INPUT N
25 PRINT "------"
30 IF N<0 THEN LET N = -N
40 IF N<2 THEN END
50 LET I = 2
60 IF I*I > N THEN GOTO 200
70 IF (N/I)*I = N THEN GOTO 300
80 LET I = I + 1
90 GOTO 60
200 PRINT N
210 END
300 LET N = N / I
310 PRINT I
320 GOTO 50</syntaxhighlight>
{{out}}
<pre>
Enter a number.
32
------
2
2
2
2
2
 
Enter a number.
2520
------
2
2
2
3
3
5
7
 
Enter a number.
13
------
13
</pre>
 
=={{header|TXR}}==
 
{{trans|Common Lisp}}
 
<syntaxhighlight lang="txr">@(next :args)
@(do
Line 5,717 ⟶ 6,461:
<syntaxhighlight lang="v">|1221 prime-decomposition puts</syntaxhighlight>
=[3 11 37]
 
=={{header|VBScript}}==
<syntaxhighlight lang="vb">Function PrimeFactors(n)
arrP = Split(ListPrimes(n)," ")
divnum = n
Do Until divnum = 1
'The -1 is to account for the null element of arrP
For i = 0 To UBound(arrP)-1
If divnum = 1 Then
Exit For
ElseIf divnum Mod arrP(i) = 0 Then
divnum = divnum/arrP(i)
PrimeFactors = PrimeFactors & arrP(i) & " "
End If
Next
Loop
End Function
 
Function IsPrime(n)
If n = 2 Then
IsPrime = True
ElseIf n <= 1 Or n Mod 2 = 0 Then
IsPrime = False
Else
IsPrime = True
For i = 3 To Int(Sqr(n)) Step 2
If n Mod i = 0 Then
IsPrime = False
Exit For
End If
Next
End If
End Function
 
Function ListPrimes(n)
ListPrimes = ""
For i = 1 To n
If IsPrime(i) Then
ListPrimes = ListPrimes & i & " "
End If
Next
End Function
 
WScript.StdOut.Write PrimeFactors(CInt(WScript.Arguments(0)))
WScript.StdOut.WriteLine</syntaxhighlight>
 
{{out}}
<pre>
C:\>cscript /nologo primefactors.vbs 12
2 3 2
 
C:\>cscript /nologo primefactors.vbs 50
2 5 5
</pre>
 
=={{header|Wren}}==
Line 5,776 ⟶ 6,466:
{{libheader|Wren-fmt}}
The examples are borrowed from the Go solution.
<syntaxhighlight lang="ecmascriptwren">import "./big" for BigInt
import "./fmt" for Fmt
 
var vals = [1 << 31, 1234567, 333333, 987653, 2 * 3 * 5 * 7 * 11 * 13 * 17]
Line 5,793 ⟶ 6,483:
</pre>
 
=={{header|XPL0}}==
{{trans|PL/0|The algorithm itself is translated, but procedure which calculates factors and fills the result array is added.}}
{{works with|EXPL-32}}
<syntaxhighlight lang="xpl0">
\ Prime decomposition
code Abs=0, Rem=2, CrLf=9, IntIn=10, IntOut=11, Text=12;
define MaxFacIndex = 30;
\ -(2^31) has most prime factors (31 twos) than other 32-bit signed integer.
integer I, N, Facs(MaxFacIndex), FacsCnt;
procedure CalcFacs(N, Facs, FacsCnt);
integer N, Facs, FacsCnt;
integer I, Cnt;
begin
N:= Abs(N);
Cnt:=0;
if N >= 2 then
begin
I:= 2;
while I * I <= N do
begin
if Rem(N / I) = 0 then
begin
N:= N / I;
Facs(Cnt):= I; Cnt:= Cnt + 1;
I:= 2
end
else
I:= I + 1
end;
Facs(Cnt):= N; Cnt:= Cnt + 1
end;
FacsCnt(0):= Cnt
end;
 
begin
Text(0, "Enter a number: "); N:= IntIn(0);
CalcFacs(N, Facs, addr FacsCnt);
for I:= 0 to FacsCnt - 2 do
begin
IntOut(0, Facs(I)); Text(0, " ")
end;
IntOut(0, Facs(FacsCnt - 1)); CrLf(0)
end
</syntaxhighlight>
{{out}}
3 runs.
<pre>
Enter a number: 32
2 2 2 2 2
</pre>
<pre>
Enter a number: 2520
2 2 2 3 3 5 7
</pre>
<pre>
Enter a number: 13
13
</pre>
=={{header|XSLT}}==
Let's assume that in XSLT the application of a template is similar to the invocation of a function. So when the following template
Lijice4777
1

edit

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/333238...363088"