Code:

Cho 2 số a,b . Tìm số c là con của 2 số a,b sao cho số c là lớn nhất có thể .
 Đk : 1<=a,b<=100¬100

 Dữ liệu vào : - Dòng 1 : Ghi số a.
              - Dòng 2 : Ghi số b.
 
 Dữ liệu ra : - Dòng 1 : Ghi độ dài xâu c .
              - Dòng 2 : Ghi ra xâu c.


_______________________________
Chương trình :
-----------------------------

Code:


Program Bai1;
 Const fi='bai.inp';
      fo='bai.out';
 Var max1,n,m:Integer;
 l:array[0..100,0..100] Of Integer;
    c,a,b:String;
    f,g:text;
Procedure doctep;
 Begin
  Assign(f,fi);
  Reset(f);
  Readln(f,a);
  Readln(f,b);
 End;
Procedure khoitao;
 Var i,j:Integer;
  Begin
  Max1:=0;
  Assign(g,fo);
  Rewrite(g);
  Fillchar(l,sizeof(l),0);
  End;
Function max(x,y:Integer):Integer;
 Begin
  If x > y then max:=x Else max:=y;
 End;
Procedure tinh;
 Var i,j:Integer;
 Begin
  For i:=length(a) downto 1 do
  For j:=length(b) downto 1 do
    Begin
    If a[i]=b[j] then
      l[i,j]:=1+l[i+1,j+1]
    Else
      l[i,j]:=max(l[i+1,j],l[i,j+1]);
    End;
 End;
Procedure tinh1;
 Begin

 End;
Procedure truy;
 VAr ch:char;ii,jj,k,i,j:Integer;
Begin
 c:='';
 max1:=0;
 For ch := '9' downto '1' do
  Begin
  i:=pos(ch,a); j:=pos(ch,b);
    IF l [i,j] > max1 then
    Begin
      max1:=l[i,j];
      c:=ch;
    End;
  End;
 i:=pos(c,a)+1;
 j:=pos(c,b)+1;
  For k:=max1-1 downto 1 do
  Begin
  For ch:='9' downto '0' do
    Begin
    ii:=i;jj:=j;
      While (ii <=length(a)) and ( a[ii] <> ch) do inc(ii);
      While (jj <=length(b)) and ( b[jj] <> ch ) do inc(jj);
    IF l[ii,jj]=k then
      Begin
      c:=c+ch;
      i:=ii+1;
      j:=jj+1;
      Break;
      End;
End;
End;
End;
Procedure xuat;
 VAr i,j:Integer;
  Begin
  For i:=1 to length(a) do
  Begin
    fOr j:=1 to length(b) do
    Write(l[i,j]:3);
    Writeln;
  End;
    Writeln(g,length(c):3);
  For i:=1 to length(c) do
    Writeln(g,c[i]:3);
  Close(g);
  End;
Begin
doctep;
khoitao;
tinh;
truy;
xuat;
End.


Đường đi mê cung

Code:

sd
PRogram Bai1;
 Const fi='bai.inp';
      fo='bai.out';
      vx:array[1..4] OF Integer=(1,-1,0,0);
      Vy:array[1..4] Of Integer=(0,0,-1,1);
 Var c,d,i,j,n,m:Integer;ktra1:boolean;
    b,a:array[1..100,1..100] Of char;
    chon:array[1..100] Of boolean;
    t,ty,kx,ky:Array[1..100] OF Integer;
    f,g:text;
Procedure doctep;
 Begin
 Assign(f,fi);
 Reset(f);
 Readln(f,n,m);
 Fillchar(chon,sizeof(chon),false);
 For i:=1 to n do
  BEgin
  For j:=1 to m do
    Read(f,a[i,j]);
    Readln(f);
  end;
 CLose(f);c:=0;d:=1;
 End;
Procedure them(x,y:Integer);
 Begin
  inc(c);
  kx[c]:=x;
  ky[c]:=y;
 End;
Procedure rut(VAr x,y:Integer);
 Begin
  x:=kx[d];
  y:=ky[d];
  inc(d);
 End;
Function ktra(a,b:Integer):Boolean;
 Begin
  If (a <=n) and ( 1<=a) and ( 1<=b) and (b<=m) then ktra:=true
  Else ktra:=false;
 End;
Procedure try(x,y:Integer);
 Var xo,yo,i:Integer;
 Begin
  them(x,y);t[1]:=0;
  a[x,y]:='x';
  While c >= d do
  begin
    rut(x,y);
  For i:=1 to 4 do
  begin
  xo:=x+vx[i];
  yo:=y+vy[i];
    If (a[xo,yo] <> 'x') and (ktra(xo,yo))  then
    Begin
    them(xo,yo);
      a[xo,yo]:='x';
      If (1=xo) or (xo=n) or (1=yo) or (yo=m) then  Begin ktra1:=true; t[c]:=d-1;
      Exit; End
      Else
      t[c]:=d-1;
      End;
 End;
End;
End;
Procedure truy;
 Var i,j:Integer;
  Begin
  If ktra1=false then Writeln(g,'No')
  Else
  Begin
  Writeln(g,'Yes');
  i:=c;
  While i <>0 do
    Begin
    chon[i]:=true;
    i:=t[i];
    End;
    For i:=1 to c do
    If chon[i] then WRiteln(g,kx[i]:3,ky[i]:3);
    End;
  Close(g);


  End;
Begin
doctep;
Assign(g,fo);
Rewrite(g);
b:=a;
Assign(g,fo);
Rewrite(G);
For i:=1 to n do
 For j:=1 to m do
  If a[i,j]='e' then
  try(i,j);
 truy;

 end.