Pascal - třídící algoritmy

Místo pro dotazy a rady ohledně programovacích jazyků (C++, C#, PHP, ASP, Javascript, VBS..) a tvorby webových stránek

Moderátor: Mods_senior

Petr2000
nováček
Příspěvky: 11
Registrován: červen 19
Pohlaví: Nespecifikováno

Re: Pascal - třídící algoritmy

Příspěvekod Petr2000 » 16 čer 2019 21:53

Kód: Vybrat vše

program Kucharka;
uses crt;
type recepty=record
        nazev,vyber,postup:string;
        pocetsurovin,doba,strana,pocet:integer;
        surovina: array [1..50] of string end;
var SC,NC: file of recepty;
        recept:recepty;
        rozhod:char;

var m,n,t,v,i,j,min,min1,min2:integer;


procedure PRIDAT;
var P,m,n : integer;

begin

seek(SC,filesize(SC));
writeln(' Pis bez diakritiky!');
write(' Zapis nazev: ');readln(); readln(recept.nazev); writeln();
write(' Zapis dobu pripravy (v min): '); readln(recept.doba); writeln();
write(' Zapis pocet surovin: '); readln(recept.pocetsurovin); writeln();
m:=recept.pocetsurovin;
recept.strana:=filesize(SC)+1;
n:=0;
repeat
n:=n+1;
write(' Zapis ', n,'. surovinu: '); readln(recept.surovina[n]);writeln();
until n=m;
write(' Zapis postup pripravy: '); readln(recept.postup); writeln();
write(SC,recept);
close(SC); reset(SC);
end;

procedure VYPIS;
begin
m:=10;
gotoxy(5,10);
writeln('Nazev receptu');
gotoxy(40,10);
writeln ('Doba pripravy');
reset(SC);
while not eof(SC) do begin
        m:=m+1;
        read(SC,recept);
        gotoxy(5,m);
        write(recept.nazev);
        gotoxy(40,m);
        write(recept.doba,' min');
        gotoxy(60,m);
        write('..........', recept.strana);
        end;
if eof(SC) then writeln();writeln();
if eof(SC) then writeln('Zmackni libovolnou klavesu pro pokracovani');
if eof(SC) then readkey();
end;

procedure VYBER1;
begin
write('Napiste pozadovanou dobu pripravy (v min): '); readln(t); writeln();
m:=10;
gotoxy(5,10);
writeln('Nazev receptu');
gotoxy(40,10);
writeln ('Doba pripravy');
reset(SC);
while not eof(SC) do begin
        read(SC, recept);
        if t>=(recept.doba) then begin
                m:=m+1;
                gotoxy(5,m);
                write(recept.nazev);
                gotoxy(40,m);
                write(recept.doba, ' min' );
                gotoxy(60,m);
                write('..........', recept.strana); writeln();
        end; end;

writeln();
write('Napis stranu vybraneho receptu: '); readln(v);
clrscr;
reset(SC);
while not eof(SC) do begin
        read(SC, recept);
        if v=(recept.strana) then begin

        writeln(' Nazev: ', recept.nazev);
        writeln(' Doba pripravy: ', recept.doba, ' min');
        m:=(recept.pocetsurovin);
        write(' Suroviny: ');
        for n:=1 to m do begin
        gotoxy(12,2+n); writeln(recept.surovina[n]);
        end; writeln();
        writeln(' Postup: ', recept.postup);
        end; end;

if eof(SC) then writeln();writeln();
if eof(SC) then writeln('Zmackni libovolnou klavesu pro pokracovani');
if eof(SC) then readkey();
end;

[highlight=yellow]procedure SERAZENI1;
var serazeni,poradi: array [1..100] of integer;
    poz1,poz2:boolean;
begin
n:=filesize(SC);
poz1:=true;poz2:=true;
i:=1;
reset(SC);
while not eof(SC) do begin
read(SC, recept);
serazeni[i]:=recept.pocetsurovin;
i:=i+1 end;

j:=0;
i:=j+1;
if serazeni[i]<serazeni[i+1] then begin min1:=serazeni[i]; t:=i; poradi[j+1]:=i end
               else begin min1:=serazeni[i+1]; t:=i+1; poradi[j+1]:=i+1 end;
repeat
i:=i+1;
if serazeni[i]<min1 then begin  min1:=serazeni[i]; t:=i; poradi[j+1]:=i end;
until i=n;
j:=1;
i:=0;

repeat
j:=j+1;
        repeat
        i:=i+1;
        v:=0;
                repeat
                v:=v+1;
                if i=poradi[v] then poz1:=false;
                until (v=j-1)or(poz1=false);
        if poz1=true then begin min2:=serazeni[i]; poradi[j]:=i end;
        until poz1=true;
        writeln(min2);poradi[j]:=i; readln();readln();

        for i:=i+1 to n do begin
   if (min1<serazeni[i])and(serazeni[i]<min2) then begin min2:=serazeni[i];poradi[j]:=i end;
   if (serazeni[i]=min1) then begin
                repeat
                v:=v+1;
                if i=poradi[v] then poz2:=false;
                until (v=j)or(poz2=false);
        if poz2=true then begin min2:=serazeni[i]; poradi[j]:=i end; end;end;

min1:=min2;
t:=poradi[j];
until j=n;


for j:=1 to n do begin
write(poradi[j], ', ') end; writeln();readln();readln();
m:=10;
for j:=1 to n do begin
reset(SC);
while not eof(SC) do begin
        read(SC, recept);
        if poradi[j]=(recept.strana) then begin
                m:=m+1;
                gotoxy(5,m);
                write(j,'. ',recept.nazev);
                gotoxy(40,m);
                write(recept.doba, ' min' );
                gotoxy(60,m);
                write('..........', recept.strana); writeln();
        end; end;end;

writeln();
write('Napis stranu vybraneho receptu: '); readln(v);
clrscr;
reset(SC);
while not eof(SC) do begin
        read(SC, recept);
        if v=(recept.strana) then begin

        writeln(' Nazev: ', recept.nazev);
        writeln(' Doba pripravy: ', recept.doba, ' min');
        m:=(recept.pocetsurovin);
        write(' Suroviny: ');
        for n:=1 to m do begin
        gotoxy(12,2+n); writeln(recept.surovina[n]);
        end; writeln();
        writeln(' Postup: ', recept.postup);
        end; end;

if eof(SC) then writeln();writeln();
if eof(SC) then writeln('Zmackni libovolnou klavesu pro pokracovani');
if eof(SC) then readkey();
end;[/highlight]

procedure SMAZ;
begin
m:=10;
gotoxy(5,10);
writeln('Nazev receptu');
gotoxy(40,10);
writeln ('Doba pripravy');
reset(SC);
while not eof(SC) do begin
        m:=m+1;
        read(SC,recept);
        gotoxy(5,m);
        write(recept.nazev);
        gotoxy(40,m);
        write(recept.doba,' min');
        gotoxy(60,m);
        write('..........', recept.strana);
        end;
        writeln();writeln();


write('Napiste stranu receptu, ktery chcete smazat: '); readln(t);
reset(SC); writeln();
while not eof(SC) do begin
        read(SC, recept);
        if t=(recept.strana) then begin
        writeln(' Nazev: ', recept.nazev);
        writeln(' Doba pripravy: ', recept.doba, ' min');
        m:=(recept.pocetsurovin);
        write(' Suroviny: ');
        for n:=1 to m do begin
        gotoxy(12,15+filesize(SC)+n); writeln(recept.surovina[n]);
        end; writeln();
        writeln(' Postup: ', recept.postup);
        end; end;

writeln('Opravdu chcete tento recept smazat? (A/N) ');
rozhod:=readkey;
if rozhod='a' then begin
    clrscr;
    assign(NC,'tmp.tmp');        {pomocny soubor}
    reset(SC);
    rewrite(NC);

    for i:=1 to filesize(SC) do begin { do pomocneho souboru se prenesou }
     read(SC,recept);                  { vsechny zaznamy, krome toho      }
     if recept.strana=t then continue  { zadaneho }
     else begin recept.strana:=filesize(NC)+1; write(NC,recept) end;end;


    close(SC);
    close(NC);
    rewrite(SC);
    reset(NC);

    for i:=1 to filesize(NC) do begin
     read(NC,recept);       { zaznamy se prenesou zpet do hlavniho souboru }
     write(SC,recept);
    end;

    close(SC);
    close(NC);
    erase(NC);           { pomocny soubor se vymaze }
    repeat until keypressed;
  end; end;



begin //Hlavní program//

clrscr;
assign (SC, 'SEZNAM.DTA') ; {$I-}
reset (SC) ; {$I-}
if IOResult=0 then
begin write('Soubor SC jiz existuje. Zrusit? (A/N)');
rozhod:=readkey;
if rozhod='A' then begin rewrite(SC);
                        close (SC);
                        reset(SC);
                        end;
end
        else begin rewrite(SC);
        close(SC);
        reset(SC);
        end;


repeat
clrscr;
gotoxy(1,2);
writeln('Pridat recept...stiskni klavesu P');
writeln('Vypsat recepty...stiskni klavesu V');
writeln('Vybrat recepty podle doby pripravy...stiskni klavesu T');
writeln('Seradit recepty podle poctu surovin...stiskni klavesu S');
writeln('Seradit recepty podle doby pripravy...stiskni klavesu Z');
writeln('Smazat nektery z receptu v kucharce... stiskni klavesu D');
writeln('Konec programu....stiskni klavesu K');

read(rozhod);
if upcase(rozhod) in ['P','V','T','S','Z','D']
then case upcase(rozhod) of
 'P':PRIDAT;
 'V':VYPIS;
 'T':VYBER1;
 'S':SERAZENI1;
 'Z':SERAZENI2;
 'D':SMAZ;
end

until upcase(rozhod)='K';
end.(*Hlavni program*)


Dodatečně přidáno po 51 vteřinách:
vložil jsem celý program ať vidíte souvislosti, snad se nenaštvete



Reklama
Uživatelský avatar
faraon
Master Level 8.5
Master Level 8.5
Příspěvky: 6795
Registrován: prosinec 10
Pohlaví: Muž

Re: Pascal - třídící algoritmy

Příspěvekod faraon » 17 čer 2019 00:05

Tím lépe, fpc mi to v Linuxu zkompiloval a něco to dělá, akorát při prvním ukončení vyskočil nějaký runtime error, při dalších bězích už ne. S Pascalem jsem pár let nic nedělal, a musím přiznat že jsem z toho dost vyšel, tak to bude trochu trvat, než se tímhle prokoušu.

To seřazení má fyzicky zpřeházet záznamy v souboru, nebo stačí když je vypíše v požadovaném pořadí?
GOTT is REAL, unless declared INTEGER

Petr2000
nováček
Příspěvky: 11
Registrován: červen 19
Pohlaví: Nespecifikováno

Re: Pascal - třídící algoritmy

Příspěvekod Petr2000 » 17 čer 2019 01:04

Stačí, když je vypíše v požadovaném pořadí :shifty:

Uživatelský avatar
Martab
Moderátor / člen HW týmu
Guru Level 13.5
Guru Level 13.5
Příspěvky: 27450
Registrován: březen 11
Pohlaví: Muž

Re: Pascal - třídící algoritmy

Příspěvekod Martab » 17 čer 2019 15:17

Tak nestačí je prostě seřadit a až budeš potřebovat jejich původní pořadí, tak se podívat do toho souboru kde jsou uloženy?
i5-3350P/P8B75-M LX/Kingston DDR3 8GB/GV-N960IXOC/SS-500ET/Seagate VS35.6/Transcend SSD370-128GB/Samsung BX2250 + Dell 1909W
ThinkPad X230 - i7-3520M + Kingston Savage SSD

„Neexistuje důvod, proč by kdokoli chtěl mít doma něco jako počítač"(Ken Olsen)

Neboj se použít SZ a upozornit na své téma ;)

