Informatika gyűjtemény

Egy szinttel feljebb bolgar.pas

2004050607080910

<<  6. óra - Partíció  >>

<<  Bolgár szoliter  >>

NézetNyomtat

bolgar.pas (Vissza)
Az alábbi letöltési lehetőségek közül választhatsz: (segítség)
Karakterkódolás:
Sortörés:
Típus: text/plain
Tartalmaz szöveget
Karakterkódolás: utf-8
Méret: 2 KB
program bolgar2;

uses crt;

const maxkupac=30000;

var kupac, proba:array[1..maxkupac] of longint;
    kupacokszama, i, csere:integer;
    szamlalo, kovetkezoproba, cikluskezdo :longint;
    q:char;
    ciklusbanVagyunk, vege:boolean;


procedure talalat(szamlalo:longint);

var i:integer;

begin
    if ciklusbanVagyunk then
    begin
        writeln('Megvan a ciklus! A ciklushossz: ',szamlalo-cikluskezdo);
        for i:=1 to kupacokszama do
        begin
          write(kupac[i],' ');
          if (i mod 10 = 9) then writeln;
        end;
        readln;
        vege:=true;
        exit;
    end
    else
    begin
        ciklusbanVagyunk:=true;
        cikluskezdo:=szamlalo;
    end;
end;

procedure rendez;

var utolsonemures,i:integer;

begin
    utolsonemures:=0;

    for i:=1 to kupacokszama do
    begin
        if (kupac[i] <> 0) then
        begin
            if (utolsonemures = (i-1)) then //jó helyen van a kupac
               utolsonemures:=i
            else //rossz helyen a kupac
            begin
                inc(utolsonemures);
                kupac[utolsonemures]:=kupac[i];
                kupac[i]:=0;
            end;
        end;
    end;

    kupacokszama:=utolsonemures;

    for i:=(kupacokszama - 1) downto 1 do
    //elég egy ciklus, mert egy idő után csak az utolsó kupac nincs a helyén
      if (kupac[i]>kupac[i+1]) then
      begin
          csere:=kupac[i];
          kupac[i]:=kupac[i+1];
          kupac[i+1]:=csere;
      end;

end;

procedure vizsgalciklus;

var i:integer;
    ugyanaz:boolean;


begin
    ugyanaz:=true;
    for i:=1 to kupacokszama do
      if (proba[i]<>kupac[i]) then ugyanaz:=false;

    if ugyanaz then
      talalat(szamlalo);



    inc(szamlalo);
    if (szamlalo=kovetkezoproba) and not ciklusbanVagyunk then
    begin
        for i:=1 to kupacokszama do
          proba[i]:=kupac[i];
        for i:=(kupacokszama + 1) to maxkupac do
          proba[i]:=0;

        szamlalo:=0;
        kovetkezoproba:=kovetkezoproba*2;
    end;
end;

procedure lepes;

begin
    for i:=1 to kupacokszama do
      dec(kupac[i]);

    kupac[kupacokszama+1]:=kupacokszama;
    inc(kupacokszama);

    rendez;
    vizsgalciklus;
end;

procedure kiirKupacok;

begin
    writeln('A kupacok:');
    for i:=1 to kupacokszama do
      write(kupac[i],' ');
    writeln;
end;

begin
    kupac[1]:=3005;
    //sajnos kézzel kell bevinni a kupacokat, és a kupacok számát
    //persze megcsinálható, hogy .txt-ből olvasson
    kupacokszama:=1;

    kovetkezoproba:=2;
    ciklusbanvagyunk:=false;
    vege:=false;

    while not vege do
        lepes;


end.
(Vissza)