Тексти програм учасників, які отримали максимальні бали.

Задача 1.

Учасники, які набрали максимум балів 515, 568, 813, 953, 962

u515t1z1.cpp
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
#include"fstream.h"
#include"math.h"

long n,m,c;
long a[4650];

void z()
{
        long k=44721;
        int l=0;
        for(long i=3;i<=k;i+=2)
        {
                int fl=0;
                for(long q=3;q<=sqrt(i);q+=2)
                        if((i%q)==0) {fl=1;break;}
                if(fl==0) {a[l]=i;l+=1;}
        }
}

void main()
{
        z();
        a[4647]=50000;
        ifstream f("nice.dat");
        ofstream o("nice.sol");
        f>>m>>n;
        if(m<3) m=3;
        c=m-2;
        if(n>1999999999) n=1999999999;
        while(c<=n)
        {
                if(c==1997999977)
                        c+=1;
                c+=2;
                long d=c;
                long p=1;
                while(d>0)
                {
                        if((d%2)==0) c+=p;
                        d/=10;
                        p*=10;
                }
                if(c<=n)
                {
                        int j=0;
                        int h=0;
                        while(a[h]<=sqrt(c)){if((c%a[h])==0){j=1;break;}h+=1;}
                        if(j==0) o<<c<<endl;
                }
        }
}
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
u568t1z1.pas
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
{$A+,B-,D-,E+,F-,G-,I+,L-,N-,O-,P-,Q-,R-,S-,T-,V+,X+}
{$M 16384,0,655360}
Const
Pr:Array[1..4791] Of Longint=
(3,5,...{тут записано всі прості числа із вказаного діапазону}...,46327,46337);
Per:Array[0..9,1..10] Of Longint=
((0,0,0,0,0,0,0,0,0,0),
(1000000000,100000000,10000000,1000000,100000,10000,1000,100,10,1),
(0,200000000,20000000,2000000,200000,20000,2000,200,20,2),
(0,300000000,30000000,3000000,300000,30000,3000,300,30,3),
(0,400000000,40000000,4000000,400000,40000,4000,400,40,4),
(0,500000000,50000000,5000000,500000,50000,5000,500,50,5),
(0,600000000,60000000,6000000,600000,60000,6000,600,60,6),
(0,700000000,70000000,7000000,700000,70000,7000,700,70,7),
(0,800000000,80000000,8000000,800000,80000,8000,800,80,8),
(0,900000000,90000000,9000000,900000,90000,9000,900,90,9));
Var Z:Array[0..10] Of Integer;
    I,J,K,M,N,L,Sum,T,Ch,Last,Nom,Kil,C:Longint;
    Fi,Fo:Text;
    S,S1:String;
    Kvadr:Array[1..5000] Of Longint;
Function Perev:Longint;
Var T:Longint;
Begin
Sum:=0;
For I:=1 To 10 Do
  Sum:=Sum+Per[Z[I],I];
Perev:=Sum;
End;

Function Check:Boolean;
Var J:Longint;
Begin
Ch:=Perev;
Check:=True;
J:=1;
While Kvadr[J]<=Ch Do
 Begin
  If Ch Mod Pr[J] = 0 Then
   Begin
    Check:=False;
    Break;
   End;
 Inc(J);
 End;
End;

Begin
For I:=1 To 4791 Do Kvadr[I]:=Sqr(Pr[I]);
Assign(Fi,'Nice.dat'); Reset(Fi);
Assign(Fo,'Nice.Sol'); Rewrite(Fo);
Readln(Fi,M,N);
If M>N Then Begin Close(Fi); CLose(Fo); Halt; End; If M=1 Then M:=3;
   IF M>1999999973 Then Halt;
   If N>1999999973 Then N:=1999999973;
   Str(M,S); Str(N,S1); Kil:=10-Length(S1);
   For I:=10-Length(S)+1 To 10 Do Begin Inc(K); Z[I]:=Byte(S[K])-48; End;
   For I:=10-Length(S)+1 To 10 Do
    If Z[I] Mod 2=0 Then
     Begin
      Inc(Z[I]);
      For J:=I+1 To 10 Do Z[J]:=1;
      Break;
     End;
   Ch:=Perev;
