wa #5 , can anyone give some testcases ? thanks
Послано
Ctna 24 янв 2010 17:49
This is my code, help me with some wrong tests , please ^^
Program Tree2;
Uses Math;//,crt;
Const Finp ='';//
Fout ='';
Maxn =20001;
Type Pt =^rc;
rc=Record
v:Longint;
Next:Pt;
End;
Var fi,fo :Text;
n,k,Low,S,T:Longint;
List :Array[1..Maxn] of Pt;
A,C,tr,v1,v2,Q,B,F:Array[1..Maxn] of Longint;
Free :Array[1..Maxn] of Boolean;
Procedure OpenFile;
Begin
Assign(fi,finp); Reset(fi);
Assign(fo,fout); Rewrite(fo);
End;
Procedure CloseFile;
Begin
Close(fi); Close(fo);
End;
Procedure Push(v:Longint; Var Next:pt);
Var p:pt;
Begin
New(p);
p^.Next:=Next;
p^.v:=v;
Next:=p;
End;
Procedure Readinp;
Var u,v:Longint;
Begin
Readln(fi,n,k);
If n=1 Then
Begin
For k:=1 to k do
Begin
Read(fi,u,v);
If v=0 Then WRiteln(fo,1)
else Writeln(fo,0);
End;
CloseFile;
Halt;
End;
For n:=1 to n do List[n]:=Nil;
For n:=2 to n do
Begin
Readln(fi,u,v);
Push(u,List[v]);
Push(v,List[u]);
End;
End;
Procedure Dfs(i,x:Longint);
Var p:Pt;
v:Longint;
Begin
If Low < x Then
Begin
Low:=x; S:=i;
End;
Free[i]:=False;
p:=List[i];
While p<> Nil do
Begin
v:=p^.v;
If Free[v] then
Begin
Tr[v]:=i;
Dfs(v,x+1);
End;
p:=p^.Next;
End;
End;
Procedure Prepare;
Var i,x:Longint;
Begin
Fillchar(Free,sizeof(Free),True);
Dfs(1,0);
Low:=0; T:=S;
Fillchar(Free,sizeof(Free),True);
Fillchar(Tr,sizeof(Tr),0);
DFS(T,0);
i:=S; x:=1; C[S]:=1; B[1]:=S;
While True do
Begin
i:=Tr[i];
Inc(x); C[i]:=x; B[x]:=i;
If i = T Then Break;
End;
End;
Procedure Solve;
Var i,x,dau,cuoi,w,v:Longint;
p:pt;
Begin
Inc(Low);
For i:=1 to Low do
Begin
x:=b[i];
dau:=0; cuoi:=1; Q[1]:=x;
While dau <> cuoi do
Begin
Inc(dau); w:=Q[dau];
p:=List[w];
While p<> Nil do
Begin
v:=p^.v;
If (C[v]=0) Then
if (v1[v]=0) Then
Begin
v1[v]:=x;
v2[v]:=v2[w]+1;
Inc(cuoi); Q[cuoi]:=v;
End;
p:=p^.Next;
End;
End;
End;
End;
Function Found(k,u,l:Longint):Longint;
Var dau,cuoi,v,x:Longint;
p:Pt;
Begin
dau:=0; cuoi:=1;
F[u]:=0; Q[1]:=u;
Tr[u]:=k;
While dau<> cuoi do
Begin
Inc(dau); x:=Q[dau];
p:=List[x];
While p<> Nil do
Begin
v:=p^.v;
If Tr[v] <> k Then
Begin
F[v]:=F[x]+1;
Tr[v]:=k;
Inc(cuoi); Q[cuoi]:=v;
If F[v]=l Then Exit(v);
End;
p:=p^.Next;
End;
End;
Exit(0);
End;
Procedure Answer;
Var u,v,x,Ans:Longint;
Begin
Fillchar(tr,sizeof(Tr),0);
For k:=1 to k do
Begin
Readln(fi,u,v);
If v >= Low Then
Begin
Writeln(fo,0);
Continue;
End;
If C[u] <> 0 Then
Begin
If v + C[u] <= Low Then
Begin
v:=v+ C[u];
Writeln(fo,B[v]);
Continue;
End;
If v<C[u] Then
Begin
v:=C[u]-v;
Writeln(fo,B[v]);
COntinue;
End;
Writeln(fo,0);
Continue;
End;
If v2[u]=v Then
Begin
Writeln(fo,v1[u]);
Continue;
End;
If V2[u] < v Then
Begin
x:=C[v1[u]];
If x > v - V2[u] Then
Begin
x:=x-(v - v2[u]);
Writeln(fo,B[x]);
Continue;
End;
If x + (v- v2[u]) <= Low Then
Begin
x:=x+(v-v2[u]);
Writeln(fo,B[x]);
Continue;
End;
Writeln(fo,0);
Continue;
End;
x:=Found(-k,u,v);
Writeln(fo,x);
End;
End;
Function Dist(u,l:Longint):Longint;
Var dau,cuoi,v,x:Longint;
p:Pt;
Begin
dau:=0; cuoi:=1;
F[u]:=0; Q[1]:=u;
Tr[u]:=k;
While dau<> cuoi do
Begin
Inc(dau); x:=Q[dau];
p:=List[x];
While p<> Nil do
Begin
v:=p^.v;
If Tr[v] <> k Then
Begin
F[v]:=F[x]+1;
Tr[v]:=k;
Inc(cuoi); Q[cuoi]:=v;
If v=l Then Exit(F[v]);
End;
p:=p^.Next;
End;
End;
Exit(0);
End;
Procedure Test;
Var u,v,l,x:Integer;
Begin
Assign(fi,finp); Reset(fi);
Assign(fo,fout); Reset(fo);
Readln(fi,n,k);
For n:=2 to n do Readln(fi,u,v);
For k:=1 to k do
Begin
Readln(fi,u,l);
Readln(fo,v);
If v=0 Then
Begin
x:=Found(-k,u,l);
If x<>0 Then
Begin
Writeln('sai');
Exit;
End;
COntinue;
End;
x:=Dist(u,v);
Writeln(x,' ',l);
If x<>l Then
begin
Writeln('Sai');
Exit;
End;
End;
End;
Begin
// Clrscr;
Openfile;
Readinp;
Prepare;
Solve;
Answer;
CloseFile;
// Test;
End.