(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)
(*  Soubor: MNOZINY.PAS                                                    *)
(*  Obsah: jednotka pro praci s mnozinami ve forme dynamickych poli        *)
(*         (pri kazde prilezitosti meni velikost pole, takze je to dost    *)
(*         slozite)                                                        *)
(*  Posledni uprava: podzim 2004                                           *)
(*  Autor: Mircosoft                                                       *)
(*  Pro kompilaci: nic                                                     *)
(*  Pro spusteni: nic                                                      *)
(*  Upozorneni: tyto zdrojove kody pouzivate na vlastni nebezpeci          *)
(*   !!!! Je chyba v zadani, takze se nedivte, ze je to uplna kravina !!!! *)
(*     Jo, btw, za nic nerucim. Treba to ani poradne nebude fungovat.      *)
(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)
Unit Mnoziny;

interface

const MaxPrvku=65535;{samozrejme jen pro prvky o velikosti 1 byte, jinak
                      prizpusobte podle potreby}

{Z definice mnoziny (soubor prvku, z nichz zadne dva nejsou stejne) a toho,
ze prvky maji byt typu byte, vyplyva, ze do takove mnoziny muzeme ulozit
maximalne 256 prvku. Proc? Protoze existuje jen 256 (0..255) ruznych hodnot,
kterych muze typ byte nabyvat (a stejne tak char nebo shortint).
Takze cely potencial, ktery muzeme pouzitim dynamickeho pole
dosahnout, vyuzijeme sotva z jedne 256tiny. Kdybychom delali prvky typu
integer nebo word (2 byty), uz by se pole vyuzilo cele, ale uz by to
neodpovidalo zadani.
P.S.: Tohle musite ucitelum vysvetlit, az se budou divit, ze do te mnoziny
nemuzou nacpat vic nez 256 ruznych 1-bytovych prvku: je to chyba zadani, ne
programatora!}

{a dalsi chyba zadani byl pozadavek na vytvoreni mnoziny s X prvky a jejich
vynulovani - to by bylo opet v rozporu s definici mnoziny. Viz dale...}

type
{pro vytvoreni dynamickeho pole:}
pole = array[1..65535] of byte;{sablona, aby bylo na co ukazovat.
  Od jednicky misto od nuly se zacina proto, ze se s tim pak bude lip pocitat}
UkNaPole = ^pole;{protoze chceme pole vytvaret dynamicky, tak potrebujeme nejaky ukazatel, ze ano...}

mnozina = record{vlastni mnozina:}
          PocetPrvku:word;
          data:uknapole; {ukazatel na pole, ne fyzicke pole. Proto pozor pri manipulaci.}
          end;

procedure VytvorMnozinu(var M:mnozina);
{vynuluje promennou PocetPrvku. POUZIVAT JEN NA PRAZDNE MNOZINY!!! (tedy
hlavne na zacatku programu, kdy hodnota PocetPrvku neni definovana a jeste
neni alokovana zadna pamet pro data)
PROSTE TO POUZIJ NA KAZDOU MNOZINU DRIV NEZ JI POPRVE POUZIJES.}

{Neni to sice presne podle zadani, ale nemuzu preci vytvorit mnozinu
s X prvky, ktere by byly vsechny nulove. To by to pak vubec nebyla mnozina.}

procedure VyprazdniMnozinu(var M:mnozina);
{odstrani z mnoziny vsechny prvky, tj. uvolni pamet. POUZIVAT JEN NA MNOZINY,
KTERE BUD NEJSOU PRAZDNE, NEBO KTERE JSOU PRAZDNE A MAJI POCETPRVKU = 0 !!!
(tedy nikdy ne na prazdnou mnozinu, ve ktere je nejakym nedopatrenim
PocetPrvku nenulovy)}

{opet - nemuzu vynulovat vsechny prvky mnoziny a nevymazat je, to by pak
nebyla mnozina, ale pole}

procedure PridejPrvek(var M:mnozina; NovyPrvek:byte);
{prida do mnoziny M prvek NovyPrvek. Stara se o prislusnou alokaci pameti
a podobne veci.}
procedure VymazPrvek(var M:mnozina; Ktery:byte);
{Vymaze z mnoziny M prvek Ktery. Stara se o prislusne uvolneni pameti apod.}
function JeVMnozine(Prvek:byte; M:mnozina):boolean;
{zjisti, jestli je prvek Prvek v mnozine M}
procedure OdectiMnozinu(var M1:mnozina; M2:mnozina);
{od mnoziny M1 odecte mnozinu M2, tj. vyjme z ni vsechny prvky, ktere najde
i v mnozine M2}
function JsouStejne(M1,M2:mnozina):boolean;
{zjisti, jestli jsou M1 a M2 shodne}
procedure Sjednoceni(M1,M2:mnozina; var vysledek:mnozina);
{sjednoceni dvou mnozin}
procedure Prunik(M1,M2:mnozina; var vysledek:mnozina);
{prunik dvou mnozin}