Přehled desktopových socketů a CPU

Uživatelský avatar
faraon
Master Level 8.5
Master Level 8.5
Příspěvky: 6795
Registrován: prosinec 10
Pohlaví: Muž

Re: Pascal - třídící algoritmy

Příspěvekod faraon » 17 čer 2019 22:37

Docela si to komplikuješ tím, že máš celý soubor jenom na disku a nenačítáš ho do paměti. Ten tvůj způsob byl užitečný a používaný v dobách externích sekvenčních pamětí a tunových počítačů s pár kilobajty RAM. To byly časy, kdy kilo paměti také minimálně kilo vážilo ;-)
Obrázek

Takže si nejdřív vyrobíme tabulku indexů - dvě pole, která budou obsahovat počet surovin a číslo stránky každého receptu. Trochu jsem přejmenoval ty tvoje proměnné, již nepotřebné zakomentoval a pár svých přidal:

Kód: Vybrat vše

procedure SERAZENI1;
var {serazeni,poradi} surovin,stranka: array [1..100] of integer;
    {poz1,poz2:boolean;}
    pocet,temp: integer;

Zase zakomentování pár už nepotřebných věcí, a jako první věc projdeme všechny recepty v souboru a potřebné údaje si načteme to těch dvou polí:

Kód: Vybrat vše

