{找素数}
Program FindPrime;
Const per=50000; size=1000000-per-1; need=6600; outf='D:\primelst.out';
Var pri :Array[0..need] of Word;
    i, total :LongInt;

Procedure initial(Var pri:Array of Word; Var total:LongInt);
 Var i, j :Longint;
     chk :Array[1..per] of boolean;
 Begin
   fillchar(chk, sizeof(chk), true);
   For i:=2 to trunc(Sqrt(per))+1 do
     If chk[i] then Begin
       j:=i+i;
       While j<=per do Begin
         chk[j]:=false;
         Inc(j, i);
       End;
       pri[total]:=i;
       Inc(total);
     End;
   For i:=trunc(Sqrt(per))+2 to per do
     If chk[i] then Begin
       pri[total]:=i;
       Inc(total);
     End;
 End;


Procedure AreaFind(vsta :LongInt; pri:Array of Word; Var total :LongInt);
 Var i, k, hh :Word;
     chk :Array[1..per] of boolean;
 Begin
   i:=0;
   hh:=Trunc(sqrt(vsta+per))+1;
   fillchar(chk, sizeof(chk), true);
   While pri[i]<=hh do begin
     k:=pri[i] - vsta mod pri[i];
     While k<=per do begin
       chk[k]:=false;
       Inc(k, pri[i]);
     End;
     Inc(i);
   End;
   For k:=1 to per do
     If chk[k] then Begin
       Write((k+vsta):10);
       Inc(total);
       If total mod 10=9 then writeln;
     End;
 End;

Begin
  Assign(output,outf);
  Rewrite(output);
  fillchar(pri,sizeof(pri),0);
  Initial(pri, total);
  i:=0;
  While pri[i]<per do Begin
    write(pri[i]:10);
    If i mod 10=9 then writeln;
    Inc(i);
  End;
  total:=i;
  i:=0;
  While i<=size do begin
    Inc(i, per);
    AreaFind(i, pri, total);
  End;
  Writeln;
  Writeln('Total= ',total:7,' in ',i+per :9);
  Close(output);
End.


 function gcd(a,b:integer):integer;
 begin 
   if b=0 then gcd:=a
     else gcd:=gcd (b,a mod b);
   end;

 function gcd(a,b:integer):integer;
 begin
   While (a=1)or(b=1) do begin
     if a>b then a:=a mod b
       else b:=b mod a;
    End;
   if a=1 then gcd:=b else gcd:=a;
 End;



{因式分解}
Program factorization;
Var su :Array[1..7000] of Word;
    tot :Integer;
    n :String;
Procedure sushu;
 const chu=10000;
 type tp=Array[0..9999] of boolean;
 var yes :Array[0..6] of ^ty;
     i1, i2 :Integer;
     i, j, k :LongInt;
 Begin
   k:=0;
   For i:=0 to 6 do Begin
     new(yes[i]);
     fillchar(yes[i]^, sizeof(yes[i]^, true));
    End;
   For i:=2 to 65535 do Begin
     i1:=i div chu;
     i2:=i mod chu;
     If yes[i1]^[i2] then Begin
       Inc(k);
       su[k]:=i;
       j:=i+i;
       While j<65535 do Begin
         i1:=j div chu;
         i2:=j mod chu;
         yes[i1]^[i2]:=false;
         Inc(j,i);
        End;
      End;
    End;
   tot:=k;
 End;

Function ok(s:String; chu:Word; Var get:String):Boolean;
 Var b, num, j :LongInt;
     o, i :Integer;
     now, ch, c :String;
 Begin
   ok:=false;
   If s='1' Then Exit;
   i:=0;
   ch:='';
   now:='';
   Repeat
     While (ch<>'')And(ch[1]='0') do Delete(ch,1,1);
     Repeat
       inc(i);
       ch:=ch+s[i];
       Val(ch, num, o);
       If ch[1]='0' then Delete(ch,1,1);
       now:=now+'0';
     Until (num>=chu) Or (i=length(s));
     If (i=Length(s))And(num<chu) Then Break;
     Delete(now, length(now), 1);
     j:=num div chu;
     str(j, c);
     now:=now+c;
     j:=num mod chu;
     str(j,ch);
   until i=length(s);
   While (ch<>'')And(ch[1]='0') do Delete(ch,1,1);
   If ch='' then Begin
     While (now[1]='0') do Delete(now,1,1);
     ok:=true;
     get:=now;
    End;
 End;

Procedure main;
 Var k, num, :Integer;
     now :String;
     f :Text;
 Begin
   Assign(f, 'input2.in6);
   Reset(f);
   Readln(f, n);
   Close(k);
   Assign(f, 'output2.on6');
   Rewrite(f);
   k:=0;
   Repeat
     Inc(k);
     num:=0;
     While ok(n, su[k], now) do Begin
       inc(num);
       n:=now;
      End;
     If num<>0 then Writeln(f, su[k],'',num);
   Until (k=tot) or (n='1');
   If n<>'1' Then Writeln(f, 'Data Error!');
   Close(f);
 End;

Begin
  sushu;
  main;
End.