aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

September 2017 Update

Browse source
This commit is contained in:
Ingy döt Net 2017-09-23 10:01:46 +02:00
parent bba7bfd280
commit ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
Download patch file Download diff file Expand all files Collapse all files

54
Task/Parallel-calculations/Fortran/parallel-calculations.f Normal file
View file

@ -0,0 +1,54 @@
program Primes
use ISO_FORTRAN_ENV
implicit none
integer(int64), dimension(7) :: data = (/2099726827, 15780709, 1122725370, 15808973, 576460741, 12878611, 12757923/)
integer(int64), dimension(100) :: outprimes
integer(int64) :: largest_factor = 0, largest = 0, minim = 0, val = 0
integer(int16) :: count = 0, OMP_GET_THREAD_NUM
call omp_set_num_threads(4);
!$omp parallel do private(val,outprimes,count) shared(data,largest_factor,largest)
do val = 1, 7
outprimes = 0
call find_factors(data(val), outprimes, count)
minim = minval(outprimes(1:count))
if (minim > largest_factor) then
largest_factor = minim
largest = data(val)
end if
write(*, fmt = '(A7,i0,A2,i12,100i12)') 'Thread ', OMP_GET_THREAD_NUM(), ': ', data(val), outprimes(1:count)
end do
!$omp end parallel do
write(*, fmt = '(i0,A26,i0)') largest, ' have the Largest factor: ', largest_factor
return
contains
subroutine find_factors(n, d, count)
integer(int64), intent(in) :: n
integer(int64), dimension(:), intent(out) :: d
integer(int16), intent(out) :: count
integer(int16) :: i
integer(int64) :: div, next, rest
i = 1
div = 2; next = 3; rest = n
do while (rest /= 1)
do while (mod(rest, div) == 0)
d(i) = div
i = i + 1
rest = rest / div
end do
div = next
next = next + 2
end do
count = i - 1
end subroutine find_factors
end program Primes

15
Task/Parallel-calculations/OoRexx/parallel-calculations-1.rexx Normal file
View file

@ -0,0 +1,15 @@
/* Concurrency in ooRexx. Example of early reply */
object1 = .example~new
object2 = .example~new
say object1~primes(1,11111111111,11111111114)
say object2~primes(2,11111111111,11111111114)
say "Main ended at" time()
exit
::class example
::method primes
use arg which,bot,top
reply "Start primes"which':' time()
Select
When which=1 Then Call pd1 bot top
When which=2 Then Call pd2 bot top
End

45
Task/Parallel-calculations/OoRexx/parallel-calculations-2.rexx Normal file
View file

@ -0,0 +1,45 @@
/*PD1 REXX pgm does prime decomposition of a range of positive integers (with a prime count)*/
Call Time 'R'
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? */
commat.=left('', 7); commat.0="{unity}"; commat.1='[prime]' /*some literals: pad; prime (or not).*/
numeric digits max(9, w+1) /*maybe increase the digits precision. */
hash=0 /*hash: 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 hash=hash+1 /*Is N prime? Then bump prime counter.*/
if tell then say right(?,w) right('('f")",9) 'prime factors: ' commat.f pf
end /*n*/
say
ps= 'primes'; if p==1 then ps= "prime" /*setup for proper English in sentence.*/
say right(hash, w+9+1) ps 'found.' /*display the number of primes found. */
Say 'PD1 took' time('E') 'seconds'
exit /*stick a fork in it, we're all done. */
/*--------------------------------------------------------------------------------------*/
factr: procedure; parse arg x 1 d,dollar /*set X, D to argument 1; dollar to null.*/
if x==1 then return '' /*handle the special case of X = 1. */
do while x//2==0; dollar=dollar 2; x=x%2; end /*append all the 2 factors of new X.*/
do while x//3==0; dollar=dollar 3; x=x%3; end /* " " " 3 " " " " */
do while x//5==0; dollar=dollar 5; x=x%5; end /* " " " 5 " " " " */
do while x//7==0; dollar=dollar 7; x=x%7; end /* " " " 7 " " " " */
/* ___*/
q=1; do while q<=x; q=q*4; end /*these two lines compute integer v 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; dollar=dollar 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; dollar=dollar y; x=x%y; end /*maybe reduce by J. */
end /*j*/
/* [?] The dollar list has a leading blank.*/
if x==1 then return dollar /*Is residual=unity? Then don't append.*/
return dollar x /*return dollar with appended residual. */