implementation

procedure VytvorMnozinu(var M:mnozina);
Begin
M.pocetprvku:=0;{aby tam na zacatku nebyla nejaka kravina}
End;{VytvorMnozinu}

procedure VyprazdniMnozinu(var M:mnozina);
Begin
with M do begin
          if pocetprvku>0 then{kdyz mnozina neni prazdna...}
           freemem(data,pocetprvku);{...tak uvolnime vsechnu pamet}
          pocetprvku:=0;{a zapiseme si, ze mnozina uz prazdna je}
          end;
End;{VyprazdniMnozinu}

procedure PridejPrvek(var M:mnozina; NovyPrvek:byte);
const pridat:boolean=true;
{bacha na definici mnoziny: kazdy prvek v ni muze byt jenom jednou. Takze
kdyz zkousime vlozit prvek, ktery uz v ni je, tak se vlozit nesmi}
var i:word;
    pomocna:uknapole;{pomocne pole pro vytvoreni nove (vetsi) mnoziny}
Begin
{if M.pocetprvku<maxprvku then}{tahle kontrola je pri typu prvku byte
                         zbytecna, protoze pole nemuzeme nikdy cele zaplnit}
with M do
 begin
 if pocetprvku>0 then{kdyby byla mnozina prazdna, tak pridavat urcite budeme}
                  for i:=1 to pocetprvku do if data^[i]=novyprvek then pridat:=false;
                 {projdeme puvodni mnozinu a jestli v ni ten novy prvek uz je, tak si rekneme, ze nic pridavat nebudeme}
 if pridat then begin
                getmem(pomocna,pocetprvku+1);{vytvorime novou mnozinu o 1 prvek vetsi}
                    {Pozor: neni mozne alokovanou pamet proste o prvek zvetsit, musime alokovat uplne novou a zrusit tu starou}
                if pocetprvku>1 then begin{jestli v te puvodni neco bylo, tak:}
                                     move(data^,pomocna^,pocetprvku);{prekopirujeme do ni tu puvodni}
                                     freemem(data,pocetprvku);{puvodni mnozinu zrusime}
                                     end;
                data:=pomocna;{a jeji ukazatel presmerujeme na tu novou}
                inc(pocetprvku);{zapiseme si, ze mame o prvek vic}
                data^[pocetprvku]:=novyprvek;{a na konec mnoziny vlozime novy prvek}
                    {mozna by se hodilo prvky v mnozine nejak setridit, aby se v ni pak treba rychleji vyhledavalo,
                     ale to uz v zadani nebylo, takze se s tim parat nebudu}
                end;
 end;
End;{PridejPrvek}

{$B-} {nastaveni stylu vyhodnocovani logickych vyrazu: kdyz se vyraz sklada
       z nekolika jinych a po vyhodnoceni prvniho uz je jasne, jak to dopadne,
       tak se ostatni vubec nevyhodnocuji. Je to sice vychozi nastaveni, ale
       pokud nemusim, tak radsi neverim nicemu, co by "melo byt". Toto
       nastaveni je potreba, abychom pak neporovnavali hodnotu k vymazani
       s daty v pameti "za" mnozinou.}
procedure VymazPrvek(var M:mnozina; ktery:byte);
const i:word=1;
var pomocna:uknapole;
Begin
if M.pocetprvku>0 then{nema cenu cokoli mazat z prazdne mnoziny}
 with M do begin
           while (i<=pocetprvku)and(data^[i]<>ktery) do inc(i);{prochazime mnozinu tak dlouho, dokud ten prvek nenajdeme nebo
                                                                dokud nejsme na konci}
           if i<=pocetprvku then begin{vime, ze odpovidajici prvek jsme nasli}
                                 if pocetprvku>1 then begin{jestli se chystame smazat posledni prvek z mnoziny, tak nebudeme
                                                            alokovat zadnou pamet}
                                                      getmem(pomocna,pocetprvku-1);{alokujeme pamet pro novou (mensi) mnozinu}
                                                      if i>1 then move(data^,pomocna^,i-1);{kdyz mazany prvek neni uplne na
                                                            zacatku, tak vsechny prvky pred nim zkopirujeme do nove mnoziny}
                                                      if i<pocetprvku then move(data^[i+1],pomocna^[i],pocetprvku-i);{a kdyz
                                                        neni uplne na konci, tak zkopirujeme vsechny prvky za nim}
                                                      end;
                                 freemem(data,pocetprvku);{zrusime puvodni mnozinu}
                                 data:=pomocna;{jeji ukazatel presmerujeme na novou}
                                 dec(pocetprvku);{a zapamatujeme si, ze mame o prvek min}
                                 end;
           end;
