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

Data update

Browse source
This commit is contained in:
Ingy döt Net 2025-06-11 20:16:52 -04:00
parent 72eb4943cb
commit 4d5544505c
2347 changed files with 62432 additions and 16731 deletions
Download patch file Download diff file Expand all files Collapse all files

4
Task/Factorial/EasyLang/factorial.easy
View file

@ -1,8 +1,6 @@
func factorial n .
r = 1
for i = 2 to n
r *= i
.
for i = 2 to n : r *= i
return r
.
print factorial 7

27
Task/Factorial/Java/factorial-4.java Normal file
View file

@ -0,0 +1,27 @@
import java.math.BigInteger;
import java.util.function.Function;
import java.util.stream.LongStream;
import java.util.stream.Stream;
public final class Factorial {
public static void main(String[] args) {
// Valid only for integer arguments 1, 2, ... , 20
Function<Integer, Long> factorialPositive = n -> LongStream.rangeClosed(2, n).reduce(1, (a, b) -> a * b);
// Valid for integer arguments <= 20
Function<Integer, Long> factorial = n -> {
if ( n < 0 || n > 20 ) {
throw new AssertionError("Argument is out of range: " + n);
}
return factorialPositive.apply(n);
};
// Return a BigInteger value
Function<Integer, BigInteger> factorialBig = n -> Stream.iterate(BigInteger.ONE, i -> i.add(BigInteger.ONE))
.limit(n)
.reduce(BigInteger.ONE, BigInteger::multiply);
}
}

25
Task/Factorial/M2000-Interpreter/factorial-2.m2000
View file

@ -9,19 +9,16 @@ Report {
}
Cls, row ' now we preserve some lines (as row number return here)
Module CheckIt {
m=bigInteger("1")
with m, "tostring" as m.toString
k=width-tab
For i=1 to 1000
if pos>tab then print
Print @(0), format$("{0::-4} :", i) ;
method m,"multiply", biginteger(i+"") as m
Report m.toString, k
' Report stop at 2/3 of display lines, and wait mouse button or spacebar
' we can flush the keyboard buffer and press space, so we get non stop display
' Report didn't stop if we use the printer's layer.
while inkey$<>"": wait 1:end while
keyboard " "
Next i
m=1u ' 1u is biginteger
k=width-tab
For i=1 to 1000
if pos>tab then print
m*=i
Print @(0), format$("{0::-4} :", i);
Report str$(m), k
' Report accumulate lines and stop at 3/4 of the screen (but not on printer)
' so we can break this using this line:
while inkey$<>"": wait 1:end while: keyboard " "
Next i
}
Checkit

65
Task/Factorial/Pascal/factorial-2.pas
View file

@ -1,32 +1,45 @@
{$mode objFPC}{R+}
FUNCTION Factorial ( n : qword ) : qword;
FUNCTION Fact(n: qword): qword;
(*)
Update for version 3.2.0
Factorial works until 20! , which is good enough for me for now
replace qword with dword and rax,rcx with eax, ecx for 32-bit
for Factorial until 12!
(*)
VAR
F: qword;
VAR
F: qword;
BEGIN
BEGIN
if n > 20 then
begin
WriteLn('This function is only accurate up to 20!');
exit(0);
end;
asm
mov $1, %rax
mov n, %rcx
.Lloop1:
imul %rcx, %rax
loopnz .Lloop1
mov %rax, F
asm
(*) Initialize result = 1 (0! = 1 case handled automatically) (*)
end;
mov $1, %rax (*) RAX = 1 (initial result) (*)
mov n, %rcx (*) RCX = input number (counter) (*)
Result := F ;
END;
test %rcx, %rcx (*) Check if n=0 (*)
jz .Lstore_result (*) Skip loop if n=0 (*)
.Lloop1:
imul %rcx, %rax (*) RAX = RAX * RCX (signed mul) (*)
dec %rcx (*) Decrement RCX (*)
jnz .Lloop1 (*) Loop while RCX != 0 (*)
.Lstore_result:
mov %rax, F (*) Store result in F (*)
end ['rax', 'rcx']; (*) Tell compiler register change (*)
Result := F;
END;
var
N : integer = 20 ;
begin
writeln;
writeln( BasicFact(N));
end. (*) Function Fact (*)

107
Task/Factorial/Pascal/factorial-3.pas
View file

@ -1,92 +1,33 @@
PROGRAM EXBigFac ;
program GMPfact;
{$IFDEF FPC}
{$mode objfpc}{$H+}{$J-}{R+}
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}
{$mode objfpc}
(*)
uses
Free Pascal Compiler version 3.2.0 [2020/06/14] for x86_64
The free and readable alternative at C/C++ speeds
compiles natively to almost any platform, including raspberry PI *
Can run independently from DELPHI / Lazarus
gmp
;
For debian Linux: apt -y install fpc
It contains a text IDE called fp
function Factorial(n: qword): string;
var
ResultMPZ: mpz_t;
i: qword;
begin
mpz_init_set_ui(ResultMPZ, 1);
for i := 2 to n do
mpz_mul_ui(ResultMPZ, ResultMPZ, i);
Result := mpz_get_str(nil, 10, ResultMPZ);
mpz_clear(ResultMPZ);
end;
https://www.freepascal.org/advantage.var
var
N : integer = 101 ;
Fact : string ;
(*)
begin
Fact := Factorial(101);
writeln( N ,'! = ', Fact);
end. (*) GMPfact (*)
USES
gmp;
FUNCTION WriteBigNum ( c: pchar ) : ansistring ;
CONST
CrLf = #13 + #10 ;
VAR
i: longint;
len: longint;
preview: integer;
ret: ansistring = '';
threshold: integer;
BEGIN
len := length ( c ) ;
WriteLn ( 'Digits: ', len ) ;
threshold := 12 ;
preview := len div threshold ;
IF ( len < 91 ) THEN
BEGIN
FOR i := 0 TO len DO
ret:= ret + c [ i ] ;
END
ELSE
BEGIN
FOR i := 0 TO preview DO
ret:= ret + c [ i ] ;
ret:= ret + '...' ;
FOR i := len - preview -1 TO len DO
ret:= ret + c [ i ] ;
END;
ret:= ret + CrLf ;
WriteBigNum := ret;
END;
FUNCTION BigFactorial ( n : qword ) : ansistring ;
(*)
See https://gmplib.org/#DOC
(*)
VAR
S: mpz_t;
c: pchar;
BEGIN
mpz_init_set_ui ( S, 1 ) ;
mpz_fac_ui ( S, n ) ;
c := mpz_get_str ( NIL, 10, S ) ;
BigFactorial := WriteBigNum ( c ) ;
END;
BEGIN
WriteLn ( BigFactorial ( 99 ) ) ;
END.
Output:
Digits: 156
93326215443944...00000000000000
101! = 9425947759838359420851623124482936749562312794702543768327889353416977599316221476503087861591808346911623490003549599583369706302603264000000000000000000000000

22
Task/Factorial/REXX/factorial-1.rexx
View file

@ -1,18 +1,4 @@
/*REXX pgm computes & shows the factorial of a non─negative integer, and also its length*/
numeric digits 100000 /*100k digits: handles N up to 25k.*/
parse arg n /*obtain optional argument from the CL.*/
if n='' then call er 'no argument specified.'
if arg()>1 | words(n)>1 then call er 'too many arguments specified.'
if \datatype(n,'N') then call er "argument isn't numeric: " n
if \datatype(n,'W') then call er "argument isn't a whole number: " n
if n<0 then call er "argument can't be negative: " n
!= 1 /*define the factorial product (so far)*/
do j=2 to n; !=!*j /*compute the factorial the hard way. */
end /*j*/ /* [↑] where da rubber meets da road. */
say n'! is ['length(!) "digits]:" /*display number of digits in factorial*/
say /*add some whitespace to the output. */
say ! /*display the factorial product──►term.*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
er: say; say '***error***'; say; say arg(1); say; exit 13
call time('r')
numeric digits 999999999
a = 10/3
say length(a) time('e')

91
Task/Factorial/REXX/factorial-2.rexx
View file

@ -1,22 +1,69 @@
/*REXX program computes the factorial of a non─negative integer, and it automatically */
/*────────────────────── adjusts the number of decimal digits to accommodate the answer.*/
numeric digits 99 /*99 digits initially, then expanded. */
parse arg n /*obtain optional argument from the CL.*/
if n='' then call er 'no argument specified'
if arg()>1 | words(n)>1 then call er 'too many arguments specified.'
if \datatype(n,'N') then call er "argument isn't numeric: " n
if \datatype(n,'W') then call er "argument isn't a whole number: " n
if n<0 then call er "argument can't be negative: " n
!= 1 /*define the factorial product (so far)*/
do j=2 to n; !=!*j /*compute the factorial the hard way. */
if pos(.,!)==0 then iterate /*is the ! in exponential notation? */
parse var ! 'E' digs /*extract exponent of the factorial, */
numeric digits digs + digs % 10 /* ··· and increase it by ten percent.*/
end /*j*/ /* [↑] where da rubber meets da road. */
!= !/1 /*normalize the factorial product. */
say n'! is ['length(!) "digits]:" /*display number of digits in factorial*/
say /*add some whitespace to the output. */
say ! /*display the factorial product ──►term*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
er: say; say '***error!***'; say; say arg(1); say; exit 13
-- 8 May 2025
include Settings
say 'FACTORIAL'
say version
say
call First20
call Imp 10,'1 10 100 1000 10000 100000 1000000 10000000 100000000 130202808'
call Rec 10,'1 10 100 1000 10000 100000 200000'
call Imp 100,'69'
call Imp 1000,'449'
call Imp 10000,'3248'
call Imp 100000,'25205'
exit
First20:
say 'First 20 factorials...'
numeric digits 30
do n = 1 to 20
say n'! =' Fact(n)
end
say
return
Imp:
glob. = ''
call Time('r')
arg d,p
numeric digits d; fact. = 0
say 'Imperative in' d 'digits precision...'
do i = 1 to Words(p)
call Time('r'); f = Word(p,i); h = Fact(f)
parse var h 'E' e
if e = '' then
say right(f'!',10) 'has exact' right(Length(h),9) 'digits' '('Format(Time('e'),,3)'s)'
else
say right(f'!',10) 'has about' right(e+1,9) 'digits' '('Format(Time('e'),,3)'s)'
end
say
return
Rec:
glob. = ''
call Time('r')
arg d,p
numeric digits d; fact. = 0
say 'Recursive in' d 'digits precision...'
do i = 1 to Words(p)
call Time('r'); f = Word(p,i); h = Recursive(f)
parse var h 'E' e
if e = '' then
say right(f'!',10) 'has exact' right(Length(h),9) 'digits' '('Format(Time('e'),,3)'s)'
else
say right(f'!',10) 'has about' right(e+1,9) 'digits' '('Format(Time('e'),,3)'s)'
end
say
return
Recursive:
procedure
arg xx
if xx = 0 then
return 1
else
return xx*Recursive(xx-1)
include Functions
include Special
include Abend

27
Task/Factorial/REXX/factorial-3.rexx
View file

@ -1,27 +0,0 @@
/*REXX program computes & shows the factorial of an integer, striping trailing zeroes. */
numeric digits 200 /*start with two hundred digits. */
parse arg N . /*obtain an optional argument from CL. */
if N=='' | N=="," then N= 0 /*Not specified? Then use the default.*/
!= 1 /*define the factorial product so far. */
do j=2 to N /*compute factorial the hard way. */
old!= ! /*save old product in case of overflow.*/
!= ! * j /*multiple the old factorial with J. */
if pos(.,!) \==0 then do /*is the ! in exponential notation?*/
d= digits() /*D temporarily stores number digits.*/
numeric digits d+d%10 /*add 10% to the decimal digits. */
!= old! * j /*re─calculate for the "lost" digits.*/
end /*IFF ≡ if and only if. [↓] */
parse var ! '' -1 _ /*obtain the right-most digit of ! */
if _==0 then != strip(!, , 0) /*strip trailing zeroes IFF the ... */
end /*j*/ /* [↑] ... right-most digit is zero. */
z= 0 /*the number of trailing zeroes in ! */
do v=5 by 0 while v<=N /*calculate number of trailing zeroes. */
z= z + N % v /*bump Z if multiple power of five.*/
v= v * 5 /*calculate the next power of five. */
end /*v*/ /* [↑] we only advance V by ourself.*/
/*stick a fork in it, we're all done. */
!= ! || copies(0, z) /*add water to rehydrate the product. */
if z==0 then z= 'no' /*use gooder English for the message. */
say N'! is ['length(!) " digits with " z ' trailing zeroes]:'
say /*display blank line (for whitespace).*/
say ! /*display the factorial product. */

4
Task/Factorial/REXX/factorial-4.rexx
View file

@ -1,4 +0,0 @@
call time('r')
numeric digits 999999999
a = 10/3
say length(a) time('e')

67
Task/Factorial/REXX/factorial-5.rexx
View file

@ -1,67 +0,0 @@
include Settings
say version; say 'Factorial'; say
p = '10 20 52 104 208 416 1e3 1e4 1e5 1e6 1e7 1e8'
call Val 100
p = '10 20 52 104 208 416 1e3 1e4 1e5 1e6'
call Dig 100
call Dig 1000
call Dig 3000
p = '10 20 52 104 208 416 1e3 1e4 1e5'
call Dig 40000
call Dig 500000
p = '10 20 52 104 208 416 1e3 1e4'
call Dig 5000000
exit
Val:
call Time('r')
arg d
numeric digits d; fact. = 0
say 'Precision is' d 'digits'
do i = 1 to Words(p)
call Time('r');f = Word(p,i); say f'!' '=' Fact(f) '('Format(Time('e'),,3)'s)'
end
say
return
Dig:
call Time('r')
arg d
numeric digits d; fact. = 0
say 'Precision is' d 'digits'
do i = 1 to Words(p)
call Time('r'); f = Word(p,i); h = Fact(f)
parse var h 'E' e
if e = '' then
say f'!' 'has exact' Length(h) 'digits' '('Format(Time('e'),,3)'s)'
else
say f'!' 'has about' e+1 'digits' '('Format(Time('e'),,3)'s)'
end
say
return
Fact:
/* Factorial = n! */
procedure expose fact.
arg x
/* Current in memory? */
if fact.factorial.x <> 0 then
return fact.factorial.x
/* Previous in memory? */
w = x-1
if fact.factorial.w = 0 then do
/* Loop cf definition */
y = 1
do n = 2 to x
y = y*n
end
fact.factorial.x = y
end
else
/* Multiply */
fact.factorial.x = fact.factorial.w*x
return fact.factorial.x
include Functions
include Abend

6
Task/Factorial/SQL/factorial.sql Normal file
View file

@ -0,0 +1,6 @@
WITH RECURSIVE f(a, b) AS (
VALUES(1, 1)
UNION ALL
SELECT a * b, b + 1 FROM f WHERE b <= 9
)
SELECT MAX(a) FROM f

14
Task/Factorial/Tcl/factorial-1.tcl
View file

@ -1,6 +1,12 @@
proc ifact n {
for {set i $n; set sum 1} {$i >= 2} {incr i -1} {
set sum [expr {$sum * $i}]
# tailcall optimization is standard in tcl8.6
proc fact { n { result 1. } } {
if { $n <= 1 } {
return $result
} else {
tailcall fact [expr {$n-1}] [expr {$n*$result}]
}
return $sum
}
set f [fact 10]
puts $f

7
Task/Factorial/Tcl/factorial-2.tcl
View file

@ -1,3 +1,6 @@
proc rfact n {
expr {$n < 2 ? 1 : $n * [rfact [incr n -1]]}
proc ifact n {
for {set i $n; set sum 1} {$i >= 2} {incr i -1} {
set sum [expr {$sum * $i}]
}
return $sum
}

4
Task/Factorial/Tcl/factorial-3.tcl
View file

@ -1 +1,3 @@
proc tcl::mathfunc::fact n {expr {$n < 2? 1: $n*fact($n-1)}}
proc rfact n {
expr {$n < 2 ? 1 : $n * [rfact [incr n -1]]}
}

18
Task/Factorial/Tcl/factorial-4.tcl
View file

@ -1,17 +1 @@
proc ifact_caching n {
global fact_cache
if { ! [info exists fact_cache]} {
set fact_cache {1 1}
}
if {$n < [llength $fact_cache]} {
return [lindex $fact_cache $n]
}
set i [expr {[llength $fact_cache] - 1}]
set sum [lindex $fact_cache $i]
while {$i < $n} {
incr i
set sum [expr {$sum * $i}]
lappend fact_cache $sum
}
return $sum
}
proc tcl::mathfunc::fact n {expr {$n < 2? 1: $n*fact($n-1)}}

28
Task/Factorial/Tcl/factorial-5.tcl
View file

@ -1,11 +1,17 @@
puts [ifact 30]
puts [rfact 30]
puts [ifact_caching 30]
set n 400
set iterations 10000
puts "calculate $n factorial $iterations times"
puts "ifact: [time {ifact $n} $iterations]"
puts "rfact: [time {rfact $n} $iterations]"
# for the caching proc, reset the cache between each iteration so as not to skew the results
puts "ifact_caching: [time {ifact_caching $n; unset -nocomplain fact_cache} $iterations]"
proc ifact_caching n {
global fact_cache
if { ! [info exists fact_cache]} {
set fact_cache {1 1}
}
if {$n < [llength $fact_cache]} {
return [lindex $fact_cache $n]
}
set i [expr {[llength $fact_cache] - 1}]
set sum [lindex $fact_cache $i]
while {$i < $n} {
incr i
set sum [expr {$sum * $i}]
lappend fact_cache $sum
}
return $sum
}

14
Task/Factorial/Tcl/factorial-6.tcl
View file

@ -1,5 +1,11 @@
package require math::special
puts [ifact 30]
puts [rfact 30]
puts [ifact_caching 30]
proc gfact n {
expr {round([::math::special::Gamma [expr {$n+1}]])}
}
set n 400
set iterations 10000
puts "calculate $n factorial $iterations times"
puts "ifact: [time {ifact $n} $iterations]"
puts "rfact: [time {rfact $n} $iterations]"
# for the caching proc, reset the cache between each iteration so as not to skew the results
puts "ifact_caching: [time {ifact_caching $n; unset -nocomplain fact_cache} $iterations]"

5
Task/Factorial/Tcl/factorial-7.tcl Normal file
View file

@ -0,0 +1,5 @@
package require math::special
proc gfact n {
expr {round([::math::special::Gamma [expr {$n+1}]])}
}

28
Task/Factorial/Uxntal/factorial.uxnatl
View file

@ -1,4 +1,28 @@
@factorial ( n* -: fact* )
%newline { [ LIT2 0a -Console/write ] DEO }
|18 @Console/write
|100
#0900
&loop
DUP #00 SWP factorial print/dec newline
INC GTHk ?&loop
POP2
BRK
@factorial ( n* -- n!* )
ORAk ?{ POP2 #0001 JMP2r }
DUP2 #0001 SUB2 factorial MUL2
JMP2r
JMP2r
@print/dec ( short* -- )
#000a SWP2 [ LITr ff ]
&get ( -- )
SWP2k DIV2k MUL2 SUB2 STH
POP OVR2 DIV2 ORAk ?&get
POP2 POP2
&put ( -- )
STHr INCk ?{ POP JMP2r }
[ LIT "0 ] ADD .Console/write DEO !&put