While Ch<N Do
    Begin
     If (Check) And (Ch<N) Then
       Begin
          For I:=1 to 10 Do If Z[I]<>0 Then Write(Fo,Z[I]);
        Writeln(Fo);

       End;
       Inc(Z[10],2);
      While Z[I]=11 Do
       Begin
        If Z[I-1]=0 Then Z[I-1]:=1 Else
                         Inc(Z[I-1],2);
        Z[I]:=1;
        Dec(I);
       End;
     End;
Close(Fi);
Close(Fo);
End.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
u813t1z1.pas
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
{$R-,S-,Q-}
VAR m,n:longint;
FUNCTION Check(v:longint):boolean;
  begin
    Check:=false;
    while v<>0 do
     begin
       if (v mod 10) mod 2 = 0 then begin check:=true;break;end;
       v:=v div 10;
     end;
  end;

PROCEDURE Count;
var i,j,k:longint;
    f:boolean;
  begin
    k:=0;
    assign(output,'nice.sol');
    rewrite(output);
    for i:=m to n do
     begin
       if check(i) then continue;
       f:=true;
       for j:=2 to trunc(sqrt(i)) do
        if i mod j = 0 then begin f:=false;break;end;
       if f then begin writeln(i);inc(k);end;
     end;
    close(output);
  end;
PROCEDURE ReadDat;
var f:text;
    t:longint;
  begin
    assign(f,'nice.dat');
    reset(f);
    readln(f,m,n);
    if m>n then
     begin
       t:=m;
       m:=n;
       n:=t;
     end;
    close(f);
  end;
BEGIN
ReadDat;
Count;
END.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
u953t1z1.pas
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
const p:array [1..4792] of longint=
(2,3,...{тут записано всі прості числа із вказаного діапазону}...,46327,46337);

var fi,fo:text;
    n,m,j,t:longint;
    i:integer;
    s:string;

procedure inch(k:longint);
var t:integer;
begin
   t:=n div k mod 10;
   if t=0 then inc(n,k) else if t=9 then begin n:=n-8*k; inch(k*10) end else inc(n,2*k);
end;

begin
 Assign (fi,'nice.dat'); Reset (fi);
 Assign (fo,'nice.sol'); Rewrite (fo);
  Readln (fi,n,m);
   str(n,s);
   for i:=1 to length(s) do if byte(s[i])mod 2=0 then begin s[i]:=chr(byte(s[i])+1); break end;
   for j:=i+1 to length(s) do s[j]:='1';
   val(s,n,i);
   if i=0 then
   while n<=m do begin
    j:=1;  t:=trunc(sqrt(n));
    while p[j]<=t do if n mod p[j]=0 then break else inc(j);
    if p[j]>t then writeln (fo,n);
    inch(1);
   end;

 Close(fi); Close(fo);
end.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
u962t1z1.pas
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
const C1:array[1..4647] of longint=
(3,5,...{тут записано всі прості числа із вказаного діапазону}...,44701,44711);
C2:array [1..4647] of longint =
(9,25,...{тут записано квадрати всіх простих чисел із попереднього масиву}...,1998179401,1999073521);

Var fi,fo:text;
    M,N,i,i1:longint;
    A,B,Start,Start0:array[1..10] of longint;
    Chuslo:array[1..10] of longint;
    l1,l2:longint;
    Finish:longint;

Procedure Check;
Var j,P,t,k:longint;
    r:real;
begin
if (i=10) and (Chuslo[i]>2) then begin close(fo);halt;end;
t:=1;
P:=0;

for j:=1 to i do begin
P:=P+Chuslo[j]*t;
if j<>i then t:=t*10;

                 end;
