Const size = 1000; fname = 'input.txt'; oname = 'output.txt'; type Queue = record AR:Array [0..size] of Word; head,tail:byte; end; var Alls : array [0..10] of Queue; {----------------------} Procedure Add(var Qu:Queue;num:word); begin if (Qu.tail<=size) then begin Qu.AR[Qu.tail]:=num; inc(Qu.tail); end; end; {----------------------} Function Get(var Qu:Queue;var OUT:word):boolean; begin if (Qu.head<>Qu.tail) then begin OUT:=Qu.AR[Qu.head]; Get:=true; inc(Qu.head); if (Qu.head=qu.tail) then begin qu.head:=0; qu.tail:=0; end; end else Get:=false; end; {----------------------} Function GetNum(num:word;pos:byte):byte; var i:byte; begin for i := 1 to pos do num:=num div 10; GetNum:=num mod 10; end; {----------------------} Procedure GetData; var F:text; cl:word; begin Assign(F,fname); Reset(F); while not eof(F) do begin Read(F,cl); Add(Alls[10],cl); end; Close(F); end; {----------------------} Procedure OutData; var F:text; cl:word; begin Assign(F,oname); ReWrite(F); while Get(Alls[10],cl) do WriteLn(F,cl); Close(F); end; {----------------------} var Razm : byte; i,j : word; vl : word; begin GetData; razm:=0; for i := Alls[10].head to Alls[10].tail do begin if (GetNum(Alls[10].AR[i],razm+1)<>0) then Inc(Razm); end; for i := 0 to razm do begin while Get(alls[10],vl) do Add(Alls[GetNum(vl,i)],vl); for j:=0 to 9 do begin While Get(Alls[j],vl) do Add(Alls[10],vl); end; end; OutData; end.