Anonymní profil Krs – Programujte.com

Běží, díky moc...jsem tele :D

Díky, ale stejně pořád nic :(

Mohl by mi prosím někdo poradit, proč mi při spouštění Pascal nebere proměnné s1, p a M (does not seem to be inicialized) a taky bych vás chtěla poprosit, jestli tomu někdo rozumíte - proč to nejde? :( Osobně myslím, že je chyba až v těle programu, ale sedím nad tím už tak dlouho, že nejsem schopná na to přijít...díky moc!


program mnoziny;
const
k=100;
type
tPole= array[0..0] of byte;
tUkSet=^tPole;
tSet= array[0..K] of tUkSet;

procedure ClearSet (var M : tSet);
var x: integer;
begin {vytvoreni mnoziny}
for x:=0 to K do New(M[x]); {vytvoreni dynamickeho pole}
ClearSet(M);
end;
procedure CreateSet(var M: tSet);{vytvoří novou množinu M s kardinalitou K prvků, kde K je konstanta}
var x: integer;
begin
for x:=0 to K do M[x]^[0]:=0; {vynulovani vsech prvku v poli}
end;
procedure AddSet (var M : tSet; n : integer); {Přidá do množiny M prvek n. Pokud dojde k chybě (prvek nemůže být součástí množiny), nedělá procedura nic}
var x: integer;
begin {pridani prvku pole}
x:=0;
while (M[x]^[0]<>N) and (x<K) do Inc(x); {zjistovani, jestli uz prvek v poli je}
if M[x]^[0]<>N then
begin {pokud prvek v poli jeste neni, tak ho pridat}
x:=0;
while (M[x]^[0]<>0) and (x<k) do Inc(x); {hledani volneho mista v poli}
if x<k then
M[x]^[0]:=M[x]^[0] + N; {pokud neni mnozina jeste plna, tak prvek pridat}
end;
end;
procedure DelSet (var M : tSet; n : integer); {ubere z množiny M prvek n. Pokud dojde k chybě (prvek nemůže být součástí množiny), nedělá procedura nic}
var x: integer;
begin
x:=0;
while (M[x]^[0]<>n) and (x<k) do Inc(x); {prohledani pole, jestli obsahuje prvek}
if M[x]^[0]=n then M[x]^[0]:=0; {pokud byl prvek nalezen, tak bude vymazan}
end;

function InSet (M : tSet; n : integer) : boolean; {vrátí True, pokud se prvek n v množině M nachází. Vrátí False, pokud se prvek n v množině M nenachází nebo pokud prvek být v množině nemůže.}
var x: integer;
begin
x:=0;
while (M[x]^[0]<>n) and (x<k) do Inc(x); {prohledani pole, jestli obsahuje prvek}
if M[x]^[0]=n then InSet:=true else InSet:=false; {pokud byl prvek nalezen, vrati true, jinak vrati else}
end;

procedure DiffSet (var M1 : tSet; M2 : tSet); {- rozdíl množin M1 a M2 (tj. výsledek obsahuje prvky množiny M1, které se nenacházejí v M2). Výsledek se vrací v M1.}
var x: integer;
begin {rozdil, vysledek do M1}
for x:=0 to K do {bude se prochazet cele pole M1}
begin
if M1[x]^[0]<>0 then {pokud je prvek pole nenulovy, tak se bude hledat,
jestli je obsazen v M2}
begin
if InSet(M2,M1[x]^[0]) then M1[x]^[0]:=0; {pokud byl prvek v poli M2 nalezen, bude vynulovan}
end;
end;
end;
Function EquSet (M1 : tSet; M2 : tSet) : boolean; {- Test množin M1 a M2 na rovnost.}
var x,y: integer;
p: integer;
Rovnost: boolean;
begin {predpokladam, ze prvky v polich mohou byt v ruznem poradi a testuje se jestli
obe pole obsahuji totozne prvky}
Rovnost:=true; {na pocatku predpokladam rovnost}
x:=0;
while (x<K) and Rovnost do {bude se prochazet cele pole M1, pokud se najde prvek,
ktery neni v poli M2, tak se cyklus prerusi}
begin
if M1[x]^[0]<>0 then {pokud je prvek pole nenulovy, tak se bude hledat,
jestli je obsazen v M2}
begin
Inc(p); {pocita se pocet nenulovych prvku}
y:=0;
Rovnost:=InSet(M2,M1[x]^[0]); {pokud nebyl prvek v poli M2 nalezen,
nejsou mnoziny stejne}
end;
Inc(x);
end;
if Rovnost then {pokud predchozi kontrola neodhalila rozdil, porovna se jeste pocet
nenulovych prvku v obou polich, kdyby nahodou bylo v M2 vice prvku, nebyly by shodne}
begin
y:=0;
for x:=0 to K do if M2[x]^[0]<>0 then Inc(y); {spocita pocet prvku v M2}
if y<>p then Rovnost:=false; {pokud nesouhlasi pocet prvku, nejsou pole stejna}
end;
EquSet:=Rovnost; {predat vysledek}
end;
procedure UnionSet (var M1 : tSet; M2 : tSet); {- provede sjednocení množin M1 a M2, výsledek uloží do M1 }
var x: integer;
begin {sjednoceni, vysledek do M1}
for x:=0 to K do {bude se prochazet cele pole M2}
begin
if M2[x]^[0]<>0 then {pokud je prvek pole nenulovy}
begin
AddSet(M1,M2[x]^[0]); {tak ho pridat do pole M1}
end;
end;
end;
procedure IntersectSet (var M1 : tSet; M2 : tSet); {- provede průnik množin M1 a M2, výsledek uloží do M1 }
var x: integer;
begin {prunik, vysledek do M1}
for x:=0 to K do {bude se prochazet cele pole M1}
begin
if M1[x]^[0]<>0 then {pokud je prvek pole nenulovy}
begin
if not InSet(M2,M1[x]^[0]) then {a pokud neni nalezen v poli M2}
begin
M1[x]^[0]:=0; {tak ho vynulovat}
end;
end;
end;
end;
function GetSet(M:TSet): string;
var s,s1: string;
x: integer;
begin {vrati obsah seznam nenulovych polozek pole, jako cisla oddelena carkou}
s:='';
for x:=0 to K do {bude se prochazet cele pole M}
begin
if M[x]^[0]<>0 then {pokud bude prvek nenulovy}
begin
Str(M[x]^[0],s1); {tak ho prevest na retezec}
if s<>'' then s:=s+','+s1 else s:=s1; {a pridat k vysledku}
{pri prvnim cisle nevlozit oddelovaci carku}
end;
end;
GetSet:=s; {predani vysledneho retezce}
end;


var M: TSet;
x,y: integer;
n: integer;
begin
CreateSet(M); {vytvoreni mnoziny}
Writeln('Zadej pocet prvku:');
Readln(y); {uzivatel zada pocet prvku v mnozine, NESMI BYT VETSI NEZ K v unite mnoziny}
writeln ('lll');
if y>1 then {pocet prvku musi byt vetsi nez 1}
begin

writeln ('Mnozina obsahuje tyto prvky:', y);
for x:=1 to Y do AddSet(M,x); {Mnozina se naplni cisly 1..Y}
Writeln;
Writeln('Pred sitem: '+GetSet(M)); {vypsani puvodni mnoziny}
DelSet(M,1); {jednicka neni prvocislo, takze ji zrovna vyradit}
x:=2;
while x<y do {opakovat, dokud x je mensi nez nejvyssi cislo v mnozine}
begin
n:=2; {budou se testovat n nasobky cisla x}
while (n*x)<y do {opakovat, dokud jsou nasobky mensi nez max. cislo}
begin
DelSet(M,n*x); {Nasobek cisla x se pokusit vymazat z pole M1}
Inc(n); {Bude nasledovat dalsi nasobek}
end;
inc(x); {zkusit dalsi cislo}
end;
Writeln('Po situ: '+GetSet(M)); {vypsani zbylych prvocisel}
end;
readln;
end.