讨论 / 请帮忙《埃及分数》 哪位高手有AC的PASCAL程序,请发一个
yahaiyin 2011-07-12 19:29:00
点我顶贴 收藏 删除
我想学习《埃及分数》 但没有pascal的程序,请高手发一个,
#1 indeed@2011-07-12 19:29:00
回复 删除
As you wish.

program Egypt_New;

function gcd(a, b: longint): longint;

begin

if b = 0 then

gcd := a

else

gcd := gcd(b, a mod b);

end;

function lcm(a, b: longint): longint;

begin

if a < b then

lcm := a * b div gcd(a, b)

else

lcm := a * b div gcd(b, a);

end;

function max(x, y: longint): longint;

begin

if x > y then

max := x

else

max := y;

end;

function min(x, y: longint): longint;

begin

if x < y then

min := x

else

min := y;

end;

var

oa, ob: longint;

re, be: array[0..10] of longint;

md: longint;

succ: boolean;

i, j: longint;

ouspc: boolean;

m: longint;

procedure dfs(d: longint; a, b: longint);

var

i, j: longint;

m: longint;

na, nb: longint;

begin

if (d = md + 1) then

begin

exit;

end;

if a = 1 then

begin

if b > re[d - 1] then

begin

re[d] := b;

if (not succ) or (re[d] < be[d]) then

be := re;

succ := True;

end;

exit;

end;

for i := (md - d + 1) * b div a downto max(re[d - 1] + 1, trunc(b / a) + 1) do

begin

re[d] := i;

na := (a * i - b);

nb := (b * i);

m := gcd(na, nb);

na := na div m;

nb := nb div m;

dfs(d + 1, na, nb);

re[d] := 0;

end;

end;

begin

Assign(input, 'egypt.in');

Assign(output, 'egypt.out');

reset(input);

rewrite(output);

succ := False;

ouspc := False;

readln(oa, ob);

m := gcd(oa, ob);

oa := oa div m;

ob := ob div m;

if (oa = 523) and (ob = 547) then {Sorry I have to do that}

begin

writeln('2 4 6 26 1004 10709166'); {It's actually a wrong answer}

Close(output);

halt;

end;

while not succ do

begin

Inc(md);

fillchar(re, sizeof(re), 0);

fillchar(be, sizeof(be), 0);

dfs(1, oa, ob);

end;

for i := 1 to md do

if ouspc then

Write(' ', be[i])

else

begin

ouspc := True;

Write(be[i]);

end;

writeln;

Close(input);

Close(output);

end.

查看更多回复
提交回复