2016 Update

This commit is contained in:
Tina Müller 2016-12-05 22:15:40 +01:00
parent 948b86eafa
commit dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions

View file

@ -1,10 +1,16 @@
{{omit from|GUISS}}
The prime decomposition of a number is defined as a list of prime numbers
which when all multiplied together, are equal to that number.
Example: 12 = 2 × 2 × 3, so its prime decomposition is {2, 2, 3}
Write a function which returns an [[Arrays|array]] or [[Collections|collection]] which contains the prime decomposition of a given number, n, greater than 1.
;Example:
12 = 2 × 2 × 3, so its prime decomposition is {2, 2, 3}
;Task:
Write a function which returns an [[Arrays|array]] or [[Collections|collection]] which contains the prime decomposition of a given number &nbsp; <big><big><math>n</math></big></big> &nbsp; greater than &nbsp; '''1'''.
If your language does not have an isPrime-like function available,
you may assume that you have a function which determines
whether a number is prime (note its name before your code).
@ -13,5 +19,9 @@ If you would like to test code from this task, you may use code from [[Primality
Note: The program must not be limited by the word size of your computer or some other artificial limit; it should work for any number regardless of size (ignoring the physical limits of RAM etc).
See also:
* [[Factors of an integer]]
;Related tasks:
* &nbsp; [[Factors of an integer]]
* &nbsp; [[Primality by trial division]]
* &nbsp; [[Sieve of Eratosthenes]]
<br><br>

View file

@ -0,0 +1,9 @@
open integer //arbitrary sized integers
decompose_prime n = loop n 2I
where
loop c p | c < (p * p) = [c]
| c % p == 0I = p :: (loop (c / p) p)
| else = loop c (p + 1I)
decompose_prime 600851475143I

View file

@ -1,3 +1,5 @@
factorize n = concat [divs n p | p <- [2..n], isPrime p]
where
divs n p = if rem n p==0 then p:divs (quot n p) p else []
factorize n = [ d | p <- [2..n], isPrime p, d <- divs n p ]
-- [2..n] >>= (\p-> [p|isPrime p]) >>= divs n
where
divs n p | rem n p == 0 = p : divs (quot n p) p
| otherwise = []

View file

@ -1,6 +1,11 @@
factorize n = divs n primesList
where
divs n ds@(d:t) | d*d > n = [n | n > 1]
| r == 0 = d : divs q ds
| otherwise = divs n t
where (q,r) = quotRem n d
import Data.Maybe (listToMaybe)
import Data.List (unfoldr)
factorize :: Integer -> [Integer]
factorize n
= unfoldr (\n -> listToMaybe [(x, div n x) | x <- [2..n], mod n x==0]) n
= unfoldr (\(d,n) -> listToMaybe [(x, (x, div n x)) | x <- [d..n], mod n x==0]) (2,n)
= unfoldr (\(d,n) -> listToMaybe [(x, (x, div n x)) | x <-
takeWhile ((<=n).(^2)) [d..] ++ [n|n>1], mod n x==0]) (2,n)
= unfoldr (\(ds,n) -> listToMaybe [(x, (dropWhile (< x) ds, div n x)) | n>1, x <-
takeWhile ((<=n).(^2)) ds ++ [n|n>1], mod n x==0]) (primesList,n)

View file

@ -1,22 +1,6 @@
import Test.HUnit
import Data.List
factor::Int->[Int]
factor 1 = []
factor n
| product primeDivisor == n = primeDivisor
| otherwise = primeDivisor ++ factor (div n $ product primeDivisor)
where
primeDivisor = filter isPrime $ filter (isDivisor n) [2 .. n]
isDivisor n d = (==) 0 $ mod n d
isPrime n = not $ any (isDivisor n) [2 .. n-1]
tests = TestList[TestCase $ assertEqual "1 has no prime factors" [] $ factor 1
,TestCase $ assertEqual "2 is 2" [2] $ factor 2
,TestCase $ assertEqual "3 is 3" [3] $ factor 3
,TestCase $ assertEqual "4 is 2*2" [2, 2] $ factor 4
,TestCase $ assertEqual "5 is 5" [5] $ factor 5
,TestCase $ assertEqual "6 is 2*3" [2, 3] $ factor 6
,TestCase $ assertEqual "7 is 7" [7] $ factor 7
,TestCase $ assertEqual "8 is 2*2*2" [2, 2, 2] $ factor 8
,TestCase $ assertEqual "large number" [2, 3, 3, 5, 7, 11, 13] $ sort $ factor (2*9*5*7*11*13)]
factorize n = divs n primesList
where
divs n ds@(d:t) | d*d > n = [n | n > 1]
| r == 0 = d : divs q ds
| otherwise = divs n t
where (q,r) = quotRem n d

View file

@ -0,0 +1,31 @@
sub prime-factors ( Int $n where * > 0 ) {
return $n if $n.is-prime;
return [] if $n == 1;
my $factor = find-factor( $n );
sort flat prime-factors( $factor ), prime-factors( $n div $factor );
}
sub find-factor ( Int $n, $constant = 1 ) {
my $x = 2;
my $rho = 1;
my $factor = 1;
while $factor == 1 {
$rho *= 2;
my $fixed = $x;
for ^$rho {
$x = ( $x * $x + $constant ) % $n;
$factor = ( $x - $fixed ) gcd $n;
last if 1 < $factor;
}
}
$factor = find-factor( $n, $constant + 1 ) if $n == $factor;
$factor;
}
for 2²⁹-1, 2⁴¹-1, 2⁵⁹-1, 2⁷¹-1, 2⁷⁹-1, 2⁹⁷-1, 2¹¹⁷-1,
5465610891074107968111136514192945634873647594456118359804135903459867604844945580205745718497
-> $n {
my $start = now;
say "factors of $n: ",
prime-factors($n).join(' × '), " \t in ", (now - $start).fmt("%0.3f"), " sec."
}

View file

@ -0,0 +1,16 @@
use Inline::Perl5;
my $p5 = Inline::Perl5.new();
$p5.use( 'ntheory' );
sub prime-factors ($i) {
my &primes = $p5.run('sub { map { ntheory::todigitstring $_ } sort {$a <=> $b} ntheory::factor $_[0] }');
primes("$i");
}
for 2²⁹-1, 2⁴¹-1, 2⁵⁹-1, 2⁷¹-1, 2⁷⁹-1, 2⁹⁷-1, 2¹¹⁷-1,
5465610891074107968111136514192945634873647594456118359804135903459867604844945580205745718497
-> $n {
my $start = now;
say "factors of $n: ",
prime-factors($n).join(' × '), " \t in ", (now - $start).fmt("%0.3f"), " sec."
}

View file

@ -1,23 +0,0 @@
constant @primes = 2, 3, 5, -> *@p {
my $n = @p[*-1];
repeat { $n += 2 } while $n %% any @p.grep: * **2 <= $n;
$n;
} ... *;
sub factors(Int $remainder is copy) {
return 1 if $remainder <= 1;
gather for @primes -> $factor {
if $factor * $factor > $remainder {
take $remainder if $remainder > 1;
last;
}
# How many times can we divide by this prime?
while $remainder %% $factor {
take $factor;
last if ($remainder div= $factor) === 1;
}
}
}
say factors 536870911;

View file

@ -0,0 +1,16 @@
factors( N, FS):-
factors2( N, FS).
factors2( N, FS):-
( N < 2 -> FS = []
; 4 > N -> FS = [N]
; 0 is N rem 2 -> FS = [K|FS2], N2 is N div 2, factors2( N2, FS2)
; factors( N, 3, FS)
).
factors( N, K, FS):-
( N < 2 -> FS = []
; K*K > N -> FS = [N]
; 0 is N rem K -> FS = [K|FS2], N2 is N div K, factors( N2, K, FS2)
; K2 is K+2, factors( N, K2, FS)
).

View file

@ -1,15 +1,15 @@
findfactors <- function(n) {
d <- c()
div <- 2; nxt <- 3; rest <- n
while( rest != 1 ) {
while( rest%%div == 0 ) {
d <- c(d, div)
rest <- floor(rest / div)
findfactors <- function(num) {
x <- c()
1stprime<- 2; 2ndprime <- 3; everyprime <- num
while( everyprime != 1 ) {
while( everyprime%%1stprime == 0 ) {
x <- c(x, 1stprime)
everyprime <- floor(everyprime/ 1stprime)
}
div <- nxt
nxt <- nxt + 2
1stprime <- 2ndprime
2ndprime <- 2ndprime + 2
}
d
x
}
print(findfactors(1005025))
print(findfactors(1027*4))

View file

@ -0,0 +1,43 @@
/*REXX pgm does prime decomposition of a range of positive integers (with a prime count)*/
numeric digits 1000 /*handle thousand digits for the powers*/
parse arg bot top step base add /*get optional arguments from the C.L. */
if bot=='' then do; bot=1; top=100; end /*no BOT given? Then use the default.*/
if top=='' then top=bot /* " TOP? " " " " " */
if step=='' then step= 1 /* " STEP? " " " " " */
if add =='' then add= -1 /* " ADD? " " " " " */
tell= top>0; top=abs(top) /*if TOP is negative, suppress displays*/
w=length(top) /*get maximum width for aligned display*/
if base\=='' then w=length(base**top) /*will be testing powers of two later? */
@.=left('', 7); @.0="{unity}"; @.1='[prime]' /*some literals: pad; prime (or not).*/
numeric digits max(9, w+1) /*maybe increase the digits precision. */
#=0 /*#: is the number of primes found. */
do n=bot to top by step /*process a single number or a range.*/
?=n; if base\=='' then ?=base**n + add /*should we perform a "Mercenne" test? */
pf=factr(?); f=words(pf) /*get prime factors; number of factors.*/
if f==1 then #=#+1 /*Is N prime? Then bump prime counter.*/
if tell then say right(?,w) right('('f")",9) 'prime factors: ' @.f pf
end /*n*/
say
ps= 'primes'; if p==1 then ps= "prime" /*setup for proper English in sentence.*/
say right(#, 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,$ /*set X, D to argument 1; $ to null.*/
if x==1 then return '' /*handle the special case of X = 1. */
do while x//2==0; $=$ 2; x=x%2; end /*append all the 2 factors of new X.*/
do while x//3==0; $=$ 3; x=x%3; end /* " " " 3 " " " " */
do while x//5==0; $=$ 5; x=x%5; end /* " " " 5 " " " " */
do while x//7==0; $=$ 7; x=x%7; end /* " " " 7 " " " " */
/* ___*/
q=1; do while q<=x; q=q*4; end /*these two lines compute integer √ X */
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
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 while x//j==0; $=$ j; x=x%j; end /*maybe reduce by J. */
if _ ==3 then iterate /*Is next Y is divisible by 5? Skip.*/
y=j+2; do while x//y==0; $=$ y; x=x%y; end /*maybe reduce by J. */
end /*j*/
/* [↓] The $ list has a leading blank.*/
if x==1 then return $ /*Is residual=unity? Then don't append.*/
return $ x /*return $ with appended residual. */

View file

@ -0,0 +1,48 @@
/*REXX pgm does prime decomposition of a range of positive integers (with a prime count)*/
numeric digits 1000 /*handle thousand digits for the powers*/
parse arg bot top step base add /*get optional arguments from the C.L. */
if bot=='' then do; bot=1; top=100; end /*no BOT given? Then use the default.*/
if top=='' then top=bot /* " TOP? " " " " " */
if step=='' then step= 1 /* " STEP? " " " " " */
if add =='' then add= -1 /* " ADD? " " " " " */
tell= top>0; top=abs(top) /*if TOP is negative, suppress displays*/
w=length(top) /*get maximum width for aligned display*/
if base\=='' then w=length(base**top) /*will be testing powers of two later? */
@.=left('', 7); @.0="{unity}"; @.1='[prime]' /*some literals: pad; prime (or not).*/
numeric digits max(9, w+1) /*maybe increase the digits precision. */
#=0 /*#: is the number of primes found. */
do n=bot to top by step /*process a single number or a range.*/
?=n; if base\=='' then ?=base**n + add /*should we perform a "Mercenne" test? */
pf=factr(?); f=words(pf) /*get prime factors; number of factors.*/
if f==1 then #=#+1 /*Is N prime? Then bump prime counter.*/
if tell then say right(?,w) right('('f")",9) 'prime factors: ' @.f pf
end /*n*/
say
ps= 'primes'; if p==1 then ps= "prime" /*setup for proper English in sentence.*/
say right(#, 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,$ /*set X, D to argument 1; $ to null.*/
if x==1 then return '' /*handle the special case of X = 1. */
do while x// 2==0; $=$ 2; x=x%2; end /*append all the 2 factors of new X.*/
do while x// 3==0; $=$ 3; x=x%3; end /* " " " 3 " " " " */
do while x// 5==0; $=$ 5; x=x%5; end /* " " " 5 " " " " */
do while x// 7==0; $=$ 7; x=x%7; end /* " " " 7 " " " " */
do while x//11==0; $=$ 11; x=x%11; end /* " " " 11 " " " " */ /* ◄■■■■ added.*/
do while x//13==0; $=$ 13; x=x%13; end /* " " " 13 " " " " */ /* ◄■■■■ added.*/
do while x//17==0; $=$ 17; x=x%17; end /* " " " 17 " " " " */ /* ◄■■■■ added.*/
do while x//19==0; $=$ 19; x=x%19; end /* " " " 19 " " " " */ /* ◄■■■■ added.*/
do while x//23==0; $=$ 23; x=x%23; end /* " " " 23 " " " " */ /* ◄■■■■ added.*/
/* ___*/
q=1; do while q<=x; q=q*4; end /*these two lines compute integer √ X */
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
do j=29 by 6 to r /*insure that J isn't divisible by 3.*/ /* ◄■■■■ changed.*/
parse var j '' -1 _ /*obtain the last decimal digit of J. */
if _\==5 then do while x//j==0; $=$ j; x=x%j; end /*maybe reduce by J. */
if _ ==3 then iterate /*Is next Y is divisible by 5? Skip.*/
y=j+2; do while x//y==0; $=$ y; x=x%y; end /*maybe reduce by J. */
end /*j*/
/* [↓] The $ list has a leading blank.*/
if x==1 then return $ /*Is residual=unity? Then don't append.*/
return $ x /*return $ with appended residual. */

View file

@ -1,43 +0,0 @@
/*REXX program performs prime decomposition for a range of positive integer(s)*/
numeric digits 1000 /*handle thousand digits for the powers*/
parse arg bot top step base add /*get optional arguments from the C.L. */
if bot=='' then do;bot=1;top=100;end /*no BOT given? Then use the default.*/
if top=='' then top=bot /* " TOP? " " " " " */
if step=='' then step=1 /* " STEP? " " " " " */
if add =='' then add=-1 /* " ADD? " " " " " */
w=length(top) /*get maximum width for aligned display*/
if base\=='' then w=length(base**top) /*will be testing powers of two later? */
@.=left('',7); @.0='{unity}'; @.1='[prime]' /*literals: prime (or not)*/
numeric digits max(9,w+1) /*maybe increase the digits precision. */
#=0 /*P: is the number of primes found. */
do n=bot to top by step /*process a single number or a range.*/
?=n; if base\=='' then ?=base**n+add /*do a "Mercenne" test? */
pf=factr(?); f=words(pf) /*get prime factors; number of factors.*/
if f==1 then #=#+1 /*Is N prime? Then bump prime counter.*/
say right(?,w) right('('f")",9) 'prime factors: ' @.f pf
iterate
end /*n*/
say
ps='primes'; if p==1 then ps='prime' /*setup for proper English in sentence.*/
say right(#,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 z 1 d,$ /*set X and Z to argument; $ to null*/
if x==1 then return '' /*handle the special case of X equal 1.*/
do while z//2==0; $=$ 2; z=z%2; end /*append all the 2 factors.*/
do while z//3==0; $=$ 3; z=z%3; end /* " " " 3 " */
do while z//5==0; $=$ 5; z=z%5; end /* " " " 5 " */
do while z//7==0; $=$ 7; z=z%7; end /* " " " 7 " */
/* ___ */
q=1; do while q<=x; q=q*4; end /*these 2 lines compute √ X */
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
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 while z//j==0; $=$ j; z=z%j; end /*maybe reduce*/
if _ ==3 then iterate /*if next Y is divisible by 5, skip.*/
y=j+2; do while z//y==0; $=$ y; z=z%y; end /*maybe reduce*/
end /*j*/
/* [↓] The $ list has a leading blank.*/
if z==1 then return $ /*if residual=unity, then don't append.*/
return $ z /*return $ with appended residual. */

View file

@ -2,10 +2,10 @@
@(do
(defun factor (n)
(if (> n 1)
(for ((max-d (sqrt n))
(for ((max-d (isqrt n))
(d 2))
(t)
((set d (if (evenp d) (+ d 1) (+ d 2))))
()
((inc d (if (evenp d) 1 2)))
(cond ((> d max-d) (return (list n)))
((zerop (mod n d))
(return (cons d (factor (trunc n d))))))))))