INFOMAN брой 2

{ Това са входните данни (числото N):
 150

                              ДВОЙНО ПРОСТИ ЧИСЛА
                              -------------------

 Разглеждаме редицата A на простите числа - 2, 3, 5, 7, 11, 13, 17, 19, ...
 Редицата B дефинираме като образуване от редицата A чрез долепяне на члено-
 вете на A последователно по двойки. B = 23, 57, 1113, 1719, ... Двойно про-
 сти числа наричаме членовете на редицата B, които са прости числа.  Редица-
 та C на двойно простите числа е 23, 3137, 8389, 157163, ...  Да се състави
 програма,която по зададено число N намира N-тия член на редицата C /N-тото
 двойно просто число/. N < 500.

  За да решим здачата, първо ще намерим редицата A - всички прости числа от
 1 до някаква горна граница например ако вземем за граница 262144, че можем
 да получим всички членове на редицата B от 1 до 262144262144,което е напъл-
 но достатъчно.Редицата A на простите числа намираме по метода на решето на
 Ератостен.След това от всяка двойка числа образуваме ново число - поредния
 член на редицата B. Проверяваме този член дали е просто число и ако е, сме
 намерили поредния член на редицата C. Когато намерим търсения N-ти член на
 C, отпечатваме решението. За да работим максимално лесно, удобно и бързо с
 простите числа от 1 до 262144, ще разработим един обект "голям масив".Обек-
 та ще съхранява много големи булеви масиви като за всеки елемент съхранява
 по 1 бит и заделя паметта на страници по 16K.При създаване на екземпляр от
 този обект, ще се заделя паметта,  а при разрушаването му тя ще се освобож-
 дава. За установянене и вземане на стойността на елемент ще напишем два ме-
 тода на асемблер за да е бързо. За да не обхождаме последователно масива и
 да търсим следващите два елемента със стойност 1  (следващите 2 прости чис-
 ла в нашия случай), ще напичем процедура на асемблер, която вика процедура
 обработчик за всеки елемент със стойност 1 в масива. Написания по такъв на-
 чин обект може да се използва за бързо намиране и обработка на всички прос-
 ти числа от 0 до 4 милиона и е годен за използване и в други задачи.  Забе-
 лязва се обаче, че програмата не се забавя в намирането на редицата A и ре-
 дицата B,а в намирането на редицата C. Основният проблем е как да проверим
 дали едно голямо число (до 12 цифри) е просто,  защото при долепяне на два
 шестцифрени члена на редицата B може да се получи до 12-цифрено число. Ако
 използваме стандартния метод  - да проверим дали числото се дали на всички
 числа от 2 до корен от числото, програмата ще е бавна. Забелязваме,че в ин-
 тервала от 1 до 2*3*5*7*11 има точно 485 прости числа - 4 пъти по малко от
 вискчите 2*3*5*7*11 (2310) числа.  За да проверим дали едно число е просто,
 не е нужно да го делим на всяко число,а само на 485 числа от всеки 2310.Та-
 ка ще ускорим програмата няколко пъти.  Ето и твърдението на което се осно-
 вава алгоритъма за проверка дали едно голямо число е просто:
    Всяко просто число X може да се представи във вида:
    X = 2310*k, където k е просто число и 0<k<2310
 Понеже простите числа от 1 до 2310 са само 485, е достатъчно програмата да
 има тези като константа и когато проверява едно число A дали е просто,  да
 го проверява дали се дели на всяко число X, където X = 2310*k, а k е всяко
 просто число от 1 до 2310 и X <= корен от A. Опитите показват,че тази стра-
 тегия ускорява програмата 3 пъти.Разгледайте функцията Prosto за да видите
 конкретната реализация на посочения алгоритъм.
    Дадената програма работи до N = 500.
}

PROGRAM DvoinoProstiCisla;
{$R-,Q-,S-}

CONST InFileName  = 'input.txt';
      OutFileName = 'output.txt';

      MaxMasivSize = 262144; {Максимална възможна размерност на голям масив}