End;{vymazprvek}

function JeVMnozine(prvek:byte; M:mnozina):boolean;
var i:word;
Begin
jevmnozine:=false;{jeste jsme ho nenasli, tak budeme predpokladat, ze tam neni}
with M do
 if pocetprvku>0 {v prazdne mnozine urcite nebude, takze se skonci a navratova hodnota zustane false}
  then for i:=1 to pocetprvku do if data^[i]=prvek then jevmnozine:=true;{jinak projdeme vsechny prvky mnoziny a porovnavame
                                                     s tim zadanym, pokud se rovnaji, tak do navratove hodnoty vlozime true}
End;{jevmnozine}

procedure OdectiMnozinu(var M1:mnozina; M2:mnozina);
var i:word;
Begin
if M1.pocetprvku>0 then{co bychom jeste odcitali od prazdne mnoziny?}
 for i:=1 to M1.pocetprvku{projdeme kazdy prvek prvni mnoziny...}
   do if jevmnozine(M1.data^[i],M2){...a kdyz se nachazi i v druhe mnozine...}
     then vymazprvek(M1,M1.data^[i]);{...tak ho z te prvni vymazeme}
{doufam, ze to cele bude fungovat}
End;{odectimnozinu}

function JsouStejne(M1,M2:mnozina):boolean;
var i:word;
Begin
if M1.pocetprvku=M2.pocetprvku{jestli nemaji stejny pocet prvku, tak stejne nejsou -> koncime}
{*)}then if M1.pocetprvku=0 then jsoustejne:=true{kdyz jsou obe prazdne, tak jsou stejne}
                            else begin{a kdyz nejsou prazdne a maji stejne prvku:}
                                 jsoustejne:=true;{predpokladejme, ze jsou...}
                                 for i:=1 to M1.pocetprvku do if not jevmnozine(M1.data^[i],M2) then jsoustejne:=false;
                                          {...a kdyz najdeme v jedne mnozine prvek, ktery neni ve druhe, tak stejne nejsou}
                                 end
    else jsoustejne:=false;
{pozn.: od *) dal nezalezi na tom, ktery pocet prvku pouzijeme, protoze uz vime, ze jsou oba stejne.
Kdyz misto M1.pocetprvku napiseme M2.pocetprvku, nic se nezmeni}
End;{jsoustejne}

procedure Sjednoceni(M1,M2:mnozina; var vysledek:mnozina);
var i:word;
Begin
vysledek:=M1;{do vysledku rovnou prekopirujeme celou prvni mnozinu}
{pozor, chyba! Tohle nebude fungovat. Primym prirazenim se jenom presmeruje
ukazatel na pole, ale ne pole samotne. Ve vysledku to sice bude v pohode,
ale mnozinu M1 to prepise!}
if M2.pocetprvku>0 then{a kdyz druha neni prazdna...}
 for i:=1 to M2.pocetprvku do pridejprvek(vysledek,M2.data^[i]);{...tak kazdy jeji prvek zkusime pridat do vysledne mnoziny.
                                                    Procedura pridejprvek uz se postara o to, abychom tam nemeli dva stejne.}
End;{sjednoceni}

procedure Prunik(M1,M2:mnozina; var vysledek:mnozina);
var i:word;
    pomocna:mnozina;{vstupni mnoziny potrebujeme poskladat tak, aby M1 byla ta s mensim poctem prvku a M2 ta druha (kvuli optimalizaci),
                     takze potrebujeme pomocnou promennou, abychom je mohli prohodit}
Begin
if M1.pocetprvku>M2.pocetprvku then begin{chceme je obracene, takze je prohodime:}
                                    pomocna:=M2;
                                    M2:=M1;
                                    M1:=pomocna;
                                    end;
if (M2.pocetprvku>0)and(M2.pocetprvku>0) then{kdyby byla jedna z mnozin prazdna, tak by byl prazdny i prunik a koncilo by se}
   for i:=1 to M1.pocetprvku do{projdeme kazdy prvek kratsi mnoziny}
     if jevmnozine(M1.data^[i],M2){a kdyz ho najdeme i ve druhe...}
         then pridejprvek(vysledek,M1.data^[i]);{...tak ho pridame k vyslednemu pruniku}
End;{prunik}

END.