50
Task/Parallel-calculations/OoRexx/parallel-calculations-3.rexx Normal file
View file

@ -0,0 +1,50 @@
/*PD2 REXX pgm does prime decomposition of a range of positive integers (with a prime count)*/
Call time 'R'
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? */
commat.=left('', 7); commat.0="{unity}"; commat.1='[prime]' /*some literals: pad; prime (or not).*/
numeric digits max(9, w+1) /*maybe increase the digits precision. */
hash=0 /*hash: 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 hash=hash+1 /*Is N prime? Then bump prime counter.*/
if tell then say right(?,w) right('('f")",9) 'prime factors: ' commat.f pf
end /*n*/
say
ps= 'primes'; if p==1 then ps= "prime" /*setup for proper English in sentence.*/
say right(hash, w+9+1) ps 'found.' /*display the number of primes found. */
Say 'PD2 took' time('E') 'seconds'
exit /*stick a fork in it, we're all done. */
/*--------------------------------------------------------------------------------------*/
factr: procedure; parse arg x 1 d,dollar /*set X, D to argument 1; dollar to null.*/
if x==1 then return '' /*handle the special case of X = 1. */
do while x// 2==0; dollar=dollar 2; x=x%2; end /*append all the 2 factors of new X.*/
do while x// 3==0; dollar=dollar 3; x=x%3; end /* " " " 3 " " " " */
do while x// 5==0; dollar=dollar 5; x=x%5; end /* " " " 5 " " " " */
do while x// 7==0; dollar=dollar 7; x=x%7; end /* " " " 7 " " " " */
do while x//11==0; dollar=dollar 11; x=x%11; end /* " " " 11 " " " " */ /* ?¦¦¦¦ added.*/
do while x//13==0; dollar=dollar 13; x=x%13; end /* " " " 13 " " " " */ /* ?¦¦¦¦ added.*/
do while x//17==0; dollar=dollar 17; x=x%17; end /* " " " 17 " " " " */ /* ?¦¦¦¦ added.*/
do while x//19==0; dollar=dollar 19; x=x%19; end /* " " " 19 " " " " */ /* ?¦¦¦¦ added.*/
do while x//23==0; dollar=dollar 23; x=x%23; end /* " " " 23 " " " " */ /* ?¦¦¦¦ added.*/
/* ___*/
q=1; do while q<=x; q=q*4; end /*these two lines compute integer v 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; dollar=dollar 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; dollar=dollar y; x=x%y; end /*maybe reduce by J. */
end /*j*/
/* [?] The dollar list has a leading blank.*/
if x==1 then return dollar /*Is residual=unity? Then don't append.*/
return dollar x /*return dollar with appended residual. */

8
Task/Parallel-calculations/Zkl/parallel-calculations-1.zkl Normal file
View file

@ -0,0 +1,8 @@
fcn factorize(x,y,z,etc){
xyzs:=vm.arglist;
fs:=xyzs.apply(factors.strand) // queue up factorizing for x,y,...
.apply("noop") // wait for all threads to finish factoring
.apply(fcn{ (0).min(vm.arglist) }); // find minimum factor for x,y...
[0..].zip(fs).filter(fcn([(n,x)],M){ x==M }.fp1((0).max(fs))) // find max of mins
.apply('wrap([(n,_)]){ xyzs[n] }) // and pluck src from arglist
}

3
Task/Parallel-calculations/Zkl/parallel-calculations-2.zkl Normal file
View file

@ -0,0 +1,3 @@
factorize(12757923,12878611,12757923,15808973,15780709,197622519).println();
// do a bunch so I can watch the system monitor
factorize( (0).pump(5000,List,fcn{(1000).random() }).xplode() ).println();

13
Task/Parallel-calculations/Zkl/parallel-calculations-3.zkl Normal file
View file

@ -0,0 +1,13 @@
fcn factors(n){ // Return a list of factors of n
acc:=fcn(n,k,acc,maxD){ // k is 2,3,5,7,9,... not optimum
if(n==1 or k>maxD) acc.close();
else{
q,r:=n.divr(k); // divr-->(quotient,remainder)
if(r==0) return(self.fcn(q,k,acc.write(k),q.toFloat().sqrt()));
return(self.fcn(n,k+1+k.isOdd,acc,maxD))
}
}(n,2,Sink(List),n.toFloat().sqrt());
m:=acc.reduce('*,1); // mulitply factors
if(n!=m) acc.append(n/m); // opps, missed last factor
else acc;
}