TYPE T16= array[0..16383] of byte; {Съставен тип 16Kb - съдържа 131072 елем.}
     ElementProc = procedure(Element:longint);

     BigArray = object { Обект "голям булев масив" }
                  Data: array[0..MaxMasivSize div 131072] of ^T16;
                  Size16: byte; {Дължина на големия масив в страници по 16Kb}
                  constructor Init(SizeMasiv:longint);
                  procedure Put(Element:longint; State:boolean);
                  function Get(Element:longint): boolean;
                  procedure FillAllWith(State:boolean);
                  procedure ForEachCall(Obrabotchik:ElementProc);
                  destructor Done;
                end;

{---------------------------------------------------------------------------}
{--------------------- методи за работа с дълъг масив ----------------------}
{---------------------------------------------------------------------------}

Constructor BigArray.Init(SizeMasiv:longint); {Инициализира големия масив}
Var I: word; {и му заделя динамична памет с размер колкото за всичките му}
Begin {елементи. Закръгля размера нагоре до кратен 16Kb - 131072 елемента}
  Size16:=SizeMasiv div 131072;
  for I:= 0 to Size16 do New(Data[I]);
End;

{Procedure BigArray.Put(Element:longint; State:boolean);
Var Masiv,El: word;
    BitMask: byte;
Begin
  BitMask:= 1 shl (Element mod 8);
  Masiv:=Element div (16384*8);
  El:=(Element div 8) mod 16384;
  if State then
    Data[Masiv]^[El]:=Data[Masiv]^[El] or BitMask
  else Data[Masiv]^[El]:=Data[Masiv]^[El] and (255 xor BitMask);
End;{}

Procedure BigArray.Put(Element:longint; State:boolean); assembler;
Asm {Променя елемента с номер Element в състояние State (true или false)}
  mov  cx, word ptr Element   {cx=Lo(Element)}
  mov  bx, word ptr Element+2 {bx=Hi(Element)}
    push cx {Calculate Bit= 1 shl (Element mod 8)}
    and  cl, 7
    mov  al, 1
    shl  al, cl {ah=BitMask}
    pop  cx
  shr  bx, 1 {bx=Masiv}
  rcr  cx, 1
  shr  cx, 2 {cx=(Element div 8)mod 16384}
  shl  bx, 2 {bx=Masiv*4}
    les   di, Self
    les   di, es:[di+offset Data+bx] { es:di=Data[Masiv]^[0] }
    add   di, cx { es:di=Data[Masiv]^[Element/8] }
  cmp   State, 0
  jnz   @true
    xor  al, 255    {Set false}
    and  es:[di], al
    jmp  @end
  @true:
    or  es:[di], al {Set true}
  @end:{}
End;

{Function BigArray.Get(Element:longint): boolean;
Var Bit,Masiv: word;
Begin
  Bit:=1 shl (Element mod 8); Element:=Element div 8;
  Masiv:=Element div 16384;
  Element:=Element mod 16384;
  Get:=boolean(Data[Masiv]^[Element] and Bit);
End;{}

Function BigArray.Get(Element:longint): boolean; assembler;
Asm {Връща елемента с номер Element от големия масив (true или false) }
  mov  cx, word ptr Element  {cx=Lo(Element)}
  mov  bx, word ptr Element+2 {bx=Hi(Element)}
    push cx {Calculate Bit= 1 shl (Element mod 8)}
    and  cl, 7
    mov  ah, 1
    shl  ah, cl {ah=BitMask}
    pop  cx
  shr  bx, 1 {bx=Masiv}
  rcr  cx, 1
  shr  cx, 2 {cx=(Element div 8)mod 16384}
  shl  bx, 2 {bx=Masiv*4}
    les   di, Self
    les   di, es:[di+offset Data+bx] { es:di=Data[Masiv]^[0] }
    add  di, cx { es:di=Data[Masiv]^[Element/8] }
  mov  al, [es:di]
  and  al, ah
End;

Procedure BigArray.FillAllWith(State:boolean); {Запълва всички елементи на}
Var I,BitMask: byte;  {големия масив със стойността State (true или false)}
Begin
  if State then BitMask:=255 else BitMask:=0;
  for I:=0 to Size16 do
    FillChar(Data[I]^,SizeOf(Data[I]^),BitMask);
End;

Procedure BigArray.ForEachCall(Obrabotchik:ElementProc); assembler;
Asm {За всеки един елемент със стойност true извиква процедурата Obrabotchik}
  cld
  les  di, Self
  xor  bx, bx
  xor  ax, ax
  @NextDataPage:
    pusha
    push  es
    shl  bx, 2
    les  di, es:[di+bx+offset Data]
       {Търсене на ненулев елемент в поредната област ES:[DI](=Self.Data)}
       mov  cx, 8192
     @AGAIN_SCAN_SELF_DATA:
       rep scasw
       jz   @NotFound
         mov  ax, 16384/4
         mul  bx    {AX:DX = Page*16384/8}
          add  ax, 16382
          sub  ax, cx
          sub  ax, cx {AX:DX = Page*16384/8 +Pozition}
         mov  si, 8
         mul  si {AX:DX = Page*16384/8 +Pozition}
           mov  si, es:[di-2]
          @Otdeli15: {Намиране и на последните цифри (mod 15) на елемента}
           test si, 1
           je  @Again15
             push  es
             pusha
             push  dx
             push  ax
             call  Obrabotchik
             popa
             pop   es
          @Again15:
           inc  ax
           shr  si, 1
           or   si, si
           jnz  @Otdeli15
     OR   CX, CX
     JNZ  @AGAIN_SCAN_SELF_DATA
   @NotFound:
    pop   es
    popa
  inc  bl
  cmp  bl, es:[di].Size16
  jng  @NextDataPage
 @EndFunction:
End;

Destructor BigArray.Done; {Освобождава динамичната памет, заета от масива}
Var I: word;
Begin
  for I:= 0 to Size16 do Dispose(Data[I]);
End;

{---------------------------------------------------------------------------}
{----------------------------- основна програма ----------------------------}
{---------------------------------------------------------------------------}

VAR Index,WantedIndex: integer;
    Last: longint;
    Prosti: BigArray;


Procedure ReadData;
Var F: Text;
Begin
  Assign(F,InFileName); Reset(F);
  ReadLn(F,WantedIndex);
  Close(F);
End;

Procedure Print(const Number:extended);
Var F: Text;
Begin
  Assign(F,OutFileName); Rewrite(F);
  WriteLn(F,Number:0:0);
  Close(F); Halt;
End;

{Function Prosto(Cislo:extended): boolean;
Var I: longint;
Begin
  Prosto:= false;
  for I:= 2 to trunc(sqrt(Cislo)) do
    if frac(Cislo/I) = 0 then Exit;
  Prosto:= true;
End;}

Function Prosto(Cislo:real): boolean; {Връща дали едно е просто}
Const BrOstataci2310 = 485;
      ProstiOstataci2310: array[1..BrOstataci2310] of integer =
 (1,2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,
 101,103,107,109,113,127,131,137,139,149,151,157,163,167,169,173,179,181,
 191,193,197,199,211,221,223,227,229,233,239,241,247,251,257,263,269,271,
 277,281,283,289,293,299,307,311,313,317,323,331,337,347,349,353,359,361,
 367,373,377,379,383,389,391,397,401,403,409,419,421,431,433,437,439,443,
 449,457,461,463,467,479,481,487,491,493,499,503,509,521,523,527,529,533,
 541,547,551,557,559,563,569,571,577,587,589,593,599,601,607,611,613,617,
 619,629,631,641,643,647,653,659,661,667,673,677,683,689,691,697,701,703,
 709,713,719,727,731,733,739,743,751,757,761,767,769,773,779,787,793,797,
 799,809,811,817,821,823,827,829,839,841,851,853,857,859,863,871,877,881,
 883,887,893,899,901,907,911,919,923,929,937,941,943,947,949,953,961,967,971,
 977,983,989,991,997,1003,1007,1009,1013,1019,1021,1027,1031,1033,1037,1039,
 1049,1051,1061,1063,1069,1073,1079,1081,1087,1091,1093,1097,1103,1109,1117,
 1121,1123,1129,1139,1147,1151,1153,1157,1159,1163,1171,1181,1187,1189,1193,
 1201,1207,1213,1217,1219,1223,1229,1231,1237,1241,1247,1249,1259,1261,1271,
 1273,1277,1279,1283,1289,1291,1297,1301,1303,1307,1313,1319,1321,1327,1333,
 1339,1343,1349,1357,1361,1363,1367,1369,1373,1381,1387,1391,1399,1403,1409,
 1411,1417,1423,1427,1429,1433,1439,1447,1451,1453,1457,1459,1469,1471,1481,
 1483,1487,1489,1493,1499,1501,1511,1513,1517,1523,1531,1537,1541,1543,1549,
 1553,1559,1567,1571,1577,1579,1583,1591,1597,1601,1607,1609,1613,1619,1621,
 1627,1633,1637,1643,1649,1651,1657,1663,1667,1669,1679,1681,1691,1693,1697,
 1699,1703,1709,1711,1717,1721,1723,1733,1739,1741,1747,1751,1753,1759,1763,
 1769,1777,1781,1783,1787,1789,1801,1807,1811,1817,1819,1823,1829,1831,1843,
 1847,1849,1853,1861,1867,1871,1873,1877,1879,1889,1891,1901,1907,1909,1913,
 1919,1921,1927,1931,1933,1937,1943,1949,1951,1957,1961,1963,1973,1979,1987,
 1993,1997,1999,2003,2011,2017,2021,2027,2029,2033,2039,2041,2047,2053,2059,
 2063,2069,2071,2077,2081,2083,2087,2089,2099,2111,2113,2117,2119,2129,2131,
 2137,2141,2143,2147,2153,2159,2161,2171,2173,2179,2183,2197,2201,2203,2207,
 2209,2213,2221,2227,2231,2237,2239,2243,2249,2251,2257,2263,2267,2269,2273,
 2279,2281,2287,2291,2293,2297,2309 );
Var Current,Last,i: longint;
Begin
  Prosto:= false;
  for i:= 2 to BrOstataci2310 do
    if frac(Cislo/ProstiOstataci2310[i]) = 0 then
      begin
        if Cislo = ProstiOstataci2310[i] then
	  Prosto:=true;
        Exit
      end;
  Last:= trunc(sqrt(Cislo));
  Current:= 2310;
  while Current < Last do
    begin
      for i:= 1 to BrOstataci2310 do
        if frac(Cislo/(Current+ProstiOstataci2310[i])) = 0 then
	  Exit;
      Inc(Current,2310);
    end;
  Prosto:= true;
End;

Procedure FindProstiCisla; {Намира всички прости числа от 1 до MaxMasivSize}
Var I,Br: longint;
Begin
  Prosti.FillAllWith(true); Prosti.Put(1,false);
  for I := 2 to MaxMasivSize do
    if Prosti.Get(I) then
      begin
        Br:=I+I;
        while Br <= MaxMasivSize do
          begin Prosti.Put(Br,false); Inc(Br,I) end
      end;
End;

Procedure ProverkaZaProsto(Element:longint); far;
Var Cislo: extended;
    S1,S2: string;
    ErrFlag: integer;
Begin
  if Last = 0 then {Ако не са се събрали двойка числа, изход}
    begin Last:=Element; Exit; end;
  Str(Last,S1); Str(Element,S2);
  Val(S1+S2, Cislo, ErrFlag);

  if Prosto(Cislo) then
    begin {Ако слепените две последов. прости числа образуват просто число}
      Inc(Index);
      if Index = WantedIndex then Print(Cislo);
    end;
  Last:=0;
End;

BEGIN
  ReadData;

  Prosti.Init(MaxMasivSize);
  FindProstiCisla;
  Last:=0; Index:=0;
  Prosti.ForEachCall(ProverkaZaProsto);
  Prosti.Done;
END.