if P>Finish then begin close(fo);halt;end;

j:=1;
while C2[j]<=P do begin
if P mod C1[j]=0 then exit;
inc(j);
              end;
writeln(fo,P);

end;

procedure Find(nom:longint);
Var j:longint;

begin
if nom=0 then begin check;exit;end;

j:=Start[nom];

while j<=9 do begin
Chuslo[nom]:=j;Find(nom-1);inc(j,2);
                        end;
Start[nom]:=1;

end;

begin
assign(fi,'nice.dat');reset(fi);
assign(fo,'nice.sol');rewrite(fo);
readln(fi,M,N);
close(fi);

while M<>0 do begin
inc(l1);A[l1]:=M mod 10;M:=M div 10;
              end;

                  Finish:=N;

while N<>0 do begin
inc(l2);N:=N div 10;
              end;

for i:=l1 downto 1 do
if A[i] mod 2=0 then begin inc(A[i]);
for i1:=i-1 downto 1 do A[i1]:=1;
break;
                     end;

for i:=1 to 10 do Start0[i]:=1;

Start:=A; i:=l1; Find(l1);
Start:=Start0;  for i:=l1+1 to l2 do Find(i);

end.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 

Задача 2.

Учасники, які набрали максимум балів 142, 372, 962

u142t1z2.pas
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
var
   vhid       : array[1..4,1..2] of real;
   fi,fo      : text;
   i          : integer;
   kor_o      : array[1..3,1..2] of real;
   kor_a      : array[1..3,1..2] of real;
   kor_c      : array[1..3,1..2] of real;
   Flag_P     : Boolean;
procedure T_O(x1_1,y1_1,x1_2,y1_2,x1_3,y1_3:real; var a,b :real);
var k1,k2:real;
 begin
  If y1_2 = y1_1 Then
   Begin
     a:=x1_3; b:=y1_2;
   End
  Else
  If x1_2 = x1_1 Then
   Begin
     a:=x1_2; b:=y1_3;
   End
  Else
   Begin
     k1 := (x1_1 - x1_2)/(y1_2 - y1_1) - (y1_2 - y1_1)/(x1_2 - x1_1);

     k2 := y1_1 - y1_3 - x1_1 * ((y1_2 - y1_1) / (x1_2 - x1_1))
                    + x1_3 * ((x1_1 - x1_2) / (y1_2 - y1_1));
     a := k2 / k1;
     b := a * ((y1_2 - y1_1)/(x1_2 - x1_1)) + y1_1 -
       x1_1 * ((y1_2 - y1_1) / (x1_2 - x1_1));
  End;
 end;

procedure T_A(x2_1, y2_1, x2_2, y2_2 :real; var Z,W:real);
 begin
   Z := 2 * x2_1 - x2_2;
   W := 2 * y2_1 - y2_2;
 end;
Procedure T_C(x3_1,y3_1,x3_2,y3_2,x3_3,y3_3,x3_4,y3_4:real; var m,n :real);
var k1,k2:real;
 begin
  If x3_2 = x3_1 Then
   Begin
     m:=x3_2;
     n:=y3_3+(y3_4-y3_3)*(x3_1-x3_3)/(x3_4-x3_3);
   End
  Else

  If x3_3 = x3_4 Then
   Begin
     m:=x3_4;
     n:=y3_1+(y3_2-y3_1)*(x3_4-x3_1)/(x3_2-x3_1);
   End
  Else

   Begin
    k1 := (y3_2 - y3_1)/(x3_2 - x3_1) - (y3_4 - y3_3)/(x3_4 - x3_3);

    k2 := y3_3 - y3_1 - x3_3 * ((y3_4 - y3_3) / (x3_4 - x3_3))
                    + x3_1 * ((y3_2 - y3_1) / (x3_2 - x3_1));
     m := k2 / k1;
     n := m * ((y3_2 - y3_1)/(x3_2 - x3_1)) + y3_1 -
       x3_1 * ((y3_2 - y3_1) / (x3_2 - x3_1));
  End;
 end;
