从1到100中找10个整数，使他们倒数的和等于1

adson 2001-12-06 05:15:43

从1到100中找10个整数，使他们倒数的和等于1，很容易找到一组解
1 1 1 1 1
— + — + —— ......－－+ ---=1
1x2 2x3 3x4 9x10 10

不过还有一个问题，能否找出一个时间复杂度比较小的算法找出一共有多少组符合
条件的解。

如果简单的用10个for语句嵌套加上简单的判断语句，复杂度在10的15次方以上，一般的PC机一时半会根本跑不出来。

...全文

384 10 打赏收藏转发到动态举报

写回复

用AI写文章

10 条回复

切换为时间正序

请发表友善的回复…

发表回复

mathe 2001-12-08

打赏
举报

这是我这个月在这里看到的最好的解答。
果然是intfree. To deal with integer freely.

minkerui 2001-12-07

打赏
举报

好长！讲讲思路好吗？

intfree 2001-12-07

打赏
举报

其实把误差 e = 1e-5; 改为 e = 1e-10
不用高精度，也可以得到同样的答案

intfree 2001-12-07

打赏
举报

答案是 69014

在C700+256M+Delphi6+win2k下，用20s出解

附程序：
{$O+,R-,S-,Q-}

uses sysutils, dialogs;

const
n = 10;
m = 100;
maxlen = 200;
e = 1e-5;
mask = 49999;

type
TBigNumber = record
l: integer;
num: array[1 .. maxlen] of byte;
end;

var
ls: array[1 .. n] of integer;
dd: array[1 .. m] of extended;
mins: array[0 .. n] of extended;
maxs: array[0 .. m, 0 .. n] of extended;
mmask: array[0 .. m] of integer;
vs: array[0 .. m] of TBigNumber;
f: array[1 .. m + 1, 0 .. mask] of byte;
temp: TBigNumber;
sum: integer;

procedure inith(var x: TBigNumber; k: integer); //x := k;
begin
fillchar(x, sizeof(x), 0);
x.l := 1; x.num[x.l] := k;
end;

procedure mul(var x: TBigNumber; k: integer); //x := x * k;
var
i, v, p: integer;
begin
p := 0;
for i := 1 to x.l do begin
v := x.num[i] * k + p;
p := v div 10;
x.num[i]:= v mod 10;
end;
while p > 0 do begin
x.l := x.l + 1;
x.num[x.l] := p mod 10;
p := p div 10;
end;
end;

procedure add(var x, y: TBigNumber); // x := x + y;
var
i: integer;
begin
if y.l > x.l then x.l := y.l;
for i := 1 to x.l do begin
x.num[i] := x.num[i] + y.num[i];
if x.num[i] >= 10 then begin
x.num[i] := x.num[i] - 10;
x.num[i + 1] := x.num[i + 1] + 1;
end;
end;
if x.num[x.l + 1] <> 0 then x.l := x.l + 1;
end;

function same(const x, y: TBigNumber): boolean;
var
i: integer;
begin
result := false;
if x.l <> y.l then exit;
for i := 1 to x.l do
if x.num[i] <> y.num[i] then
exit;
result := true;
end;

procedure init;
var
i, k, s: integer;
begin

sum := 0;

for i := 0 to m do begin
s := 1; inith(vs[i], 1);
for k := 1 to m do
if k <> i then begin
s := (s * k) mod mask;
mul(vs[i], k);
end;
mmask[i] := s;
end;

f[m + 1, 0] := 0;
for i := 1 to mask - 1 do
f[m + 1, i] := n + 1;

for i := m downto 1 do begin
f[i] := f[i + 1];
for s := 0 to mask - 1 do begin
k := f[i + 1, (s - mmask[i] + mask) mod mask] + 1;
if k < f[i, s] then
f[i, s] := k;
end;
end;

mins[0] := 0;
for i := 1 to n do
mins[i] := mins[i - 1] + 1 / (m - i + 1);

