9-25 Exam The third problem report (or write a pointer translation god horse is floating clouds feel long time not to speak even words will not say 233333333QVO)

typeLink=^pnode; Pnode=RecordW:longint;        Next:link; End; varA,root:Array[0..1122] ofLongint; G:Array[0..1100,0..1100] ofLongint; Hash:Array[0..1122] ofBoolean; List:Array[0..1122] oflink;        N,min:longint; procedureInit; beginassign (input,'badnews.in'); Assign (output,'Badnew.out');                Reset (input);        Rewrite (output); End; procedureterminate; beginclose (input);                Close (output);        Halt End; procedureqsort (S,t:longint); varI,j,x,m:longint; beginm:= (s+t) >>1; X:=A[m]; A[M]:=A[s]; A[s]:=x; I:=s; J:=T; Repeat                         while(I&LT;J) and(X>a[j]) DoDec (j); ifI<j Then beginA[I]:=A[J]; Inc (I);End;  while(I&LT;J) and(X<a[i]) DoInc (I); ifI<j Then beginA[j]:=a[i]; Dec (j);End; untilI=J; A[i]:=x;                Inc (I);                Dec (j); ifI<t Thenqsort (i,t); ifS<j Thenqsort (S,J); End; functionDFS (i:longint): Longint; varJ,tot:longint;                P,q:link;        Pd:boolean; beginPD:=true; P:=Nil;  forj:=1  tog[i][0] Do                begin                        if  notHASH[G[I][J]] Then                        beginPD:=false; HASH[G[I][J]]:=true;                                New (q); Q^.W:=dfs (G[i][j]) +1; Q^.next:=p; P:=Q; End; End; ifPd ThenExit1); Tot:=0;  whileP<>Nil  Do                beginInc (TOT); A[tot]:=P^.W; P:=P^.next; End; Qsort (1, tot);  forj:=2  toTot DoInc (a[j],j-1); DFS:=0;  forj:=1  toTot Do ifA[j]>dfs Thendfs:=A[j]; End; proceduremain; varI,x,min:longint; beginFillchar (list,sizeof (list),0);                READLN (n);  fori:=2  toN Do                beginreadln (x); Inc (G[i][0]); g[i][g[i][0]]:=x; Inc (G[x][0]); g[x][g[x][0]]:=i; End;  fori:=1  toN Do                beginFillchar (hash,sizeof (hash),0); Hash[i]:=true; Root[i]:=DFS (i); End; Min:=10000;  fori:=1  toN Do                begin                        ifRoot[i]<min Thenmin:=Root[i]; End;                Writeln (min); a[0]:=0;  fori:=1  toN Do                begin                        ifRoot[i]=min Then                        beginInc (A[0]); a[a[0]]:=i; End; End;  fori:=1  toa[0]-1  DoWrite (A[i],' '); Writeln (a[a[0]]); End; beginInit;                Main        Terminate End.

Like on the collection, Vic private qq:1064864324, add me to discuss issues together, and progress

9-25 Exam The third problem report (or write a pointer translation god horse is floating clouds feel long time not to speak even words will not say 233333333QVO)