I use Dijkstra to find the minimum number of changes, but get WA...
Can anyone help me pls? Here's  the code:


var a:array[0..1000,0..1000] of integer;
    route:array[1..2,1..1000] of integer;
    d,t,v,sol:array[0..1000] of integer;
    n,i,j,k,l,p,m,rr,r1,r2:integer;
    b:boolean;
procedure drum(k:integer); {Builds the solution}
begin
  if k<>0 then begin
     l:=l+1; sol[l]:=k;
     drum(t[k]);
     end;
end;
begin
  assign(input,'input.txt');
  reset(input);
  readln(n);
  for i:=1 to n do readln(route[1,i],route[2,i]);
  readln(rr,r1,r2);
  for i:=0 to n do
      for j:=0 to n do begin
          a[i,j]:=maxint div 2;
          if i=j then a[i,j]:=0;
          end;
  {Building the adjacencey matrix}
  for i:=1 to n do  begin
      if (r1=route[1,i]) or (r2=route[1,i]) then a[0,i]:=1;
      for j:=1 to n do
          if i<>j then
             if (route[1,i]=route[1,j]) or
             (route[2,i]=route[1,j]) then a[i,j]:=1;
      end;
  fillchar(v,sizeof(v),0);
  fillchar(t,sizeof(t),0);
  for i:=0 to n do begin
      d[i]:=a[0,i];
      if d[i]<maxint div 2 then t[i]:=0;
      end;
  v[0]:=1;
  {Dijkstra algorithm}
  for i:=1 to n do begin
      m:=maxint div 2;
      for j:=1 to n do
          if (v[j]=0) and (d[j]<m) then begin
             p:=j; m:=d[j];
             end;
      v[p]:=1;
      for j:=1 to n do
          if d[j]>d[p]+a[p,j] then begin
             d[j]:=d[p]+a[p,j]; t[j]:=p;
             end;
      end;
  b:=false;
  m:=maxint div 2;
  {Find best solution}
  for i:=1 to n do
      if (d[i]<m) and ((route[1,i]=rr) or (route[2,i]=rr)) then begin
         m:=d[i]; p:=i; b:=true;
         end;
  if b then begin
  l:=0;
  drum(p);
  writeln(l);
  for i:=l downto 1 do writeln(sol[i]);
  end
  else writeln('IMPOSSIBLE');
end.