Matematické Fórum

type Tpole=array of Integer;
var naz,vyp: Tpole;
    i,j,poc,zb,a: Integer;

procedure Napln(var s: Tpole; n: Integer);
var i: Integer;
begin
  SetLength(s,n);
  for i := 0 to n-1 do
    s[i] := i+1;
end;

begin
  WriteLn(' -------------------- Kruh -------------------');
  Write(' Zadej pocet cisel: ');
  ReadLn(poc);
  if (poc>0)and(poc<1000000) then
  begin
    Napln(naz,poc);
    SetLength(vyp,poc);
    i := 0;   //nastaveni promenych
    j := 0;
    a := 0;
    zb := 0;
    while zb<poc do  //pocet vyrazovani je mensi nez pocet cisel
    begin
      if naz[i]<>0 then  //jestlize prvek pole neni 0, tak ho zapocitame
        a := a+1;
      if a=2 then  //kdyz mame pocet projitych cisel 2
      begin
        j := j+1;          //pocitadlo pro index pole vyrazenych cisel zvysime o 1
        vyp[j] := naz[i]; //do pole vypadnutych zapiseme, ktere to je
        naz[i] := 0;      //a prvku pole (tomu cislu) pridelime 0
        a := 0;           //pocitadlo na nulu
        zb := zb+1;       //uz jsme jedno vyradili
      end;
      i := i+1;
      if i=poc then     //kdyz jsme na konci rady
        i := 0;         //skocime na zacatek rady
    end;
    WriteLn;
    {WriteLn(' Poradi vypadnutych cisel');
    for i := 1 to poc-1 do  //vypis poradi vyrazovani
      Write(' ',vyp[i]);
    WriteLn;}
    WriteLn;
    WriteLn(' Zbylo cislo: ',vyp[poc]);
    ReadLn;
  end
  else
  begin
    WriteLn;
    WriteLn(' ERROR ');
    ReadLn;
  end;
end.

const Max=100000000;
var naz: array[1..Max] of Boolean;
    i,j,poc,zb,a: Integer;

begin
  WriteLn(' -------------------- Kruh -------------------');
  Write(' Zadej pocet cisel: ');
  ReadLn(poc);
  if (poc>0)and(poc<=Max) then
  begin
    i := 1;   //nastaveni promenych
    j := 0;
    a := 0;
    zb := 0;
    while zb<poc do  //dokud pocet vyrazovani je mensi nez pocet cisel
    begin
      if not naz[i] then  //jestlize prvek pole je False, tak s nim pracujeme
        a := a+1;
      if a=2 then  //kdyz mame pocet projitych cisel 2
      begin
        naz[i] := True;   //a prvku pole (tomu cislu) pridelime True - priste uz ho preskocime
        j := i;           //zapiseme vyrazeny prvek (cislo)
        a := 0;           //pocitadlo na nulu
        zb := zb+1;       //uz jsme jedno vyradili
      end;
      i := i+1;
      if i-1=poc then    //kdyz jsme na konci rady
        i := 1;         //skocime na zacatek rady
    end;
    WriteLn;
    WriteLn;
    WriteLn(' Zbylo cislo: ',j); //vypiseme posledni vyrazeny prvek (tedy ten zbyly)
    ReadLn;
  end
  else
  begin
    WriteLn;
    WriteLn(' ERROR ');
    ReadLn;
  end;
end.