切换到宽版
  • 11607阅读
  • 1回复

卡壳~~~大家救我~~~ [复制链接]

上一主题 下一主题
离线stevenjl
 

只看楼主 倒序阅读 0 发表于: 2006-08-20
Dream Walker...
离线archimedes

只看该作者 1 发表于: 2006-08-22
{
ID:oifans1
PROG:concom
LANG:PASCAL
}

program concom;
const
maxc=100;
var
fin,fout:text;
per:array[1..maxc,1..maxc]of byte;{Percentages}
con:array[1..maxc,1..maxc]of boolean;{Control}
n,i,j:integer;
min,max,x,y:byte;
flag:boolean;
procedure check(x,y:byte);
var
  i,sum:byte;
begin
  sum:=0;
  for i:=min to max do
    if con[x,i] then begin
    sum:=sum+per[i,y];
    if sum>=50 then break;
    end;
  if sum>=50 then begin
    con[x,y]:=true;
    flag:=true;
  end;
end;
begin
fillchar(per,sizeof(per),0);
fillchar(con,sizeof(con),0);
min:=maxc;max:=1;
assign(fin,'concom.in');
reset(fin);
readln(fin,n);
for i:=1 to n do begin
  readln(fin,x,y,j);
  if x<min then min:=x;
  if x>max then max:=x;
  if y<min then min:=y;
  if y>max then max:=y;
  per[x,y]:=j;
  if j>=50 then con[x,y]:=true;
end;
close(fin);
for i:=min to max do
  con[i,i]:=true;

repeat
  flag:=false;
  for i:=min to max do
    for j:=min to max do
    if not con[i,j] then check(i,j);
until not flag;

assign(fout,'concom.out');
rewrite(fout);
for i:=min to max do
  for j:=min to max do
    if (i<>j) and con[i,j] then writeln(fout,i,' ',j);
close(fout);
end.
快速回复
限100 字节
 
上一个 下一个