Function T_I(C_x,C_Y,x1,y1,x2,y2:Real):Boolean;
 Begin
   if (((C_x <= x1) and (c_x >= x2))
     or  ((c_x >= x1) and (c_x <= x2)))
     and
      (((c_y <= y1) and (c_y >= y2))
      or  ((c_y >= y1) and (c_y <= y2)))
     Then T_I:=True Else T_I := False;
 End;
 begin
  assign(fi,'billiard.dat');
  reset(fi);
  assign(fo,'billiard.sol');
  rewrite(fo);
  for i := 1 to 4 do
   begin
    read(fi,vhid[i,1],vhid[i,2]);
    readln(fi)
   end;
  { O1 }
  T_O( vhid[1,1], vhid[1,2], vhid[2,1],
       vhid[2,2], vhid[4,1], vhid[4,2], kor_o[1,1], kor_o[1,2]);

  { A1 }
  T_A (kor_o[1,1], kor_o[1,2], vhid[4,1], vhid[4,2], kor_a[1,1], kor_a[1,2]);

   { O2 }
   T_O( vhid[2,1], vhid[2,2], vhid[3,1],
       vhid[3,2], kor_a[1,1], kor_a[1,2], kor_o[2,1], kor_o[2,2] );

   { A2 }
  T_A (kor_o[2,1], kor_o[2,2], kor_a[1,1], kor_a[1,2], kor_a[2,1], kor_a[2,2]);

   { O3 }
   T_O( vhid[3,1], vhid[3,2], vhid[1,1],
       vhid[1,2], kor_a[2,1], kor_a[2,2], kor_o[3,1], kor_o[3,2] );

   { A3 }
  T_A (kor_o[3,1], kor_o[3,2], kor_a[2,1], kor_a[2,2], kor_a[3,1], kor_a[3,2]);

   { C3 }

   T_C( vhid[3,1], vhid[3,2], vhid[1,1], vhid[1,2],
        kor_a[3,1], kor_a[3,2], vhid[4,1], vhid[4,2],
        kor_c[3,1], kor_c[3,2] );

   { C2 }
   T_C( vhid[2,1], vhid[2,2], vhid[3,1], vhid[3,2],
        kor_c[3,1], kor_c[3,2], kor_a[2,1], kor_a[2,2],
        kor_c[2,1], kor_c[2,2] );

   { C1 }
   T_C( vhid[1,1], vhid[1,2], vhid[2,1], vhid[2,2],
        kor_c[2,1], kor_c[2,2], kor_a[1,1], kor_a[1,2],
        kor_c[1,1], kor_c[1,2] );

      If T_I (Kor_c[3,1], Kor_c[3,2], vhid[3,1], vhid[3,2], vhid[1,1],
     vhid[1,2]) Then
    If T_I (Kor_c[2,1], Kor_c[2,2], vhid[3,1], vhid[3,2], vhid[2,1],
     vhid[2,2]) Then
    If T_I (Kor_c[1,1], Kor_c[1,2], vhid[2,1], vhid[2,2], vhid[1,1],
     vhid[1,2]) Then
     Write(fo,Kor_c[1,1]:0:2,' ',kor_c[1,2]:0:2)
    Else
    Write(fo,'задача не имеет решения');
    WriteLn(fo);

  close(fi);
  close(fo);
end.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
u372t1z2.pas
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 16384,0,655360}

var xa,ya,xb,yb,xc,yc,xo,yo,a,b,c,a1,b1,c1,a2,b2,c2,a3,b3,c3,xo1,yo1,xo2,yo2,xo3,yo3,xd,yd:real;
    f:text;

procedure syst(aa,ba,ca,ab,bb,cb:real; var x,y:real);
begin
  y:=(-ca*ab+cb*aa)/(ba*ab-bb*aa);
  if aa<>0 then x:=-(ca+ba*y)/aa else x:=-(cb-bb*y)/ab;