for i := 0 to m do begin
maxs[i, 0] := 0;
for k := 1 to n do
maxs[i, k] := maxs[i, k - 1] + 1 / (i + k);
end;

for i := 1 to m do
dd[i] := 1 / i;

end;

procedure search(d, last, smask: integer; s: extended);
var
i: integer;
begin

if (s + maxs[last, d] < 1 - e) or
(s + mins[d] > 1 + e) or
(f[last + 1, smask] > d) then
exit;

if d = 0 then begin

{
The result is 69014;

write(sum, ': ');
for i := 1 to n do
write(ls[i], ' ');
writeln;
}

inith(temp, 0);
for i := 1 to n do
add(temp, vs[ls[i]]);

if same(temp, vs[0]) then
sum := sum + 1;
exit;

end;

smask := smask + mask;

for i := last + 1 to m - d + 1 do begin
ls[d] := i;
search(d - 1, i, (smask - mmask[i]) mod mask, s + dd[i]);
end;

end;

begin
init;
search(n, 0, mmask[0], 0);
showmessage(inttostr(sum));
end.

minkerui 2001-12-07

打赏
举报

速度很慢！而且我把原题目中的10个数改为了五个：－（
等一会儿我贴一个剪枝好一点的。

minkerui 2001-12-07

打赏
举报

PROGRAM DaoShuHe;
Var
CycI,CycJ:Integer;
Used:Array[1..100] Of Boolean;
Procedure Find(Step:Byte;Count:Real);
Var
Cyc:Byte;
Begin
If Step=5 Then
Begin
If Count=1 Then
Begin
For CycI:=1 To 100 Do
Begin
If Used[CycI]=True Then
Write('1/',CycI,'+');
End;
Write(Chr(8));
WriteLn('=1');
End;
Exit;
End;

If (Count=1)And(Step<>10) Then Exit;
For Cyc:=1 To 100 Do
Begin
If (Used[Cyc]=False)And(1-Count>=1/Cyc) Then
Begin
Used[Cyc]:=True;
Find(Step+1,Count+1/Cyc);
Used[Cyc]:=False;
End;
End;
End;

Begin
FillChar(Used,SizeOf(Used),False);
Find(0,0);
End.

minkerui 2001-12-07

打赏
举报

改进版本：

PROGRAM DaoShuHe;
Const
THENUM=2;
Var
JinSi:Word;
Total:LongInt;
CycI,CycJ:Integer;
Used:Array[1..100] Of Boolean;
TempNum:Real;

Function GetLastMaxNum(HadCount,Num:Byte):Real;
Var
Temp:Real;
Begin
Temp:=0;
For CycI:=Num+1 To Num+1+THENUM-HadCount Do
Temp:=Temp+(1/CycI);
GetLastMaxNum:=Temp;
End;

Procedure Find(Step,Last:Byte;Count:Real);
Var
Cyc:Byte;
Begin
If Step=THENUM Then
Begin
If Count=1 Then
Begin
{}
{------ Print ------}
For CycI:=1 To 100 Do
Begin
If Used[CycI]=True Then
Write('1/',CycI,'+');
End;
Write(Chr(8));
WriteLn('=1');
{}
Inc(Total);
End;
Exit;
End;

If (Count=1)And(Step<>THENUM) Then Exit;
TempNum:=GetLastMaxNum(Step,Last);
If TempNum<(1-Count) Then Exit;
For Cyc:=Last+1 To 100 Do
Begin
If (1-Count>=1/Cyc) Then
Begin
Used[Cyc]:=True;
Find(Step+1,Cyc,Count+1/Cyc);
Used[Cyc]:=False;
End
End;
End;

Begin
WriteLn;
FillChar(Used,SizeOf(Used),False);
Find(0,0,0);
WriteLn('Total:',Total);
End.

intfree 2001-12-07