Delphi XE8 中的数字分区算法生成器
Number Partition Algorithm Generator in Delphi XE8
如何在Delphi XE8?[=22=中使用高效简单的算法输出数字N
Partitions的列表]
例如N=4
,结果(假设在TListBox
中列出):
4
3 + 1
2 + 2
2 + 1 + 1
1 + 1 + 1 + 1
我试过,决定使用动态数组:
var
IntegerArray: array of Integer;
数一数,二数,三数,...
然后在 TListBox
:
中输入动态数组
procedure TMForm.AddItem;
var
Temp: String;
I: Integer;
II: Integer;
begin
Temp:= '';
for II:= 0 to Length(IntegerArray)-1 do
begin
for I := 0 to (IntegerArray[(Length(IntegerArray)-II)-1]-1) do
begin
Temp:= Temp+IntToStr(Length(IntegerArray)-II-1);
Temp:= Temp+'+';
end;
end;
delete(Temp,length(Temp),1);
ListBox1.Items.Add(Temp);
end;
并开始编写算法(目前有效,但仅使用数字 1、2 和 3 来写入分区),但似乎我需要重写它以使用递归(因此它将使用所有可用的数字来写入分区),这就是我的问题;这里如何使用递归?
function TMForm.Calculate(MyInt: Integer): Integer;
var
I: Integer;
begin
ListBox1.Clear;
GlobalInt:= MyInt;
Result:= 0;
SetLength(IntegerArray, 0);
SetLength(IntegerArray, (MyInt+1));
IntegerArray[1]:= MyInt;
AddItem;
Result:= Result+1;
//
if MyInt>1 then
begin
repeat
IntegerArray[1]:= IntegerArray[1]-2;
IntegerArray[2]:= IntegerArray[2]+1;
AddItem;
Result:= Result+1;
until ((IntegerArray[1]/2) < 1 );
if MyInt>2 then
repeat
IntegerArray[3]:= IntegerArray[3]+1;
IntegerArray[1]:= MyInt-IntegerArray[3]*3;
IntegerArray[2]:= 0;
AddItem;
Result:= Result+1;
if NOT ((IntegerArray[1]/2) < 1) then
repeat
IntegerArray[1]:= IntegerArray[1]-2;
IntegerArray[2]:= IntegerArray[2]+1;
AddItem;
Result:= Result+1;
until ((IntegerArray[1]/2) <=1 );
IntegerArray[1]:= MyInt-IntegerArray[3]*3;
IntegerArray[2]:= 0;
until ((IntegerArray[1]/3) < 1 );
//if MyInt>3 then...
end;
Edit1.Text:= IntToStr(Result);
end;
运行当前程序示例:
更新
设法让它像这样工作:
procedure TMForm.Calculate(MyInt: Integer);
var
I: Integer;
begin
ListBox1.Clear;
GlobalInt:= MyInt;
ItemCount:= 0;
SetLength(IntegerArray, 0);
SetLength(IntegerArray, (MyInt+1));
IntegerArray[1]:= MyInt;
AddItem;
ItemCount:= ItemCount+1;
//
if MyInt>1 then
Step2;
if MyInt>2 then
for I := 3 to MyInt do
Steps(I);
Edit1.Text:= IntToStr(ItemCount);
end;
procedure TMForm.Steps(n: Integer);
var
I,II: Integer;
begin
if not ((IntegerArray[1]/n) < 1 ) then
repeat
IntegerArray[n]:= IntegerArray[n]+1;
//
IntegerArray[1]:= GlobalInt;
for I:= 3 to GlobalInt do IntegerArray[1]:= IntegerArray[1]-IntegerArray[I]*I;
//
AddItem;
ItemCount:= ItemCount+1;
Step2;
if n>3 then
for II := 3 to (n-1) do
begin
Steps(II);
end;
until ((IntegerArray[1]/n) < 1 );
//
IntegerArray[n]:= 0;
IntegerArray[1]:= GlobalInt;
for I:= 3 to GlobalInt do IntegerArray[1]:= IntegerArray[1]-IntegerArray[I]*I;
end;
procedure TMForm.SpinBox1Change(Sender: TObject);
begin
SpinBox2.Value:= SpinBox1.Value;
end;
procedure TMForm.Step2;
var
I: Integer;
begin
if NOT ((IntegerArray[1]/2) < 1) then
repeat
IntegerArray[1]:= IntegerArray[1]-2;
IntegerArray[2]:= IntegerArray[2]+1;
AddItem;
ItemCount:= ItemCount+1;
until ((IntegerArray[1]/2) < 1 );
IntegerArray[2]:= 0;
IntegerArray[1]:= GlobalInt;
for I:= 3 to GlobalInt do IntegerArray[1]:= IntegerArray[1]-IntegerArray[I]*I;
end;
procedure TMForm.FormCreate(Sender: TObject);
begin
//
end;
但显然,我需要一些优化。
你是对的,最简单的实现是递归。
有一些优化的可能性(对于较大的值,最好存储较小值的分区并一次又一次地使用它们),但我认为对于大 N 值,结果列表大小对于输出
//N is number for partitions, M is maximum part value
//(used here to avoid permutation repeats like 3 1 and 1 3)
procedure Partitions(N, M: integer; s: string);
var
i: integer;
begin
if N = 0 then
Memo1.Lines.Add(s)
else
for i := Min(M, N) downto 1 do
Partitions(N - i, i, s + IntToStr(i) + ' ');
end;
begin
Partitions(7, 7, '');
给出输出
7
6 1
5 2
5 1 1
4 3
4 2 1
4 1 1 1
3 3 1
3 2 2
3 2 1 1
3 1 1 1 1
2 2 2 1
2 2 1 1 1
2 1 1 1 1 1
1 1 1 1 1 1 1
从您的 link 中引用了:Fast Algorithms for Generating Integer Partitions
.
在那里实施建议的最快算法(ZS1 和 ZS2)如下所示:
(注意,这里没有递归!)
procedure PartitionsZS1(n: Integer);
var
x: TArray<Integer>;
i,r,h,t,m: Integer;
begin
SetLength(x,n+1);
for i := 1 to n do x[i] := 1;
x[1] := n;
m := 1;
h := 1;
WriteLn(x[1]);
while (x[1] <> 1) do begin
if (x[h] = 2) then begin
m := m + 1;
x[h] := 1;
h := h - 1;
end
else begin
r := x[h] - 1;
t := m - h + 1;
x[h] := r;
while (t >= r) do begin
h := h + 1;
x[h] := r;
t := t - r;
end;
if (t = 0) then
m := h
else begin
m := h + 1;
if (t > 1) then begin
h := h + 1;
x[h] := t;
end;
end;
end;
for i := 1 to m do Write(x[i]);
WriteLn;
end;
end;
procedure PartitionsZS2(n: Integer);
var
x: TArray<Integer>;
i,j,r,h,m: Integer;
begin
SetLength(x,n+1);
for i := 1 to n do x[i] := 1;
for i := 1 to n do Write(x[i]);
WriteLn;
x[0] := -1;
x[1] := 2;
h := 1;
m := n - 1;
for i := 1 to m do Write(x[i]);
WriteLn;
while (x[1] <> n) do begin
if (m-h > 1) then begin
h := h + 1;
x[h] := 2;
m := m - 1;
end
else begin
j := m - 2;
while (x[j] = x[m - 1]) do begin
x[j] := 1;
j := j - 1;
end;
h := j + 1;
x[h] := x[m - 1] + 1;
r := x[m] + x[m - 1]*(m-h-1);
x[m] := 1;
if (m - h) > 1 then
x[m-1] := 1;
m := h + r - 1;
end;
for i := 1 to m do Write(x[i]);
WriteLn;
end;
end;
program Project61;
{$APPTYPE CONSOLE}
begin
PartitionsZS1(7);
WriteLn;
PartitionsZS2(7);
end.
输出:
7
61
52
511
43
421
4111
331
322
3211
31111
2221
22111
211111
1111111
1111111
211111
22111
2221
31111
3211
322
331
4111
421
43
511
52
61
7
如何在Delphi XE8?[=22=中使用高效简单的算法输出数字N
Partitions的列表]
例如N=4
,结果(假设在TListBox
中列出):
4
3 + 1
2 + 2
2 + 1 + 1
1 + 1 + 1 + 1
我试过,决定使用动态数组:
var
IntegerArray: array of Integer;
数一数,二数,三数,...
然后在 TListBox
:
procedure TMForm.AddItem;
var
Temp: String;
I: Integer;
II: Integer;
begin
Temp:= '';
for II:= 0 to Length(IntegerArray)-1 do
begin
for I := 0 to (IntegerArray[(Length(IntegerArray)-II)-1]-1) do
begin
Temp:= Temp+IntToStr(Length(IntegerArray)-II-1);
Temp:= Temp+'+';
end;
end;
delete(Temp,length(Temp),1);
ListBox1.Items.Add(Temp);
end;
并开始编写算法(目前有效,但仅使用数字 1、2 和 3 来写入分区),但似乎我需要重写它以使用递归(因此它将使用所有可用的数字来写入分区),这就是我的问题;这里如何使用递归?
function TMForm.Calculate(MyInt: Integer): Integer;
var
I: Integer;
begin
ListBox1.Clear;
GlobalInt:= MyInt;
Result:= 0;
SetLength(IntegerArray, 0);
SetLength(IntegerArray, (MyInt+1));
IntegerArray[1]:= MyInt;
AddItem;
Result:= Result+1;
//
if MyInt>1 then
begin
repeat
IntegerArray[1]:= IntegerArray[1]-2;
IntegerArray[2]:= IntegerArray[2]+1;
AddItem;
Result:= Result+1;
until ((IntegerArray[1]/2) < 1 );
if MyInt>2 then
repeat
IntegerArray[3]:= IntegerArray[3]+1;
IntegerArray[1]:= MyInt-IntegerArray[3]*3;
IntegerArray[2]:= 0;
AddItem;
Result:= Result+1;
if NOT ((IntegerArray[1]/2) < 1) then
repeat
IntegerArray[1]:= IntegerArray[1]-2;
IntegerArray[2]:= IntegerArray[2]+1;
AddItem;
Result:= Result+1;
until ((IntegerArray[1]/2) <=1 );
IntegerArray[1]:= MyInt-IntegerArray[3]*3;
IntegerArray[2]:= 0;
until ((IntegerArray[1]/3) < 1 );
//if MyInt>3 then...
end;
Edit1.Text:= IntToStr(Result);
end;
运行当前程序示例:
更新
设法让它像这样工作:
procedure TMForm.Calculate(MyInt: Integer);
var
I: Integer;
begin
ListBox1.Clear;
GlobalInt:= MyInt;
ItemCount:= 0;
SetLength(IntegerArray, 0);
SetLength(IntegerArray, (MyInt+1));
IntegerArray[1]:= MyInt;
AddItem;
ItemCount:= ItemCount+1;
//
if MyInt>1 then
Step2;
if MyInt>2 then
for I := 3 to MyInt do
Steps(I);
Edit1.Text:= IntToStr(ItemCount);
end;
procedure TMForm.Steps(n: Integer);
var
I,II: Integer;
begin
if not ((IntegerArray[1]/n) < 1 ) then
repeat
IntegerArray[n]:= IntegerArray[n]+1;
//
IntegerArray[1]:= GlobalInt;
for I:= 3 to GlobalInt do IntegerArray[1]:= IntegerArray[1]-IntegerArray[I]*I;
//
AddItem;
ItemCount:= ItemCount+1;
Step2;
if n>3 then
for II := 3 to (n-1) do
begin
Steps(II);
end;
until ((IntegerArray[1]/n) < 1 );
//
IntegerArray[n]:= 0;
IntegerArray[1]:= GlobalInt;
for I:= 3 to GlobalInt do IntegerArray[1]:= IntegerArray[1]-IntegerArray[I]*I;
end;
procedure TMForm.SpinBox1Change(Sender: TObject);
begin
SpinBox2.Value:= SpinBox1.Value;
end;
procedure TMForm.Step2;
var
I: Integer;
begin
if NOT ((IntegerArray[1]/2) < 1) then
repeat
IntegerArray[1]:= IntegerArray[1]-2;
IntegerArray[2]:= IntegerArray[2]+1;
AddItem;
ItemCount:= ItemCount+1;
until ((IntegerArray[1]/2) < 1 );
IntegerArray[2]:= 0;
IntegerArray[1]:= GlobalInt;
for I:= 3 to GlobalInt do IntegerArray[1]:= IntegerArray[1]-IntegerArray[I]*I;
end;
procedure TMForm.FormCreate(Sender: TObject);
begin
//
end;
但显然,我需要一些优化。
你是对的,最简单的实现是递归。
有一些优化的可能性(对于较大的值,最好存储较小值的分区并一次又一次地使用它们),但我认为对于大 N 值,结果列表大小对于输出
//N is number for partitions, M is maximum part value
//(used here to avoid permutation repeats like 3 1 and 1 3)
procedure Partitions(N, M: integer; s: string);
var
i: integer;
begin
if N = 0 then
Memo1.Lines.Add(s)
else
for i := Min(M, N) downto 1 do
Partitions(N - i, i, s + IntToStr(i) + ' ');
end;
begin
Partitions(7, 7, '');
给出输出
7
6 1
5 2
5 1 1
4 3
4 2 1
4 1 1 1
3 3 1
3 2 2
3 2 1 1
3 1 1 1 1
2 2 2 1
2 2 1 1 1
2 1 1 1 1 1
1 1 1 1 1 1 1
从您的 link 中引用了:Fast Algorithms for Generating Integer Partitions .
在那里实施建议的最快算法(ZS1 和 ZS2)如下所示: (注意,这里没有递归!)
procedure PartitionsZS1(n: Integer);
var
x: TArray<Integer>;
i,r,h,t,m: Integer;
begin
SetLength(x,n+1);
for i := 1 to n do x[i] := 1;
x[1] := n;
m := 1;
h := 1;
WriteLn(x[1]);
while (x[1] <> 1) do begin
if (x[h] = 2) then begin
m := m + 1;
x[h] := 1;
h := h - 1;
end
else begin
r := x[h] - 1;
t := m - h + 1;
x[h] := r;
while (t >= r) do begin
h := h + 1;
x[h] := r;
t := t - r;
end;
if (t = 0) then
m := h
else begin
m := h + 1;
if (t > 1) then begin
h := h + 1;
x[h] := t;
end;
end;
end;
for i := 1 to m do Write(x[i]);
WriteLn;
end;
end;
procedure PartitionsZS2(n: Integer);
var
x: TArray<Integer>;
i,j,r,h,m: Integer;
begin
SetLength(x,n+1);
for i := 1 to n do x[i] := 1;
for i := 1 to n do Write(x[i]);
WriteLn;
x[0] := -1;
x[1] := 2;
h := 1;
m := n - 1;
for i := 1 to m do Write(x[i]);
WriteLn;
while (x[1] <> n) do begin
if (m-h > 1) then begin
h := h + 1;
x[h] := 2;
m := m - 1;
end
else begin
j := m - 2;
while (x[j] = x[m - 1]) do begin
x[j] := 1;
j := j - 1;
end;
h := j + 1;
x[h] := x[m - 1] + 1;
r := x[m] + x[m - 1]*(m-h-1);
x[m] := 1;
if (m - h) > 1 then
x[m-1] := 1;
m := h + r - 1;
end;
for i := 1 to m do Write(x[i]);
WriteLn;
end;
end;
program Project61;
{$APPTYPE CONSOLE}
begin
PartitionsZS1(7);
WriteLn;
PartitionsZS2(7);
end.
输出:
7
61
52
511
43
421
4111
331
322
3211
31111
2221
22111
211111
1111111
1111111
211111
22111
2221
31111
3211
322
331
4111
421
43
511
52
61
7