begin
{n:=filesize(SC);}
{poz1:=true;poz2:=true;}

i:=1;
reset(SC);
while not eof(SC) do
      begin
      read(SC, recept);
      {serazeni[i]:=recept.pocetsurovin;}
      surovin[i]:=recept.pocetsurovin;
      stranka[i]:=i;
      i:=i+1
      end;
pocet:=i-1;
Ono by ani nebylo potřeba uchovávat celkový počet receptů, stačilo by ta pole procházet až do první nuly (podobně jako při hledání se zarážkou), ale nesmělo by se stát že se zaplní celá! A pomocí for to navíc bude jednodušší, ostatně v Pascalu je tenhle příkaz určený především k tomuhle, proto je dost omezený.

A teď si tu tabulku pěkně seřadíme, podle počtu surovin. Seřazení číselného pole bys měl zvládat, tady je ale malý chyták v tom, že musíš prohazovat nejenom samotné počty v tabulce surovin, ale i k nim příslušící čísla stránek ve druhé tabulce:

Kód: Vybrat vše

(** serazeni poli - zkraceny bubblesort *)
for i:=2 to pocet do
    for j:= pocet downto i do
        if surovin[j]<surovin[j-1] then
           begin
           (** prohozeni poctu surovin *)
           temp:=surovin[j];
           surovin[j]:=surovin[j-1];
           surovin[j-1]:=temp;
           (** prohozeni cisel stranek *)
           temp:=stranka[j];
           stranka[j]:=stranka[j-1];
           stranka[j-1]:=temp;
           end;
Asi bych tomu neměl bubblesort říkat, protože tady se probublává směrem dolů, viz proměnná j. On teda pravý bubblesort byl původně něco trošičku jiného, používal se už v dobách elektromechanických třídiček děrných štítků... Ale princip činnosti je stále stejný.

Data budou před setříděním vypadat třeba takhle (surovin - stránka):
5 - 1
6 - 2
2 - 3

A po setřídění/zpřeházení celých řádků tabulky:
2 - 3
5 - 1
6 - 2

Teď přichází klíčový moment, kde by sekvenční práce se souborem celý program vééélmi zpomalovala. Naštěstí si dnešní moderní operační systémy dokáží disky cachovat, takže celý soubor už je okopírovaný někde v operační paměti a nebude se prohrabávat disk znovu a znovu při každém čtení, jako to bylo kdysi. Spustit to pod MS-DOSem nejlépe na disketě, to by byla muzika :lol:
Pro postupné vypsání receptů ve změněném pořadí je totiž potřeba pokaždé projít celý soubor znovu od začátku a vyhledat příslušný recept s konkrétním číslem stránky... Výhodnější by bylo seekování přímo do libovolného místa souboru, ale to možná jindy.

Kód: Vybrat vše

(** hlavicka vypisu *)
gotoxy(5,10);
writeln('Nazev receptu');
gotoxy(40,10);
writeln ('Pocet surovin');

(** vypsani jednotlivych stranek ze souboru *)
for i:=1 to pocet do
    begin
    (** pokazde to vezmeme od zacatku souboru *)
    reset(SC);
    (** nacteme vsechny stranky az do pozadovane *)
    for j:=1 to stranka[i] do read(SC, recept);
    (** a tu vypiseme na obrazovku *)
    gotoxy(5,i+10);
    write(recept.nazev);
    gotoxy(40,i+10);
    write(recept.pocetsurovin);
    gotoxy(60,i+10);
    write('..........', recept.strana);
    end;

A to je vlastně všechno, nějak se mi nechtělo celý ten tvůj kód studovat jak vlastně funguje, použil jsem to nejjednodušší co mě zrovna napadlo. Takže jsem ho nekomentoval ale rovnou smáznul. Nakonec přijde už jenom ten tvůj výpis vybraného receptu:

Kód: Vybrat vše

(** tady jsem to trochu prorezal asi o 60 radku *)
{...}

(** a dal uz pokracuje tvuj kod *)
writeln;
write('Napis stranu vybraneho receptu: '); readln(v);
clrscr;
reset(SC);
while not eof(SC) do begin
        read(SC, recept);
        if v=(recept.strana) then begin

        writeln(' Nazev: ', recept.nazev);
        writeln(' Doba pripravy: ', recept.doba, ' min');
        m:=(recept.pocetsurovin);
        write(' Suroviny: ');
        for n:=1 to m do begin
        gotoxy(12,2+n); writeln(recept.surovina[n]);
        end; writeln;
        writeln(' Postup: ', recept.postup);
        end; end;

if eof(SC) then writeln;writeln;
if eof(SC) then writeln('Zmackni libovolnou klavesu pro pokracovani');
if eof(SC) then readkey;
end;

To co je v komentářích můžeš klidně vyházet, je to tam jen pro informaci, hlavně ty moje popisy v řádcích začínajících (**. Až přijdeš na to jak to funguje, neměl by být problém to upravit pro řazení podle jakéhokoliv jiného kritéria.
GOTT is REAL, unless declared INTEGER

Petr2000
nováček
Příspěvky: 11
Registrován: červen 19
Pohlaví: Nespecifikováno

Re: Pascal - třídící algoritmy

Příspěvekod Petr2000 » 19 čer 2019 16:14

Faraone, děkuji Ti mnohokráte, nejspíš si mě úplně zachránil. Vůbec mě takový způsob nenapadl.
Jde vidět, že jsem na začátku. A ještě jednou moc děkuji


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Pascal - pomoc s programem
    od Pelda01 » 13 lis 2018 14:07 » v Programování a tvorba webu
    20
    1668
    od faraon
    13 lis 2018 19:30
  • Pascal - načtení ze záznamu
    od Petr2000 » 15 čer 2019 23:27 » v Programování a tvorba webu
    2
    494
    od Petr2000
    16 čer 2019 07:14
  • Pascal - jak vypočítat řadu při diferenciaci
    od Pelda01 » 04 pro 2018 14:50 » v Programování a tvorba webu
    5
    836
    od faraon
    04 pro 2018 20:05
  • Nvidia přináší podporu pro raytracing i pro Pascal a Polaris
    od DesperadoKHY » 20 bře 2019 13:32 » v Vše ostatní (hw)
    2
    442
    od DesperadoKHY
    20 bře 2019 14:09

Zpět na “Programování a tvorba webu”

Kdo je online

Uživatelé prohlížející si toto fórum: CommonCrawl [Bot] a 8 hostů