end;

procedure rivn(xa,ya,xb,yb:real; var a,b,c:real);
begin
a:=ya-yb; b:=xb-xa;
c:=xb*(yb-ya)+yb*(xa-xb);
end;

procedure symetry(x,y,a,b,c:real; var x1,y1:real);
var a1,b1,c1,p,q:real;
begin
a1:=b; b1:=-a; c1:=-a1*x-b1*y;
syst(a,b,c,a1,b1,c1,p,q);
x1:=2*p-x; y1:=2*q-y;
end;

begin

assign(f,'c:\billiard.dat');
reset(f);
readln(f,xa,ya);
readln(f,xb,yb);
readln(f,xc,yc);
readln(f,xo,yo);
close(f);

rivn(xa,ya,xb,yb,a,b,c);
symetry(xo,yo,a,b,c,xo1,yo1);
rivn(xa,ya,xc,yc,a1,b1,c1);
symetry(xo,yo,a1,b1,c1,xo2,yo2);
rivn(xb,yb,xc,yc,a3,b3,c3);
symetry(xo2,yo2,a3,b3,c3,xo3,yo3);
rivn(xo1,yo1,xo3,yo3,a2,b2,c2);
syst(a,b,c,a2,b2,c2,xd,yd);

assign(f,'c:\billiard.sol');
rewrite(f);
writeln(f,xd:0:2,' ',yd:0:2);
close(f);
end.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
u962t1z2.pas
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
{$A+,B-,D+,E+,F-,G-,I+,L+,N+,O-,P-,Q+,R+,S+,T-,V+,X+}
{$M 16384,0,655360}
Type Kordynaty=array[1..2] of extended;
Var fi,fo:text;
a,b,a1,b1,a2,b2,a3,b3:extended;
Result:Kordynaty;
x,y:extended;
Procedure Peretyn;
Var k1,k2,l1,l2:extended;
begin
if a1=a2 then begin
k2:=(b-y)/(a-x);     l2:=y-k2*x;
Result[1]:=a1; Result[2]:=k2*Result[1]+l2;  exit;
              end;
if a=x then begin
k1:=(b2-b1)/(a2-a1); l1:=b1-k1*a1;
Result[1]:=x; Result[2]:=k1*Result[1]+l1;   exit;
              end;
k1:=(b2-b1)/(a2-a1); l1:=b1-k1*a1;
k2:=(b-y)/(a-x);     l2:=y-k2*x;
Result[1]:=(l2-l1)/(k1-k2);
Result[2]:=k1*Result[1]+l1;
end;

procedure symetria(x1,y1,x2,y2:extended);
Var k1,k2,l1,l2:extended;
    Tmp:Kordynaty;
begin

if x1=x2 then begin
x:=2*x1-x;exit;
              end;

if y1=y2 then begin
y:=2*y1-y;exit;
              end;

k1:=(y1-y2)/(x1-x2);    l1:=y1-k1*x1;
k2:=-(x1-x2)/(y1-y2);   l2:=y-k2*x;

Tmp[1]:=(l2-l1)/(k1-k2);
Tmp[2]:=k1*Tmp[1]+l1;
x:=2*Tmp[1]-x;
y:=2*Tmp[2]-y;
end;

begin
assign(fi,'billiard.dat');reset(fi);
assign(fo,'billiard.sol');rewrite(fo);
readln(fi,a1,b1);
readln(fi,a2,b2);
readln(fi,a3,b3);
readln(fi,a,b);
close(fi);
x:=a;y:=b;
symetria(a3,b3,a1,b1);
symetria(a2,b2,a3,b3);
symetria(a1,b1,a2,b2);
Peretyn;
writeln(fo,Result[1]:0:2,' ',Result[2]:0:2);
close(fo);
end.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 

Задача 3.

Учасники, які набрали максимум балів 515, 647, 838, 953

