比赛 HAOI2009 模拟试题4 评测结果 AWTT
题目名称 服务器储存信息问题 最终得分 25
用户昵称 苏轼 运行时间 0.000 s
代码语言 Pascal 内存使用 0.00 MiB
提交时间 2009-04-24 11:29:44
显示代码纯文本
{
 haoi2009 moni4 t2
 rp++
 time:2009.4.24
}
program cch(input,output);
const
 maxf=10000000;
type
 node=record
       p:integer;
       d:integer;
      end;
var
 map:array[1..30000,1..10] of node;
 flag:array[1..30000] of boolean;
 ans,tot,n,m:longint;
 a:array[1..10,0..30000] of integer;
 r,v:array[1..30000] of integer;
 d:array[1..30000] of longint;
 q:array[1..120000] of integer;

{procedure ins(x,y,z:longint);
var
 i:longint;
begin
 inc(tot); e[tot].p:=y; e[tot].d:=z; e[tot].next:=0;
 if v[x]=0 then e[x]:=tot
  else
   begin
    i:=v[x];
    while e[i].next<>0 do
      i:=e[i].next;
    e[i].next:=tot;
   end;
end;}

procedure init;
var
 i,y,z,x:longint;
begin
 assign(input,'servers.in');
 assign(output,'servers.out');
 reset(input);
 rewrite(output);
 readln(n,m);
 for i:=1 to 10 do flag[i]:=false;
 for i:=1 to 10 do a[i,0]:=0;
 for i:=1 to n do read(r[i]);
 for i:=1 to n do
  begin
   flag[r[i]]:=true;
   inc(a[r[i],0]); a[r[i],a[r[i],0]]:=i;
  end;
 tot:=0;
 for i:=1 to n do v[i]:=0;
 for i:=1 to m do
  begin
   readln(x,y,z);
   inc(v[i]); map[i,v[i]].p:=x; map[i,v[i]].d:=z;
  end;
end;

function find(x,y:integer):longint;
var
 i:integer;
begin
 for i:=1 to v[x] do
  if map[x,i].p=y then
   exit(map[x,i].d);
end;

procedure spfa(k:integer);
var
 flag:array[1..30000] of boolean;
 head,tail,i,x,y:longint;
begin
 for i:=1 to n do d[i]:=maxf;
 for i:=1 to n do flag[i]:=false;
 flag[k]:=true; d[k]:=0;
 head:=1; tail:=1;
 q[head]:=k;
 repeat
  x:=q[head]; flag[x]:=false;
  for i:=1 to v[x] do
   begin
    y:=find(x,map[x,i].p);
    if d[map[x,i].p]>d[x]+y then
     begin
      d[map[x,i].p]:=d[x]+y;
      if not flag[map[x,i].p] then
       begin
        inc(tail);
        q[tail]:=map[x,i].p;
        flag[map[x,i].p]:=false;
       end;
     end;
   end;
   inc(head);
  until head>tail;
end;

function check(x,y:integer):boolean;
var
 i,j:integer;
begin
 for i:=r[y]+1 to 10 do
  if flag[i] then
   for j:=1 to a[i,0] do
    if d[y]>d[a[i,j]] then exit(true);
end;

procedure main;
var
 i,j:integer;
begin
 ans:=n;
 for i:=1 to n do
  begin
   spfa(i);
   for j:=1 to n do
    if r[i]<r[j] then
     if check(i,j) then
      inc(ans);
  end;
end;

procedure print;
begin
 writeln(ans);
 close(input);
 close(output);
end;

begin
 init;
 main;
 print;
end.