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-02-27 18:35:13 -05:00
parent 8e4e15fa56
commit 72eb4943cb
1853 changed files with 35514 additions and 9441 deletions
Download patch file Download diff file Expand all files Collapse all files

1
Task/Determinant-and-permanent/00-TASK.txt
View file

@ -8,7 +8,6 @@ In both cases the sum is over the permutations <math>\sigma</math> of the permut
More efficient algorithms for the determinant are known: [[LU decomposition]], see for example [[wp:LU decomposition#Computing the determinant]]. Efficient methods for calculating the permanent are not known.
;Related task:
* [[Permutations by swapping]]
<br><br>

84
Task/Determinant-and-permanent/ALGOL-68/determinant-and-permanent.alg Normal file
View file

@ -0,0 +1,84 @@
BEGIN # matrix determinant and permanent #
# - translated from the Phix sample, via EasyLang #
MODE NUMBER = REAL; # type of matrix elements to be handled #
# adjust to suit, if necessary #
PROC minor = ( [,]NUMBER a, INT x, y )[,]NUMBER:
BEGIN
[ 1 LWB a : 1 UPB a - 1, 2 LWB a : 2 UPB a - 1 ]NUMBER r;
FOR i FROM 1 LWB a TO 1 UPB a - 1 DO
FOR j FROM 2 LWB a TO 2 UPB a - 1 DO
r[ i, j ] := a[ i + ABS ( i >= x ), j + ABS ( j >= y ) ]
OD
OD;
r
END # minor # ;
PROC det = ( [,]NUMBER a )NUMBER:
IF 1 UPB a = 1 LWB a THEN # only one NUMBER #
a[ 1 LWB a, 2 LWB a ]
ELSE
INT sgn := 1;
NUMBER res := 0;
FOR i FROM 2 LWB a TO 2 UPB a DO
res +:= sgn * a[ 1 LWB a, i ] * det( minor( a, 1 LWB a, i ) );
sgn := - sgn
OD;
res
FI # det # ;
PROC perm = ( [,]NUMBER a )NUMBER:
IF 1 UPB a = 1 LWB a THEN # only one NUMBER #
a[ 1 LWB a, 2 LWB a ]
ELSE
NUMBER res := 0;
FOR i FROM 2 LWB a TO 2 UPB a DO
res +:= a[ 1 LWB a, i ] * perm( minor( a, 1 LWB a, i ) )
OD;
res
FI # perm # ;
BEGIN # test cases #
PROC test det and perm = ( [,]NUMBER a )VOID:
print( ( whole( det( a ), -8 ), " ", whole( perm( a ), -8 ), newline ) );
test det and perm( ( ( 1, 2 )
, ( 3, 4 )
)
);
test det and perm( ( ( 2, 9, 4 )
, ( 7, 5, 3 )
, ( 6, 1, 8 )
) );
test det and perm( ( ( -2, 2, -3 )
, ( -1, 1, 3 )
, ( 2, 0, -1 )
)
);
test det and perm( ( ( 1, 2, 3, 4 )
, ( 4, 5, 6, 7 )
, ( 7, 8, 9, 10 )
, ( 10, 11, 12, 13 )
)
);
test det and perm( ( ( 0, 1, 2, 3, 4 )
, ( 5, 6, 7, 8, 9 )
, ( 10, 11, 12, 13, 14 )
, ( 15, 16, 17, 18, 19 )
, ( 20, 21, 22, 23, 24 )
)
);
test det and perm( ( ( 5 ) ) );
test det and perm( ( ( 1, 0, 0 )
, ( 0, 1, 0 )
, ( 0, 0, 1 )
)
);
test det and perm( ( ( 0, 0, 1 )
, ( 0, 1, 0 )
, ( 1, 0, 0 )
)
)
END
END

48
Task/Determinant-and-permanent/XPL0/determinant-and-permanent.xpl0 Normal file
View file

@ -0,0 +1,48 @@
func DetPerm(Det, A, N); \Return value of determinant or permanent of A, order N
int Det, A, N;
int B Sum, Term;
int I, K, L;
[if N = 1 then return A(0, 0);
B:= Reserve((N-1)*4);
Sum:= 0;
for I:= 0 to N-1 do
[L:= 0;
for K:= 0 to N-1 do
if K # I then
[B(L):= @A(K, 1); L:= L+1];
Term:= A(I, 0) * DetPerm(Det, B, N-1);
if Det & I&1 then Term:= -Term;
Sum:= Sum + Term;
];
return Sum;
];
int Arrays, I;
[Arrays:= [
[ [1, 2],
[3, 4] ],
[ [-2, 2, -3],
[-1, 1, 3],
[ 2, 0, -1] ],
[ [ 1, 2, 3, 4],
[ 4, 5, 6, 7],
[ 7, 8, 9, 10],
[10, 11, 12, 13] ],
[ [ 0, 1, 2, 3, 4],
[ 5, 6, 7, 8, 9],
[10, 11, 12, 13, 14],
[15, 16, 17, 18, 19],
[20, 21, 22, 23, 24] ]
];
for I:= 0 to 3 do
[Text(0, "Determinant: ");
IntOut(0, DetPerm(true, Arrays(I), I+2));
CrLf(0);
Text(0, "Permanent : ");
IntOut(0, DetPerm(false, Arrays(I), I+2));
CrLf(0); CrLf(0);
];
]