u515t1z3.cpp
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
#include"fstream.h"
#include"string.h"

char a[1000];
int c[1000];
double n;
int i,k;
double m;
int x,y;
int pr;

int p(int j)
{
        while((a[j]>='0')&&(a[j]<='9')){n=10*n+a[j]-'0';j+=1;}
        double w=10;
        if(a[j]=='.'){j+=1;while((a[j]>='0')&&(a[j]<='9')){n+=(a[j]-'0')/w;w*=10;j+=1;}}
        return j-1;
}

void q()
{
        m=n;
        x=i;
        y=k;
        pr=1;
}

void main()
{
        ifstream f("max.dat");
        ofstream o("max.sol");
        while(f.ios::eof()==0){f>>a[i];i++;}
        for(i=0;i<strlen(a);i++)
                if((a[i]>='0')&&(a[i]<='9'))
                {
                        n=0.0;
                        k=p(i);
                        if(n>=m) q();
                }
        if(pr==1)
                for(i=x;i<=y;i++)
                        o<<a[i];
}
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
u647t1z3.pas
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
{$A+,B-,D-,E+,F-,G-,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V+,X+,Y+}
{$M 16384,0,655360}
Var
  s : String;
  ls: Byte Absolute S;
  f :Boolean;
  mc,md : String;
  lmc : Byte Absolute mc;
  lmd : Byte Absolute md;
function Max(a,b:Integer):Integer; Begin if a>b then max:=a else max:=b; End;
function cmp(s: String) : Boolean;
Var sc,sd : String;
l : Integer;
Begin
  While (lmc>0) and (mc[1]='0') do mc:=Copy(mc,2,lmc);
  While (length(s)>0) and (s[1]='0') do s:=Copy(s,2,ls);
  If Pos('.',s)>0 then Begin sc:=Copy(s,1,Pos('.',s)-1); sd:=Copy(s,Pos('.',s)+1,Length(s)); End
                  else Begin sc:=s; sd:=''; End;
  If Length(sc)<lmc then Begin cmp:=False; Exit; End;
  if Length(sc)>lmc then Begin cmp:=True; Exit End;
  If sc<mc then Begin cmp:=False; Exit; End;
  if sc>mc then Begin cmp:=True; Exit End;
  l:=max(Length(sd),lmd);
  While lmd<l do md:=md+'0';
  While Length(sd)<l do sd:=sd+'0';
  If md>sd then Begin cmp:=False; Exit; End;
  if md<sd then Begin cmp:=True;  Exit; End;
  cmp:=false;
End;

Var
  t : String;
  i,j : Integer;
  lt : Byte Absolute T;
  ff : Text;
Begin
  Assign(ff,'MAX.DAT'); Reset(ff);
  Readln(ff,s);
  Close(ff);
  For i:=1 to ls do
  Begin
    f:=False;
    lt:=0;
    For j:=i to ls do
    Begin
      if (s[j]>='0') and (s[j]<='9') then t:=t+s[j] else
      If (not f) and (s[j]='.') and (j>i) and (j<ls) and (s[j+1] in ['0'..'9']) then Begin f:=True; t:=t+'.'; End else
      Break;
    End;
    if cmp(t) then Begin
      If Pos('.',t)>0 then Begin mc:=Copy(t,1,Pos('.',t)-1); md:=Copy(t,Pos('.',t)+1,Lt); End
                      else Begin mc:=t; md:=''; End;
    End;
  End;
  Assign(ff,'MAX.SOL'); Rewrite(ff);
  Write(ff,mc);
  While md[lmd]='0' do dec(lmd);
  if md<>'' then Write(ff,'.'+md);
  Writeln(ff);
  Close(ff);
