Bài 1 - CONNECT
Mã:
Program CONNECT;
Type ds=Record v:String;t:Longint End;
Const MaxN=1000;
Var a:array[1..MaxN] of ds;
    n:Longint;
    MaxL:Byte;
Procedure Input;
Var f:Text;
    i:Longint;
Begin
  Assign(f,'CONNECT.INP');
  Reset(f);
  Readln(f,n);
  For i:=1 to n do Readln(f,a[i].v);
  Close(f);
End;

Function ToNum(s:String):Longint;
Var n,ncode:Longint;
Begin
  Val(s,n,ncode);
  ToNum:=n;
End;

Procedure InitArr;
Var i,j:Longint;
Begin
  MaxL:=0;
  For i:=1 to n do
    Begin
      While Pos(' ',a[i].v)<>0 do Delete(a[i].v,Pos(' ',a[i].v),1);
      If MaxL<Length(a[i].v) then MaxL:=Length(a[i].v);
      a[i].t:=ToNum(a[i].v);
    End;
  For i:=1 to n do
    For j:=Length(a[i].v)+1 to MaxL do a[i].t:=a[i].t*10+9;
End;

Procedure Swap(Var a,b:ds);
Var t:ds;
Begin
  t:=a;
  a:=b;
  b:=t;
End;

Procedure Sort;
Var i,j:Longint;
Begin
  For i:=1 to n-1 do
    For j:=i+1 to n do
      If a[i].t<a[j].t then swap(a[i],a[j]);
  For i:=1 to n do
    For j:=1 to n-1 do
      If (a[j].t=a[j+1].t) and (Length(a[j].v)<Length(a[j+1].v)) then swap(a[j],a[j+1]);
End;

Procedure Output;
Var f:Text;
    i:Longint;
    s:String;
Begin
  Assign(f,'CONNECT.OUT');
  Rewrite(f);
  For i:=1 to n do
    Write(f,a[i].v);
  Close(f);
End;
BEGIN
  Input;
  InitArr;
  Sort;
  Output;
END.
Bài 2 - TOUR
Mã:
Program TOUR;
Const MaxN=1000;
      MaxK=10;
Var a:array[1..MaxN,1..MaxN] of Boolean;
    d:array[1..MaxK+2] of Integer;
    Queue:array[1..MaxN*MaxN] of Integer;
    n,First,Last:Integer;
    m,t:Longint;
    j,k:Byte;
Procedure Input;
Var f:Text;
    i:Longint;
    u,v:Integer;
    j:Byte;
Begin
  Assign(f,'TOUR.INP');
  Reset(f);
  Readln(f,n,k,m);
  FillChar(a,sizeof(a),False);
  For j:=1 to k do
    Read(f,d[j]);
  Readln(f,d[k+1]);
  d[k+2]:=d[1];
  For i:=1 to m do
    Begin
      Readln(f,u,v);
      a[u,v]:=True;
      a[v,u]:=True;
    End;
  Close(f);
End;
Procedure InitQueue;
Begin
  First:=0;
  Last:=0;
End;
Procedure Push(v:Integer);
Begin
  Inc(Last);
  Queue[Last]:=v;
End;
Function Pop:Integer;
Begin
  If First<Last then
    Begin
      Inc(First);
      Pop:=Queue[First];
    End;
End;
Function EmptyQueue:Boolean;
Begin
  EmptyQueue:=(First=Last);
End;
Function BFS(u,v:Integer):Longint;
Var i,j:Integer;
    h:array[1..MaxN*MaxN] of Longint;
Begin
  InitQueue;
  Push(u);
  h[Last]:=0;
  While not(EmptyQueue) do
    Begin
      i:=Pop;
      For j:=1 to n do
        If a[i,j] then
          Begin
            Push(j);
            h[Last]:=h[First]+1;
            If j=v then
              Begin
                BFS:=h[Last];
                Exit;
              End;
          End;
    End;
End;
Procedure Output;
Var f:Text;
Begin
  Assign(f,'TOUR.OUT');
  Rewrite(f);
  Write(f,t);
  Close(f);
End;
BEGIN
  Input;
  t:=0;
  For j:=1 to k+1 do
    t:=t+BFS(d[j],d[j+1]);
  Output;
END.
Bài 3 - ROBOT
Mã:
Program ROBOT;
Const MaxN=50;
Var a:array[1..MaxN,1..MaxN] of 0..1;
    f:array[1..MaxN,1..MaxN] of String;
    n:Byte;
Procedure Input;
Var fi:Text;
    i,j:Byte;
Begin
  Assign(fi,'ROBOT.INP');
  Reset(fi);
  Readln(fi,n);
  For i:=1 to N do
    Begin
      For j:=1 to N do Read(fi,a[i,j]);
      Readln(fi);
    End;
  Close(fi);
End;

Function Compare(s1,s2:String):Byte;
Var i:Byte;
Begin
  Compare:=1;
  For i:=1 to Length(s1) do
    If s1[i]<>s2[i] then
      Begin
        If s1[i]='0' then
          Compare:=1
        else
          Compare:=2;
        Break;
      End;
End;

Function ToStr(i:Byte):String;
Var s:String;
Begin
  Str(i,s);
  ToStr:=s;
End;

Procedure Optimize;
Var i,j:Byte;
Begin
  f[1,1]:=ToStr(a[1,1]);
  For i:=2 to n do f[i,1]:=f[i-1,1]+ToStr(a[i,1]);
  For j:=2 to n do f[1,j]:=f[1,j-1]+ToStr(a[1,j]);
  For i:=2 to n do
    For j:=2 to n do
      Case Compare(f[i-1,j],f[i,j-1]) of
        1:f[i,j]:=f[i-1,j]+ToStr(a[i,j]);
        2:f[i,j]:=f[i,j-1]+ToStr(a[i,j]);
      End;
End;

Procedure Output;
Var fi:Text;
Begin
  Assign(fi,'ROBOT.OUT');
  Rewrite(fi);
  Writeln(fi,f[n,n]);
  Close(fi);
End;

BEGIN
  Input;
  Optimize;
  Output;
END.