Ukol v Pascalu – Pascal – Fórum – Programujte.com

Ahojte,

nevite mi prosim nekdo poradit s timto ukolem. Vytvořte ADT Hash tabulka explicitně zřetězenými synonymy, která bude poskytovat následující metody:

procedure HTInit (var Table : tHTable); - Inicializace tabulky s explicitně zřetězenými synonymy.
function HTSearch (var Table : tHTable; Key : tKey; var ukPrvek:tUkPrvek) : boolean; - Vyhledání prvku v TRP Table podle zadaného klíče Key. Pokud je daný prvek nalezen, vrací se funkční hodnota TRUE a ukazatel ItemPtr ukazuje na vyhledaný prvek. Pokud prvek nalezen není, vrací se hodnota FALSE a ukazatel ItemPtr nabývá hodnoty nil. Poznámka: parametr ukPrvek byl přidán z důvodu možné využitelnosti dalšími procedurami - správnější by bylo předávat z funkce pouze najdené data a hodnotu bool, protože ukazatel odhaluje uživateli "vnitřnosti" implementace tohoto ADT.
procedure HTInsert (var Table:tHTable; Key:tKey; Data:tData); - Tato procedura vkládá do tabulky Table položku s klíčem Key a s daty Data. Protože jde o vyhledávací tabulku, nemůže být prvek se stejným klíčem uložen v tabulce více než jedenkrát. Pokud se vkládá prvek, jehož klíč se již v tabulce nachází, aktualizujte jeho datovou část. Využijte dříve vytvořenou funkci ExpSearch. Při vkládání nového prvku do seznamu synonym použijte co nejefektivnější způsob.
function HTRead (var Table:tHTable; Key:tKey; var OutData:tData) : boolean; - Tato funkce zjišťuje hodnotu datové části položky zadané klíčem. Pokud je položka nalezena, vrací funkce hodnotu TRUE a prostřednictvím parametru OutData se předá hodnota datové části nalezené položky. Pokud položka nalezena nebyla, vrací se funkční hodnota FALSE a hodnota OutData není definována.
procedure HTDelete (var Table:tHTable; Key:tKey); - Tato procedura vyjme položku s klíčem Key a s daty Data z tabulky Table. Uvolněnou položku korektně zrušte. Pokud položka s uvedeným klíčem neexistuje, dělejte, jako kdyby se nic nestalo (tj. nedělejte nic).
procedure HTDeleteTable (var Table:tHTable); - Tato procedura zruší všechny položky tabulky, korektně uvolní prostor, který tyto položky zabíraly, a uvede tabulku do počátečního stavu.
Typy jsou definovány takto:

tKey = string[10]; { typ klíče (například čárový kód zboží) }
tData = real; { typ obsahu (například cena zboží) }

{ Datová položka TRP s explicitně řetězenými synonymy }
tHTukPrvek = ^tHTPrvek;

tHTPrvek = record
Key : tKey; { klíč }
Data : tData; { obsah }
Next : tHTukPrvek; { ukazatel na další synonymum }
end;

{ TRP s explicitně zřetězenými synonymy. }
tHTable = array [1..HTSize] of tHTukPrvek;

Co z toho chápeš?
Co z toho nechápeš?
Co přesně potřebuješ?

Když mi vysvětlíš, co to jsou explicitně zřetězená synonyma, tak snad poradím.
Ale celý program za tebe nenapíšu.

Da se rict, ze to mam skoro hotove, akorat mi tam neco haze chybu a nemuzu ji opravit.

program ADThash;

{$APPTYPE CONSOLE}

uses
SysUtils;

const HTSize=17;
type
tKey=string[10];
tData=real;
tHTukPrvek=^tHTPrvek;
tHTPrvek=record
key:tKey;
data:tdata;
ukDalsi:tHTukPrvek;
end;
tHTable=array [0..HTSize] of tHTukPrvek;

procedure HTInit (var Table: tHTable);
var q:integer;
begin
q:=0;
repeat begin Table[q]:=nil;
q:=q+1; end; until q=HTSize+1;
end;

function Rozptyl (var Key:tKey) : integer;
var i : integer;
Vysledek : integer;
begin
Vysledek:=1;
for i:=1 to length(Key) do
begin
Vysledek:=Vysledek+ord(Key[i]);
end;
Rozptyl := (vysledek mod HTSize)+1;
end;


Procedure HTInsert (var Table:tHTable;key:tKey; data:tData);
function rovnost (var pomUk:tHTukPrvek; key:tKey; data:tData):boolean;
var a:integer;
begin
if pomUk<>nil then begin
if pomUk^.key<>key then
rovnost(pomUk.ukDalsi,key,data)
else begin pomUk.data:=data; rovnost:=True; a:=0; end;
end;
if a<>0 then rovnost:=false;
end;

var index:integer;
pomUk:tHTukPrvek;
p:boolean;
begin
index:=rozptyl(key);
pomUk:=Table[index];
if pomUk<>nil then
begin
p:=rovnost(pomUk,key,data);
if p=true then exit;
while pomUk<>nil do
pomUk:=pomUk^.ukDalsi;
end;
if pomUk=nil then new(pomUk);
pomUk^.key:=Key;
pomUk^.data:=data;
pomUk^.ukDalsi:=nil;
Table[index]:=pomUk;

end;

function HTSearch (var Table:tHTable; Key:tKey; var ukPrvek:tHTukPrvek) : boolean;
var pomUk:tHTukPrvek;
begin
pomUk:=Table[Rozptyl (key)];
while pomUk<>nil do begin
if pomUk^.key=key then begin
ukPrvek:=pomUk;
HTSearch:=true;
exit;
end;
pomUk:=pomUk^.ukDalsi;
end; {while}
HTSearch:=false;
ukPrvek:=nil;
end;

procedure HTDelete (var Table:tHTable; Key:tKey);
var pomUk, ukPredchozi:tHTukPrvek;
index:integer;
begin
index:=Rozptyl(key);
pomUk:=Table[Rozptyl (key)];
ukPredchozi:=pomuk;
while pomUk<>nil do begin
if pomUk^.key=Key then begin
if pomUk=ukPredchozi then
Table[index]:=pomUk^.ukdalsi
else
ukPredchozi^.ukDalsi:=pomUk^.ukDalsi;
dispose(pomUk);
exit;
end;
ukPredchozi:=pomUk;
pomUk:=pomUk^.ukDalsi;
end; {while}
end;

function HTRead (var Table:tHTable; Key:tKey; var data:tData) : boolean;
var pomUk:tHTukPrvek;
begin
pomUk:=Table[Rozptyl(key)];
while pomUk<>nil do begin
if pomUk^.key=key then begin
data:=pomUk.data;
HTread:=true;
exit;
end;
pomUk:=pomUk^.ukDalsi;
end; {while}
HTread:=false;
end;

procedure HTDeleteTable (var Table:tHTable);
Procedure smaz(var Prvek:tHTukPrvek);
begin
while Prvek<>nil do begin
smaz(prvek.ukDalsi);
Prvek:=nil;
end;
end;
var i:integer;
begin
i:=0;
while i<>(HTsize+1) do begin
smaz(Table[i]);
Table[i]:=nil;
i:=i+1;
end; {while}
end;

Procedure print(var t:tHtable);
var
i:integer;
pomUk:tHTukPrvek;
begin
for I := 0 to HTSize do begin
pomUk:=t[i];
if pomUk<>nil then begin
while PomUk<>nil do begin
Writeln('key=',pomUk^.key);
writeln('data=',pomUk^.data:8:3);
pomUk:=pomUk^.ukDalsi;
end;
end;
end;
end;
var
c:char;
HashT:tHTable;
data:real;
key:tKey;
hledany:tHTukPrvek;
b:boolean;
begin
c:='m';
repeat
case c of
'm':begin writeln(' ***ADT hash tabulka explicitne zretezenymi synonymi***');
writeln('Zadejte i pro inicializaci seznamu');
writeln('Zadejte v pro vlozeni prvku do seznamu');
writeln('Zadejte o pro vypsani hash tabulky');
writeln('Zadejte h pro hledani podle klice');
writeln('Zadejte r pro nactení dat podle klice');
Writeln('Zadejte d pro smazani prvku podle klice');
Writeln('Zadejte x pro smazani cele hash tabulky');
writeln('Zadejte m pro menu');
writeln('Zadejte k pro konec');
end;
'i':begin HTinit(HashT); writeln('Seznam inicializovan.'); end;
'v':begin writeln('Zadejte data urcena k vlozeni.'); readln(data);
write('Zadejte podle jakeho klice se maji data ulozit.');
repeat writeln(', musí byt 10ti mistny'); readln(key);
until (length(key)=10);
HTInsert(HashT,key,data);
end;
'o':begin print(hashT); end;
'h':begin write('Zadejte podle jakeho klice se maji data hledat.');
repeat writeln(', musí byt 10ti mistny.'); readln(key);
until (length(key)=10);
b:=HTsearch(hashT,key,hledany);
if b=true then begin
writeln('Podle klice ',key);
writeln('Byla nalezena data: ',hledany.data:8:3)
end else writeln('Nenalezeno podle klice: ',key);
end;
'r':begin write('Zadejte podle jakeho klice se maji data hledat.');
repeat writeln(', musí byt 10ti mistny.'); readln(key);
until (length(key)=10);
b:=HTRead(hashT,key,data);
if b=true then begin
writeln('Podle klice ',key);
writeln('Byla nalezena data: ',data:8:3)
end else writeln('Nenalezeno podle klice: ',key);
end;
'd':begin write('Zadejte podle jakeho klice se maji data mazat.');
repeat writeln(', musí byt 10ti mistny.'); readln(key);
until (length(key)=10);
HTdelete(hashT,key);
end;
'x':begin HTDeleteTable(hashT); writeln('Vse bylo smazano.'); end;
else begin writeln('Nespravny znak.'); end;
end;
writeln;
writeln('Zvolte moznost, kterou chcete provest.');
readln(c);
until (c='k');
end.

Jakej dement vyblil takovýhle zadání? Tvůj učitel?
Já sice nemám žádné programátorské vzdělání, ale přesto si troufnu tvrdit, že tohle nemá s hešováním nic společného. Vždyť to je úplně obyčejný spojový seznam! Hešování je třeba tvorba CRC kontrolních součtů. Tedy procházení dlouhého textu, pro který se vygeneruje krátký výcuc - tzv. heš - třeba onen CRC součet, který vytvářejí komprimační programy, které tím ověřují, jestli nedošlo k porušení zakódovaných dat.
Pro jeden text lze stvořit právě jeden heš. Naopak jeden heš může pocházet z více možných zdrojových textů. Pravděpodobnost záměny závisí na hešovací funkci, ale bývá extrémně malá.
Např. kdyby hešovací funkce spočívala v tom, že heš=prvních 100 bajtů textu, tak by záměna nastala u všech textů se shodnými prvními 100 bajty. Kdyby heš=součet ASCII hodnot celého textu+součet ASCII hodnot lichých znaků+součet ASCII sudých znaků+... tak je pravděpodobnost záměny mnohem menší, a o to jde.

Tvoje zadání žádnou hešovací funkci neobsahuje, tudíž je to hrozný blábol. "Explicitně zřetězená synonyma" - ???, co tím chtěl básník říci?
Každopádně - tvůj program je v podstatě správně, jenom tam na pár místech chyběl znak "^" - symbol odkazu. Správně je to tedy:

program ADThash;



{$APPTYPE CONSOLE}



uses

  SysUtils;



const HTSize=17;

type

      tKey=string[10];

      tData=real;

      tHTukPrvek=^tHTPrvek;

      tHTPrvek=record

        key:tKey;

        data:tdata;

        ukDalsi:tHTukPrvek;

      end;

     tHTable=array [0..HTSize] of tHTukPrvek;



procedure HTInit (var Table: tHTable);

var q:integer;

begin

q:=0;

   repeat begin Table[q]:=nil;

                q:=q+1; end; until q=HTSize+1;

end;



function Rozptyl (var Key:tKey) : integer;

var i : integer;

Vysledek : integer;

begin

Vysledek:=1;

for i:=1 to length(Key) do

begin

Vysledek:=Vysledek+ord(Key[i]);

end;

Rozptyl := (vysledek mod HTSize)+1;

end;





Procedure HTInsert (var Table:tHTable;key:tKey; data:tData);

function rovnost (var pomUk:tHTukPrvek; key:tKey; data:tData):boolean;

var a:integer;

begin

if pomUk<>nil then begin

if pomUk^.key<>key then

rovnost(pomUk^.ukDalsi,key,data)

else begin pomUk^.data:=data; rovnost:=True; a:=0; end;

end;

if a<>0 then rovnost:=false;

end;



var index:integer;

    pomUk:tHTukPrvek;

    p:boolean;

begin

index:=rozptyl(key);

pomUk:=Table[index];

if pomUk<>nil then

  begin

  p:=rovnost(pomUk,key,data);

  if p=true then exit;

  while pomUk<>nil do

    pomUk:=pomUk^.ukDalsi;

end;

if pomUk=nil then new(pomUk);

  pomUk^.key:=Key;

  pomUk^.data:=data;

  pomUk^.ukDalsi:=nil;

  Table[index]:=pomUk;



end;



function HTSearch (var Table:tHTable; Key:tKey; var ukPrvek:tHTukPrvek) : boolean;

var pomUk:tHTukPrvek;

begin

    pomUk:=Table[Rozptyl (key)];

    while pomUk<>nil do begin

        if pomUk^.key=key then begin

            ukPrvek:=pomUk;

            HTSearch:=true;

            exit;

        end;

        pomUk:=pomUk^.ukDalsi;

    end;   {while}

      HTSearch:=false;

      ukPrvek:=nil;

end;



procedure HTDelete (var Table:tHTable; Key:tKey);

var pomUk, ukPredchozi:tHTukPrvek;

    index:integer;

begin

  index:=Rozptyl(key);

  pomUk:=Table[Rozptyl (key)];

  ukPredchozi:=pomuk;

  while pomUk<>nil do begin

        if pomUk^.key=Key then begin

         if pomUk=ukPredchozi then

              Table[index]:=pomUk^.ukdalsi

              else

           ukPredchozi^.ukDalsi:=pomUk^.ukDalsi;

           dispose(pomUk);

            exit;

        end;

        ukPredchozi:=pomUk;

        pomUk:=pomUk^.ukDalsi;

    end;   {while}

end;



function HTRead (var Table:tHTable; Key:tKey; var data:tData) : boolean;

var pomUk:tHTukPrvek;

begin

    pomUk:=Table[Rozptyl(key)];

    while pomUk<>nil do begin

        if pomUk^.key=key then begin

            data:=pomUk^.data;

            HTread:=true;

            exit;

        end;

        pomUk:=pomUk^.ukDalsi;

    end;   {while}

      HTread:=false;

end;



procedure HTDeleteTable (var Table:tHTable);

Procedure smaz(var Prvek:tHTukPrvek);

begin

while Prvek<>nil do begin

smaz(prvek^.ukDalsi);

Prvek:=nil;

end;

end;

var i:integer;

begin

i:=0;

  while i<>(HTsize+1) do begin

     smaz(Table[i]);

     Table[i]:=nil;

     i:=i+1;

  end; {while}

end;



Procedure print(var t:tHtable);

var

i:integer;

pomUk:tHTukPrvek;

begin

  for I := 0 to HTSize do   begin

    pomUk:=t[i];

    if pomUk<>nil then   begin

    while PomUk<>nil do begin

        Writeln('key=',pomUk^.key);

        writeln('data=',pomUk^.data:8:3);

        pomUk:=pomUk^.ukDalsi;

    end;

    end;

  end;

end;

var

c:char;

HashT:tHTable;

data:real;

key:tKey;

hledany:tHTukPrvek;

b:boolean;

begin

c:='m';

repeat

case c of

  'm':begin writeln('       ***ADT hash tabulka explicitne zretezenymi synonymi***');

      writeln('Zadejte i pro inicializaci seznamu');

      writeln('Zadejte v pro vlozeni prvku do seznamu');

      writeln('Zadejte o pro vypsani hash tabulky');

      writeln('Zadejte h pro hledani podle klice');

      writeln('Zadejte r pro nactení dat podle klice');

      Writeln('Zadejte d pro smazani prvku podle klice');

      Writeln('Zadejte x pro smazani cele hash tabulky');

      writeln('Zadejte m pro menu');

      writeln('Zadejte k pro konec');

              end;

  'i':begin HTinit(HashT); writeln('Seznam inicializovan.'); end;

  'v':begin writeln('Zadejte data urcena k vlozeni.'); readln(data);

      write('Zadejte podle jakeho klice se maji data ulozit.');

      repeat writeln(', musí byt 10ti mistny'); readln(key);

      until (length(key)=10);

      HTInsert(HashT,key,data);

      end;

  'o':begin print(hashT); end;

  'h':begin write('Zadejte podle jakeho klice se maji data hledat.');

      repeat writeln(', musí byt 10ti mistny.'); readln(key);

      until (length(key)=10);

      b:=HTsearch(hashT,key,hledany);

      if b=true then begin

      writeln('Podle klice ',key);

      writeln('Byla nalezena data: ',hledany^.data:8:3)

      end else writeln('Nenalezeno podle klice: ',key);

      end;

  'r':begin write('Zadejte podle jakeho klice se maji data hledat.');

      repeat writeln(', musí byt 10ti mistny.'); readln(key);

      until (length(key)=10);

      b:=HTRead(hashT,key,data);

      if b=true then begin

      writeln('Podle klice ',key);

      writeln('Byla nalezena data: ',data:8:3)

      end else writeln('Nenalezeno podle klice: ',key);

      end;

  'd':begin write('Zadejte podle jakeho klice se maji data mazat.');

      repeat writeln(', musí byt 10ti mistny.'); readln(key);

      until (length(key)=10);

      HTdelete(hashT,key);

      end;

  'x':begin HTDeleteTable(hashT); writeln('Vse bylo smazano.'); end;

      else begin writeln('Nespravny znak.'); end;

end;

writeln;

writeln('Zvolte moznost, kterou chcete provest.');

readln(c);

until (c='k');

end.

ppolozka = ^tpolozka;

tpolozka = record

cena:real;

kod_zbozi:longint;

popis:string;

end;



pseznam = ^tseznam;

tseznam = record

data:pointer; {bude ukazovat na typ ppolozka}

dalsi:pseznam;

end;

Osobne to radeji nekomentuji, zvlaste jeho osobu. Jeste jedna chutovka, zde je jeji zadani:

Hash tabulka s implicitně zřetězenými synonymy.

U tabulky s implicitně zřetězenými synonymy je součástí každé položky tabulky informace o využití položky - Status, která v případě volné položky nabývá hodnoty FREE. Pokud položka tabulky obsahuje platná data, nabývá Status hodnoty FULL. Položka tabulky se může nacházet ještě ve třetím stavu, BLIND. Do tohoto stavu se dostane v okamžiku, kdy obsah položky zrušíme (IHTDelete). Pokud bychom v tomto případě nastavili stav FREE, mohli bychom přerušit implicitní zřetězení synonym, protože položka ve stavu FREE říká, že se zde dosud nikdo nepokusil dané synonymum zapsat, a že tedy neexistuje žádné synonymum o kousek dál. Položka ve stavu BLIND tedy například funkci IHTSearch dává najevo, že se má pokračovat v hledání.

Datové typy jsou definovány následovně:

type
tIKey = string[10]; { typ klíče (například čárový kód zboží) }
tIData = real; { typ obsahu (například cena zboží) }
tIStatus = (FREE,FULL,BLIND); { stav položky v TRP s impl. z. s. }

{ Datová položka TRP s implicitně řetězenými synonymy }
tIHTItem = record
Key : tIKey; { klíč }
Data : tIData; { obsah }
Status : tIStatus; { stav položky }
end;

{ TRP s implicitně zřetězenými synonymy. }
tIHTable = array [1..IHTMaxSize] of tIHTItem;

V tomto úkolu se jedná o variantu hash tabulky se dvěmi rozptylovacími funkcemi, jejichž implementace bude např. následující:

function IRozptyl (var Key:tIKey) : integer;
var
i : integer;
Result : integer;
begin
Result:=1;
for i:=1 to length(Key) do Result:=Result+ord(Key[i]);
IRozptyl := (Result mod IHTSize)+1;
end;


function IRozptyl2 (var Key:tIKey) : integer;
var
i : integer;
Result : integer;
begin
Result:=1;
for i:=1 to length(Key) do
Result := Result+ord(Key[i])+1;
IRozptyl2 := (Result mod (IHTSize-1))+1;
end;


IRozptyl je rozptylovací funkce, jejímž úkolem je zpracovat zadaný klíč a přidělit mu index v rozmezí 1..HTSize. V ideálním případě by mělo dojít k rovnoměrnému rozptýlení těchto klíčů po celé tabulce.

IRozptyl2 je rozptylovací funkce pro výpočet inkrementu - jejím úkolem je zpracovat zadaný klíč a přidělit mu hodnotu v intervalu 1..IHTSize-1.

U všech procedur využívejte jako první rozptylovou funkci IRozptyl. Druhá rozptylovací funkce, IRozptyl2, se používá pro výpočet inkrementu (přírůstku) v případě, že položka s indexem Rozptyl je již obsazena.

Pozor! Počet prvků tabulky (konstanta IHTSize) musí být prvočíslo!

Implementujte následující metody:

procedure IHTInit (var Table:tIHTable);
Inicializace tabulky s implicitně zřetězenými synonymy.
procedure IHTInsert (var Table:tIHTable; Key:tIKey; Data:tIData);
Tato procedura vkládá do tabulky Table položku s klíčem Key a s daty Data. Protože jde o vyhledávací tabulku, nemůže být prvek se stejným klíčem uložen v tabulce více než jedenkrát. Pokud se vkládá prvek, jehož klíč se již v tabulce nachází, aktualizujte jeho datovou část.
Pro určení počátku implicitně zřetězeného seznamu synonym použijte rozptylovací funkci IRozptyl, pro výpočet přírůstku (používaného pokud je položka na indexu IDisperse již obsazena) použijte funkci IRozptyl2.
Tabulku implementujte tak, aby mohla být zcela obsazena (může v ní být uloženo IHTSize prvků). Posunujeme-li se v poli s přírůstkem 1, pak po indexu IHTSize následuje index 1. Položku lze uložit do záznamu, který je ve stavu FREE nebo BLIND.
Pokud je tabulka plná, volejte při pokusu o další vkládání funkci ErrorInsert. Při implementaci NEVYUŽÍVEJTE funkci IHTSearch.
function IHTSearch (var Table:tIHTable; Key:tIKey; var Index:integer) : boolean;
TRP s implicitně zřetězenými synonymy s dvojí rozptylovací funkcí. Vyhledání prvku v TRP Table podle zadaného klíče Key. Pokud je daný prvek nalezen, vrací se funkční hodnota TRUE a proměnná Index obsahuje index vyhledaného prvku. Pokud prvek nalezen není, vrací se hodnota FALSE a proměnná Index nabývá nedefinované hodnoty. Při vyhledávání mohou nastat v zásadě dvě situace, při kterých ihned ukončíme(neúspěšné) vyhledávání: narazili jsme na položku ve stavu FREE nebo jsme již zkontrolovali všechny prvky tabulky. V ostatních případech musíme testovat, zda se jedná o hledanou položku, či nikoliv. Pro tento účel použijte níže definovanou funkci IsFound, která vrací hodnotu true v případě, kdy na zadané pozici leží platný prvek, jehož klíč se shoduje se zadaným klíčem. Vedlejším efektem této funkce je zvýšení globálního počítadla IHTcmpcnt, které při ukončení funkce IHTSearch vlastně udává, kolik porovnání jsme potřebovali k vyhledání (úspěšnému, či neúspěšnému) prvku s daným klíčem. Hodnotu IHTcmpcnt NENASTAVUJTE SAMI a ani tuto proměnnou jinak
nevyužívejte - chovejte se k ní, jako kdyby neexistovala. Využívá se při statistickém vyhodnocování úspěšnosti vyhledávání.
Poznámka: parametr Index byl přidán z důvodu možné využitelnosti dalšími procedurami. Pokud by prvořadým cílem byla abstraktnost datového typu TRP, pak by tento parametr nebyl vhodný, protože uživateli odhaluje způsob implementace tabulky a umožňuje nekorektní zásahy do její struktury (tj. zásahy, kdy nejsou využity navržené procedury pro přístup k tabulce).
function IHTRead (var Table:tIHTable; Key:tIKey; var OutData:tIData) : boolean;
Tato funkce zjišťuje hodnotu datové části položky zadané klíčem. Pokud je položka nalezena, vrací funkce hodnotu TRUE a prostřednictvím parametru OutData se předá hodnota datové části nalezené položky. Pokud položka nalezena nebyla, vrací se funkční hodnota FALSE a hodnota OutData není definována. Využijte dříve vytvořenou funkci IHTSearch.
procedure IHTDelete (var Table:tIHTable; Key:tIKey);
Tato procedura vyjme položku s klíčem Key a s daty Data z tabulky Table. Prakticky to znamená, že uvolňovanou položku uvedeme do stavu BLIND. Pokud položka s uvedeným klíčem neexistuje, dělejte, jako kdyby se nic nestalo (tj. nedělejte nic).

Zde je hotovy program, ale opet mi tam neco nefrci.

program ADThashimplicitni;

{$APPTYPE CONSOLE}

uses
SysUtils;
const IHTMaxSize=17;
type
tIKey = string[10]; { typ klíče}
tIData = real; { typ obsahu}
tIStatus = (FREE,FULL,BLIND); { stav poloky v TRP s impl.z.s. }

{ Datová poloka TRP s implicitně řetězenými synonymy }
tIHTItem = record
Key:tIKey; { klíč }
Data:tIData; { obsah }
Status:tIStatus; { stav poloky }
end;

{ TRP s implicitně zřetězenými synonymy. }
tIHTable = array [1..IHTMaxSize] of tIHTItem;

procedure HTInit (var Table:tIHTable);
var i:integer;
begin
for I := 1 to IHTMaxSize do Table[i].status:=Free;
end;

function IRozptyl (var Key:tIKey) : integer;
var
i: integer;
vysledek : integer;
begin
vysledek:=1;
for i:=1 to length(Key) do
vysledek:=vysledek+ord(Key[i]);
IRozptyl := (vysledek mod IHTMaxSize+1);
end;

function IRozptyl2 (var Key:tIKey) : integer;
var
i: integer;
vysledek : integer;
begin
vysledek:=1;
for i:=1 to length(Key) do
vysledek := vysledek+ord(Key[i])+1;
IRozptyl2 := (vysledek mod (IHTMaxSize-1))+1;
end;

procedure HTInsert (var Table:tIHTable; key:tIKey; data:tIData);
var index,i,p:integer;
begin
index:=Irozptyl(key);
p:=Irozptyl2(key);
i:=index;
while Table[i].status<>Free do begin
if Table[i].Key=key then
begin
Table[i].Data:=data;
exit;
end;
if table[i].Status=blind then begin
Table[i].key:=key;
table[i].data:=data;
table[i].status:=Full;
exit;
end;
i:=(i+p);
if i>(IHTmaxsize+1) then begin
i:=(i mod IHTmaxsize);
if i=index then begin writeln('zasobnik je plny'); exit; end;
end;
end;

Table[i].key:=key;
table[i].data:=data;
table[i].status:=Full;
end;

function IHTSearch (var Table:tIHTable; Key:tIKey; var Index:integer) : boolean;
var ind,i,p:integer;
begin
ind:=Irozptyl(key);
p:=Irozptyl2(key);
i:=ind;
while Table[i].status<>free do begin
if Table[i].Key=key then
begin
index:=i;
IHTsearch:=true;
exit;
end;
i:=(i+p);
if i>(IHTmaxsize+1) then begin
i:=(i mod IHTmaxsize);
if i=ind then begin writeln('nenalezeno'); IHTsearch:=false; exit; end;
end;
end;
end;

function IHTRead (var Table:tIHTable; Key:tIKey; var OutData:tIData) : boolean;
var ind,i,p:integer;
begin
ind:=Irozptyl(key);
p:=Irozptyl2(key);
i:=ind;
while Table[i].status<>Free do begin
if Table[i].Key=key then
begin
OutData:=Table[i].Data;
IHTread:=true;
exit;
end;
i:=(i+p);
if i>(IHTmaxsize+1) then begin
i:=(i mod IHTmaxsize);
if i=ind then begin writeln('nenalezeno'); IHTread:=false; exit; end;
end;
end;
end;

procedure IHTDelete (var Table:tIHTable; Key:tIKey);
var ind,i,p:integer;
begin
ind:=Irozptyl(key);
p:=Irozptyl2(key);
i:=ind;
while Table[i].status<>Free do begin
if Table[i].Key=key then
begin
Table[i].Key:='';
Table[i].Status:=Blind;
exit;
end;
i:=(i+p);
if i>(IHTmaxsize+1) then begin
i:=(i mod IHTmaxsize);
if i=ind then begin exit; end;
end;
end;
end;

procedure Print (var Table:tIHTable);
var i:integer;
status:string;
begin
for I := 1 to IHTmaxsize do begin
Writeln('pozice: ',i);
Writeln('key=',Table[i].key);
writeln('data=',Table[i].data:8:3);
if Table[i].Status=free then Status:='free';
if Table[i].Status=full then Status:='full';
if Table[i].Status=blind then Status:='blind';
writeln('status=',Status);
end;

end;

var
index:integer;
c:char;
HashT:tIHTable;
data:tIData;
key:tIKey;
b:boolean;
begin
c:='m';
repeat
case c of
'm':begin writeln(' ***ADT hash tabulka explicitne zretezenymi synonymi***');
writeln;
writeln('Zadejte i pro inicializaci seznamu.');
writeln('Zadejte v pro vlozeni prvku do seznamu.');
writeln('Zadejte h pro hledani dat podle klice.');
writeln('Zadejte r pro vypsani dat podle klice.');
writeln('Zadejte d pro mazani dat.');
writeln('Zadejte o pro vypsani hash tabulky.');
writeln('Zadejte m pro menu.');
writeln('Zadejte k pro ukonceni pgmu.');
end;
'i':begin HTinit(HashT); writeln('Seznam inicializovan.'); end;
'v':begin writeln('Zadejte data urcena k vlozeni.'); readln(data);
write('Zadejte podle jakeho klice se maji data ulozit.');
repeat writeln(', musí byt 10ti mistny.'); readln(key);
until (length(key)=10);
HTInsert(HashT,key,data);
end;
'h':begin write('Zadejte podle jakeho klice se maji data hledat.');
repeat writeln(', musí byt 10ti mistny.'); readln(key);
until (length(key)=10);
b:=IHTsearch(hashT,key,index);
if b=true then begin
writeln('Podle klice ',key);
writeln('Na pozici: ',index);
writeln('Byla nalezena data: ',hashT[index].Data:8:3)
end else writeln('Nenalezeno podle klice: ',key);
end;
'r':begin write('Zadejte podle jakeho klice se maji data hledat.');
repeat writeln(', musí byt 10ti mistny.'); readln(key);
until (length(key)=10);
b:=IHTread(hashT,key,data);
if b=true then begin
writeln('Podle klice ',key);
writeln('Byla nalezena data: ',Data:8:3)
end else writeln('Nenalezeno podle klice: ',key);
end;
'd':begin write('Zadejte podle jakeho klice se maji data smazat.');
repeat writeln(', musí byt 10ti mistny.'); readln(key);
until (length(key)=10);
IHTdelete(hashT,key);
end;
'o':begin print(hashT); end;
else begin writeln('Nespravny znak.'); end;
end;
writeln;
writeln('Zvolte moznost,kterou chcete provest.');
readln(c);
until (c='k');
end.

Nevite mi jeste pomoct s timto ukolem: vytvořte algoritmus pro vyhodnocování aritmetických výrazů, které jsou zapsány v notaci postfix.
Nemusíte přitom vyhodnocovat víceznakové operandy (stačí hodnoty od 0..9).

tady je sablona pro jazyk C:
//Vyhodnocování Postfixových výrazù
//Varianta s vyuzitim zasobniku (staticke pole float)

#include <stdio.h>
#include <conio.h>

////////////////////////////////////
// Zasobnik
struct tStack
{
float data[100]; //data ulozena v zasobniku
int top; //index vrcholu zasobniku
};

//inicializace
void StackInit(tStack& s)
{
s.top = -1; //-1 = zasobnik je prazdny
}

//test na prázdnost zásobníku
bool StackEmpty(tStack& s)
{
//chybí !!!
}

//pøeètení vrcholu zásobníku
float Top(tStack& s)
{
//chybí !!!
}

//pøeètení a odstranìní vrcholu zásobníku
float Pop(tStack& s)
{
//chybí !!!
}


//vlo�ení dat do zásobníku
void Push(tStack& s, float d)
{
//chybí !!!
}

//vraci pocet prvku v zasobniku
int Count(tStack& s)
{
return s.top+1;
}


/////////////////////////////////////////////////////////////////////

int main()
{
int znak;
tStack zasobnik;
StackInit(zasobnik);

printf("\nVyhodnocovani Postfixovych vyrazu");
printf("\n\nZadej vyraz: ");
while(1)
{
znak = getche();
if( znak >= '0' && znak <= '9' )
Push(zasobnik, (float)(znak-'0') );
//úkol



if( znak == 13 ) //kod klavesy Enter
break;
}


printf("\n\nLibovolnou klavesou ukoncete program");
getch();
return 0;
}

Ahá, už začínám pomalu chápat, o co jde :smile1:

Explicitně zřetězená synonyma:
- Pomocí hashovací funkce (zde Rozptyl) si z dat, která chceme vložit, vypočítáme index.
- Najdeme v tabulce buňku s tímto indexem.
- Data vložíme na konec spojového seznamu, který vychází z této buňky (takže jestli má víc hodnot stejný hash, budou se v jedné buňce řadit za sebe).

Implicitně zřetězená synonyma:
- Pomocí hashovací funkce (zde iRozptyl) si z dat, která chceme vložit, vypočítáme index.
- Najdeme v tabulce buňku s tímto indexem.
- Pokud je prázdná, vložíme data sem a končíme.
- Pokud prázdná není, posuneme se v tabulce o pár buněk dál (o kolik, to řekne funkce irozptyl2); pokud přejedeme konec tabulky, vracíme se zase někam na začátek. Jakmile najdeme volné místo, data tam vložíme a konec.
- Jestli jsme volné místo nenašli, tak asi nelze vkládát a konec.

Status blind tam máme proto, že kdybychom tam při vymazání té buňky dali free, tak by se přerušil ten řetěz "když tady není místo, posunu se dál". Čili blind se při ukládání bere jako volná položka, ale při hledání dat jako obsazená.

Tak, tím jsem si to (doufám) ujasnil a teď k tomu druhému programu.
Máš tam strašně prasácky rozházené beginy a endy, takže dá strašnou práci rozluštit, který ke kterému patří. A vůbec neručím za to, že jsem to rozluštil správně.
Tyhle čtyři řádky za htinsertem asi k ničemu nepatří, smaž je:
Table[i].key:=key;
table[i].data:=data;
table[i].status:=Full;
end;
Zbytek by snad měl být v pořádku.
Nevím, jestli to posouvání o hodnotu irozptyl2 opravdu vyjde tak, že postupně projdeme celou tabulku, ale to asi zajišťuje ten prvočíselný počet buněk, že jo?

Jestli tam pořád "něco nefrčí", tak zkus upřesnit co.

DIKY MOC, uz to frci jak ma!!!