End.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
u838t1z3.pas
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
var s,s1,s2,s3:string;i,n,k,j,t,sh,c:longint;f,fd,f0:boolean;fi,fo:text;
procedure sort(var sp,s1p:string);
var j,k,c,sh:longint;s2p:string;fl,fl1,fl2:boolean;
begin
if sp=' 'then begin s2p:=sp;sp:=s1p;s1p:=s2p;end;
fl:=false;fl1:=true;fl2:=true;
for j:=1 to length(sp)+1 do if sp[j]='.' then begin fl1:=false; break;end;
for k:=1 to length(s1p)+1 do if s1p[k]='.' then begin fl2:=false;break;end;

if fl1 then j:=length(sp)+1;
if fl2 then k:=length(s1p)+1;
if  k>j then begin s2p:=sp;sp:=s1p;s1p:=s2p;fl:=true;end else
if  k=j then begin for c:=1 to k do if byte(s1p[c])>byte(sp[c]) then
begin s2p:=sp;sp:=s1p;s1p:=s2p;fl:=false;break;end else
if  byte(s1p[c])=byte(sp[c]) then fl:=true else
begin fl:=false;break;end;
if fl then begin if length(sp)>length(s1p) then
sh:=length(sp) else sh:=length(s1p);
for c:=k to sh do if s1p[c]>sp[c] then
begin s2p:=sp;sp:=s1p;s1p:=s2p;break;end else
if s1p[c]<sp[c] then break;end;end;
end;

begin
assign(fi,'max.dat');reset(fi);
assign(fo,'max.sol');rewrite(fo);
readln(fi,s);
k:=1;
while k<=length(s) do Begin
f:=true;f0:=true;fd:=true;
for  i:=k to length(s)+1 do if (byte(s[i])>=48) and (byte(s[i])<=57) then break;
for  c:=i to length(s)+1 do if (byte(s[c])<48) or (byte(s[c])>57) then break;
s3:=copy(s,i,c-i);
if (s[c]='.')  then
for i:=c+1 to length(s)+1 do if (byte(s[i])<48) or (byte(s[i])>57) then break;
s3:=s3+copy(s,c,i-c);
for i:=1 to length(s3) do

if (s3[i]='0') and (s3[i+1]<>'0') then
begin f:=false;  break;end else if s3[i]<>'0' then break else
if (i=length(s3)) and (s3[i]='0') then f:=false;
if not f then s2:=copy(s3,i+1,length(s3)-i) else s2:=s3;
sort(s1,s2);k:=c;
end;

for i:=1 to length(s1) do if s[i]='.' then begin f0:=false; break;end;
for k:=length(s1) downto i do
if s1[k]<>'0' then begin fd:=false;break;end else
if (s1[k]='0') and (s1[k-1]<>'0') then break;
if  (not f0) and (fd) then
delete(s1,k,length(s1)-k+1);
if s1[length(s1)]='.' then dec(byte(s1[0]));
writeln(fo,s1);
close(fi);
close(fo);
end.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
u953t1z3.pas
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
const ch:set of char=['0'..'9'];
var fi,fo:text;
    s:string;
    i,j,t,q,l,lc,p:integer;
procedure leng(var i:integer); begin while s[i]in ch do inc(i) end;
procedure new; begin p:=j; l:=j-i; lc:=t end;
begin
  Assign (fi,'max.dat'); Reset (fi);
  Assign (fo,'max.sol'); Rewrite (fo);
   Readln (fi,s);
   for i:=1 to length(s) do
    if (s[i]<>'0')and(s[i]in ch) then begin
       j:=i; leng(j); t:=j+1;
       if (s[t-1]='.')and(s[t]in ch) then leng(t) else dec(t);
       if l=j-i then begin
         q:=j-i;
         while (s[p-q]=s[j-q])and(q<>j-t+1) do dec(q);
         if ((s[p-q]in ch)and(s[p-q]<s[j-q]))or(not(s[p-q]in ch)) then new
       end else if l<j-i then new;
       i:=j-1;
    end;

  if p=0 then write(fo,'0') else for i:=p-l to lc-1 do write(fo,s[i]); writeln(fo);
  Close(fi); Close(fo);
end.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -