program p2; var r,f:text; temp:char; A:array[1..10] of array[1..29] of char; B:array[1..29] of char; i,j,t,q,q1,q2:integer; notsort:Boolean; begin assign(r,'c:\test.txt'); reset(r); assign(f,'c:\out.txt'); rewrite(f); for i:=1 to 10 do begin for j:=1 to 29 do read(r,A[i,j]); readln(r); end; notsort:=true; while notsort do begin notsort:=false; for i:=2 to 10 do begin q:=i-1; q1:=((ord(A[i,22])-48)*1000)+((ord(A[i,23])-48)*100)+((ord(A[i,24])-48)*10)+(ord(A[i,25])-48); q2:=((ord(A[q,22])-48)*1000)+((ord(A[q,23])-48)*100)+((ord(A[q,24])-48)*10)+(ord(A[q,25])-48); if q1 > q2 then begin notsort:=true; for t:=1 to 29 do begin temp:=A[i,t]; A[i,t]:=A[i-1,t]; A[i-1,t]:=temp; end; WriteLn(''); end; end; end; t:=0; for i:=1 to 10 do begin if A[i,27]='g' then begin if A[i,29]='m' then begin if t < 3 then begin for j:=1 to 29 do write(f,A[i,j]); writeln(f); t:=t+1; end; end; end; end; close(r); close(f) end.