Anonymous user
Permutations with some identical elements: Difference between revisions
Permutations with some identical elements (view source)
Revision as of 00:48, 9 August 2021
, 2 years ago→{{header|Pascal}}: correct search index to count of different elements gblMaxUsedIdx not gblMaxCardsUsed elements.Saves some time
(added Pascal) |
m (→{{header|Pascal}}: correct search index to count of different elements gblMaxUsedIdx not gblMaxCardsUsed elements.Saves some time) |
||
Line 540:
Most time consuming is appending to the stringlist.So I limited that to 10000<BR>
One can use the string directly in EvaluatePerm.
<lang pascal>program
{$IFDEF FPC}
{$mode Delphi
{$Optimization ON,All}
{$ELSE}
{$APPTYPE CONSOLE}
Line 562 ⟶ 563:
Elem : tDiffCardCount;
end;
tRemSet = array [low(tDeckIndex)..High(tDeckIndex)] of tSetElem;▼
▲ tRemSet = array [low(tDeckIndex)..High(tDeckIndex)] of tSetElem;
tpRemSet = ^tRemSet;
tRemainSet = array [low(tSequenceIndex)..High(tSequenceIndex)] of tRemSet;
tCardSequence = array [low(tSequenceIndex)..High(tSequenceIndex)] of tDiffCardCount;
var
{$ALIGN 32}
RemainSets : tRemainSet;
CardString : AnsiString;
CS : pchar;
sl :TStringList;
gblMaxCardsUsed,
gblMaxUsedIdx,
gblPermCount : NativeInt;
Line 602 ⟶ 606:
procedure SetInit(var ioSet:tRemSet;const inSet:tRemSet);
var
i,j,k,sum : integer;
begin
ioSet := inSet;
sum := 0;
k := 0;
write('Initial set : ');
For i := Low(ioSet) to High(ioSet) do
Begin
j := inSet[i].ElemCount;
if j <> 0 then
sum += j;
For j := j downto 1 do
write(chr(inSet[i].Elem));
end;
gblMaxUsedIdx := k;
writeln(' lenght: ',
end;
procedure EvaluatePerm;
Begin
//append
if gblPermCount < 10000 then
sl.append(CS);
Line 627 ⟶ 635:
procedure Permute(depth,MaxCardsUsed:NativeInt);
var
pSetElem : tpRemSet;//^tSetElem;
i : NativeInt;
begin
Line 633 ⟶ 641:
pSetElem := @RemainSets[depth];
repeat
if pSetElem^[i].Elemcount
//take one of the same elements of the stack
//insert in result here string
CS[depth] := chr(pSetElem^[i].Elem);
//done one permutation
IF depth = MaxCardsUsed then
Line 645 ⟶ 653:
else
begin
dec(pSetElem^.ElemCount);▼
▲ RemainSets[depth+1]:= RemainSets[depth];
Permute(depth+1,MaxCardsUsed);
▲ //re-insert that element
end;
end;
//move on to the next
▲ inc(pSetElem);
inc(i);
until i >= gblMaxUsedIdx;
Line 661 ⟶ 667:
Begin
gblpermCount := 0;
if MaxCardsUsed >
MaxCardsUsed :=
if MaxCardsUsed>0 then
Line 694 ⟶ 700:
SetInit(RemainSets[0], Manifolds);
j :=
writeln('Count of elements: ',j);
while j > 1 do
Line 711 ⟶ 717:
SetInit(RemainSets[0], Manifolds);
j :=
writeln('Count of elements: ',j);
while j > 1 do
Line 722 ⟶ 728:
dec(j);
end;
//extend by 3 more elements
with Manifolds[3] do
Line 735 ⟶ 742:
Elemcount := 1; Elem := Ord('6');
end;
SetInit(RemainSets[0], Manifolds);
j :=
writeln('Count of elements: ',j);
sl.clear;
Line 812 ⟶ 818:
Length 12 Permutations 3326400
</pre>
=={{header|Perl}}==
{{libheader|ntheory}}
| |||