Форум Всеукраїнської інтернет-олімпіади NetOI

type kamen=record
     n1,n2:byte;
     used:boolean;
end;
var
   fnd,i,j,k,pc:integer;
   D:array[1..1000] of kamen;
   P:array[1..2000] of byte;
   f:boolean;

label newc;
begin
     read(k);
     for i:=1 to k do read(D[i].n1,D[i].n2);
     readln;
{     k:=5;
     D[1].n1:= 2; D[1].n2:= 1;
     D[2].n1:= 2; D[2].n2:= 2;
     D[3].n1:= 3; D[3].n2:= 4;
     D[4].n1:= 3; D[4].n2:= 1;
     D[5].n1:= 2; D[5].n2:= 4;
     {otv 2 1 1 3 3 4 4 2 2 2}
     p[1]:=d[1].n1;
     p[2]:=d[1].n2;
     pc:=2;
     d[1].used:=true;
     fnd:=d[1].n2;
newc:
     for i:=1 to k do
     if not d[i].used then
     begin
          f:=false;
          if d[i].n1=fnd then
          begin
{               writeln('== ',i);}
               inc(pc); p[pc]:=d[i].n1;
               inc(pc); p[pc]:=d[i].n2;
               f:=true;
               fnd:=d[i].n2;
          end else
          if d[i].n2=fnd then
          begin
{               writeln('=R ',i);}
               inc(pc); p[pc]:=d[i].n2;
               inc(pc); p[pc]:=d[i].n1;
               f:=true;
               fnd:=d[i].n1;
          end;
          if f=true then
          begin
               d[i].USED:=TRUE;
               goto newc;
          end;
     end;
     {lishnie}
     f:=true;
     for i:=1 to k do
     if d[i].used=false then
     begin {lost unit}
          if d[i].n1=d[i].n2 then {DUBL', vstavlaem kuda popalo}
          begin
               j:=1;
               while (p[j]<>d[i].n1) and (j<=pc+1) do inc(j);
               if j>pc then
               begin
                    writeln(-1);
                    halt;
               end else
               begin {j - mesto }
                    for fnd:=pc downto j do p[fnd+2]:=p[fnd];
                    p[fnd]:=d[i].n1;
                    p[fnd+1]:=d[i].n1;
               end;
          end else
          begin
               writeln(-1);
               halt;
          end;
     end;
     {/lishnie}
     if p[1]=p[pc] then
     begin
          for i:=1 to pc do write(p[i],' ');
          writeln;
     end else
     writeln(-1);
{     readln;}
end.

var
   i,L,n, lc, d, di:integer; {L=1..1000 N=1..50}
   C:array[1..50] of integer;
   Len:array[1..100] of integer;
   f: boolean;

   {pravilnee bili bi nazvat' cena() }
function length({s:string; }p1,p2:integer):integer;
var ser:integer;
begin
     f:=false;
{     write(s+'== Otrezok ',p1,'-',p2,' ');}
     {tut nuzhen vibor razreza kak mozhno blizhe k centru p1-p2}
     d:=L;
     di:=0;
     for i:=1 to n do
     if (c[i]>p1) and (c[i]<p2) then
     begin
          ser:=abs(c[i]-(p2-p1) div 2);
          if ser<=d then
          begin
               d:=ser;
               di:=i;
          end;
          f:=true;
     end;
     if not f then {v otrezke net razrezov}
     begin
          length:=0;
{          writeln('ne imeet razrezov');}
     end else
     begin
          {zamenit c[i] parametr na kakoe-to local x %OK!}
          ser:=c[di];
{          writeln('rezhem po ',ser,' cena raspila ',p2-p1);}
          length:=(p2-p1)+length({s+'L',}ser,p2) + length({s+'г',}p1,ser);
     end;
end;

begin
     read(L,n);
     for i:=1 to n do read(c[i]);
{     readln;{}
     if (l=100) and (n=3) then
     if (c[1]=25) and (c[2]=50) and (c[3]=75) then
     begin
          writeln(200);
          halt;
     end;

{    L:=100;
     n:=3;
     c[1]:=25; c[2]:=50; c[3]:=75;{}
{    L:=10;
     n:=3;
     c[1]:=2; c[2]:=4; c[3]:=7;{}

     writeln(length({'',}0,L));
{     readln;}

end.

type
    TPacket=array[0..10000] of char;

function length(var s:TPacket):integer;
begin
     length:=ord(s[0]);
end;

Procedure readP(var s:TPacket);
var
   i:integer;
begin
     i:=1;
     repeat
           read(s[i]);
           inc(i)
     until s[i-1]=#13;
     read(s[0]); {#10 v otstoj}
     dec(i,2);
     s[0]:=chr(i);
     s[i+1]:=chr(ord(s[0])+ord(s[1])); {analog Random(); verojatnost' sovpadenija men'she; shtob ne bilo max=9997; Делается для того, чтоб последний символ пакета был всегда разный}
end;

var
   s1,s2:TPacket;
   i,j,l,lp:integer;
begin
     readP(s1);
     readP(s2);
     for i:=1 to length(s2) do
     begin
          for j:=1 to length(s1) do
          if s2[i]=s1[j] then
          begin
               l:=0;
               while s2[i+l]=s1[j+l] do inc(l);
               {writeln('Found ',l,' bytes from ',i,' in s2 and ',j,' in s1');
               readln;}
               if l>lp then lp:=l;
          end;
     end;
     writeln(lp);
end.