Unit Halmaz;
(*
Bitvektoros halmaz br zol s pld ja.
Magyar k rtya-halmaz tĄpusa.
Asszoci lt mveletek: (Kszsg)
-------------- THalmaz(TKartya) ---------------
* TeljesPakli +
* UresPakli +
* TeljesPakliE +
* UresPakliE +
* Kozetesz +
* Elvesz +
* BenneVanE +
* Egyesit +
* Kozosek +
* LegjobbLap +
* LegrosszabbLap +
* VeletlenLap +
. . . . . .
* BePakli +
* KiPakli +
* HibasEPakli +
------------------- TKartya -------------------
* Kartya +
* KartyaSzin +
* KartyaFigura +
. . . . . .
* BeKartya +
* KiKartya +
*)
Interface
Type
TFigura = (VII,VIII,IX,X,Also,Felso,Kiraly,Asz);
TSzin = (Makk,Piros,Tok,Zold); {Nvsor-szerinti "ersorrendben"}
THalmaz = Record
lapok: Array [TSzin,TFigura] of Boolean;
siker: Boolean;
End;
TKartya = Record szin:TSzin; figura:TFigura End;
Const
MaxKartyaDb = (Ord(Zold)+1)*(Ord(Asz));
SFigura : Array [TFigura] of String[6]=('VII','VIII','IX','X',
'Also','Felso','Kiraly',
'Asz');
SSzin : Array [TSzin] of String[5]=('Makk','Piros','Tok','Zold');
Function KodbolSzin(Const kod:Byte):TSzin;
{Ef: kod ELEME [0..SZAMOSSAG'TSzin)
Uf: SORSZAM(KodbolSzin(kod))}
Function KodbolFigura(Const kod:Byte):TFigura;
{Ef: kod ELEME [0..SZAMOSSAG'TFigura)
Uf: SORSZAM(KodbolFigura(kod))}
Procedure TeljesPakli(Var p:THalmaz);
{Ef: -
Uf: MINDEN s:TSzin, MINDEN f:TFigura: p.lapok[s,f] ES
p.siker}
Function TeljesPakliE(Const p:THalmaz):Boolean;
{Ef: -
Uf: TeljesPakliE(p) <=> MINDEN s:TSzin, MINDEN f:TFigura:
p.lapok[s,f]}
Procedure UresPakli(Var p:THalmaz);
{Ef: -
Uf: MINDEN s:TSzin, MINDEN f:TFigura: NEM p.lapok[s,f] ES
p.siker}
Function UresPakliE(Var p:THalmaz):Boolean;
{Ef: -
Uf: UresPakliE(p) <=> MINDEN s:TSzin, MINDEN f:TFigura:
NEM p.lapok[s,f]}
Procedure Kozetesz(Var p:THalmaz; Const k:TKartya);
{Ef: -
Uf: k=(s,f) ES p.lapok[s,f]}
Procedure Elvesz(Var p:THalmaz; Const k:TKartya);
{Ef: k=(s,f) ES p.lapok[s,f]
Uf: k=(s,f) ES NEM p.lapok[s,f]}
Function BenneVanE(Var p:THalmaz; Const k:TKartya):Boolean;
{Ef: -
Uf: BenneVanE(p,k) <=> k=(s,f) ES p.lapok[s,f] }
Procedure Egyesit(Const p1,p2:THalmaz; Var p:THalmaz);
{Ef: -
Uf: ...}
Procedure Kozosek(Const p1,p2:THalmaz; Var p:THalmaz);
{Ef: -
Uf: ...}
Procedure LegjobbLap(Var p:THalmaz; Var k:TKartya);
{Ef: NEM UresPakliE(p)
Uf: k=(s,f) ES MINDEN kk:TKartya: kk=(ss,ff) ES
BenneVanE(ss,ff) ES
JobbE(ss,ff),(s,f))}
Procedure LegrosszabbLap(Var p:THalmaz; Var k:TKartya);
{Ef: NEM UresPakliE(p)
Uf: ...}
Procedure VeletlenLap(Var p:THalmaz; Var k:TKartya);
{Ef: NEM UresPakliE(p)
Uf: BenneVan(p,k)}
Procedure BePakli(Var p:THalmaz);
{Ef: -
Uf: ...}
Procedure KiPakli(Const p:THalmaz);
{Ef: -
Uf: ...}
Function HibasEPakli(Var p:THalmaz):Boolean;
{Ef: -
Uf: HibasEPakli=not(p.siker) ES p'.siker }
Procedure Kartya(Var k:TKartya; Const s:TSzin; Const f:TFigura);
{Ef: -
Uf: k=(s,f)}
Function KartyaSzin(Const k:TKartya):TSzin;
{Ef: -
Uf: KartyaSzin(k)=s <=> k=(s,f)}
Function KartyaFigura(Const k:TKartya):TFigura;
{Ef: -
Uf: KartyaFigura(k)=f <=> k=(s,f)}
Procedure BeKartya(Var k:TKartya);
{Ef: -
Uf: ...}
Procedure KiKartya(Const k:TKartya);
{Ef: -
Uf: ...}
Implementation
Uses Crt; {az AltRutin.inc kĄv nja meg}
{$i AltRutin.inc}
{------------------------ SzĄn s Figura: ------------------------}
Function KodbolSzin(Const kod:Byte):TSzin;
{Ef: kod ELEME [0..SZAMOSSAG'TSzin)
Uf: SORSZAM(KodbolSzin(kod))}
Var
s:TSzin;
Begin {az Ef-t nem ellenrizzk}
s:=Makk;
While Ord(s)<kod do s:=succ(s);
KodbolSzin:=s
End{KodBolSzin};
Function KodbolFigura(Const kod:Byte):TFigura;
{Ef: kod ELEME [0..SZAMOSSAG'TFigura)
Uf: SORSZAM(KodbolFigura(kod))}
Var
f:TFigura;
Begin {az Ef-t nem ellenrizzk}
f:=VII;
While Ord(f)<kod do f:=succ(f);
KodbolFigura:=f
End{KodBolFigura};
{---------------------------- Halmaz: ----------------------------}
Procedure TeljesPakli(Var p:THalmaz);
{Ef: -
Uf: MINDEN s:TSzin, MINDEN f:TFigura: p.lapok[s,f]}
Var
s:TSzin; f:TFigura;
Begin
For s:=Makk to Zold do
Begin
For f:=VII to Asz do
Begin
p.lapok[s,f]:=True
End;
End;
p.siker:=True
End;{TeljesPakli}
Function TeljesPakliE(Const p:THalmaz):Boolean;
{Ef: -
Uf: TeljesPakliE(p) <=> MINDEN s:TSzin, MINDEN f:TFigura:
p.lapok[s,f]}
Var
s:TSzin; f:TFigura; db:Byte;
Begin
{
db:=0;
For s:=Makk to Zold do
Begin
For f:=VII to Asz do
Begin
If not(p.lapok[s,f]) then Inc(db)
End;
End;
TeljesPakliE:=(db=0)
}
s:=Makk; f:=VII;
while (p.lapok[s,f]) and not((s=Zold) and (f=Asz)) do
begin
if f=Asz
then
begin
s:=succ(s);
f:=VII;
end
else f:=succ(f);
end;
TeljesPakliE:=p.lapok[s,f];
End;{TeljesPakliE}
Procedure UresPakli(Var p:THalmaz);
{Ef: -
Uf: MINDEN s:TSzin, MINDEN f:TFigura: NEM p.lapok[s,f]}
Var
s:TSzin; f:TFigura;
Begin
For s:=Makk to Zold do
Begin
For f:=VII to Asz do
Begin
p.lapok[s,f]:=False
End;
End;
p.siker:=True
End;{UresPakli}
Function UresPakliE(Var p:THalmaz):Boolean;
{Ef: -
Uf: UresPakliE(p) <=> MINDEN s:TSzin, MINDEN f:TFigura:
NEM p.lapok[s,f]}
Var
s:TSzin; f:TFigura; db:Byte;
Begin
db:=0;
For s:=Makk to Zold do
Begin
For f:=VII to Asz do
Begin
If p.lapok[s,f] then Inc(db)
End;
End;
UresPakliE:=db=0
End;{UresPakliE}
Procedure Kozetesz(Var p:THalmaz; Const k:TKartya);
{Ef: -
Uf: k=(s,f) ES p.lapok[s,f]}
Begin
p.lapok[k.szin,k.figura]:=True
End;{Kozetesz}
Procedure Elvesz(Var p:THalmaz; Const k:TKartya);
{Ef: k=(s,f) ES p.lapok[s,f]
Uf: k=(s,f) ES NEM p.lapok[s,f]}
Begin
If not p.lapok[k.szin,k.figura] then {nem teljesl az Ef}
Begin
p.siker:=False
End
Else
Begin
p.lapok[k.szin,k.figura]:=False
End;
End;{Elvesz}
Function BenneVanE(Var p:THalmaz; Const k:TKartya):Boolean;
{Ef: -
Uf: BenneVanE(p,k) <=> k=(s,f) ES p.lapok[s,f] }
Begin
BenneVanE:=p.lapok[k.szin,k.figura]
End;{BenneVanE}
Procedure Egyesit(Const p1,p2:THalmaz; Var p:THalmaz);
{Ef: -
Uf: ...}
Var
s:TSzin; f:TFigura; db:Byte;
Begin
for s:=Makk to Zold do
for f:=VII to Asz do p.lapok[s,f]:=p1.lapok[s,f] or p2.lapok[s,f];
End;{Egyesit}
Procedure Kozosek(Const p1,p2:THalmaz; Var p:THalmaz);
{Ef: -
Uf: ...}
Var
s:TSzin; f:TFigura; db:Byte;
Begin
for s:=Makk to Zold do
for f:=VII to Asz do p.lapok[s,f]:=p1.lapok[s,f] and p2.lapok[s,f];
End;{Kozosek}
Procedure LegjobbLap(Var p:THalmaz; Var k:TKartya);
{Makk VII, MAKK VIII, ..., Zold Asz}
{Ef: NEM UresPakliE(p)
Uf: k=(s,f) ES MINDEN kk:TKartya: kk=(ss,ff) ES
BenneVanE(ss,ff) ES
JobbE(ss,ff),(s,f))}
Var
s:TSzin; f:TFigura;
Begin
If UresPakliE(p) then {nem teljesl az Ef}
Begin
p.siker:=False
End
Else
Begin
s:=Makk; f:=VII;
While ((s<Zold) or ((s=Zold) and (f<Asz))) and
not p.lapok[s,f] do
Begin
If f<Asz then f:=succ(f)
else Begin s:=succ(s); f:=VII end;
End;
k.szin:=s; k.figura:=f;
End;
End;{LegjobbLap}
Procedure LegrosszabbLap(Var p:THalmaz; Var k:TKartya);
{Zold Asz, ... , Makk VIII, MAKK VII}
{Ef: NEM UresPakliE(p)
Uf: ...}
Var
s:TSzin; f:TFigura;
Begin
If UresPakliE(p) then {nem teljesl az Ef}
Begin
p.siker:=False
End
Else
Begin
s:=Zold; f:=Asz;
While ((s>Makk) or ((s=Makk) and (f>VII))) and
not p.lapok[s,f] do
Begin
If f>VII then f:=pred(f)
else Begin s:=pred(s); f:=Asz end;
End;
k.szin:=s; k.figura:=f;
End;
End;{LegrosszabbLap}
Procedure VeletlenLap(Var p:THalmaz; Var k:TKartya);
{Ef: NEM UresPakliE(p)
Uf: BenneVan(p,k)}
Var
s:TSzin; f:TFigura;
Begin
If UresPakliE(p) then {nem teljesl az Ef}
Begin
p.siker:=False
End
Else
Begin
Repeat
s:=KodbolSzin(Random(4)); f:=KodbolFigura(Random(8));
Until p.lapok[s,f];
k.szin:=s; k.figura:=f
End;
End;{VeletlenLap}
Procedure BePakli(Var p:THalmaz);
{Ef: ...
Uf: ...}
Var V: Char; K: TKartya;
Begin
UresPakli(p);
Repeat
Writeln('Krem adjon meg egy k rty t (szĄn,figura)');
BeKartya(k);
If not (BenneVanE(p,k)) then Kozetesz(p,k);
Writeln('Add meg mg k rty t? (i/n)');
Readln(V);
Until V='n'
End;{BePakli}
Procedure KiPakli(Const p:THalmaz);
{Ef: -
Uf: ...}
Var
s:TSzin; f:TFigura;
Begin
For s:=Makk to Zold do
Begin
Write(SSzin[s]:6,':');
For f:=VII to Asz do
Begin
If p.lapok[s,f] then Write(SFigura[f],' ')
End;
Writeln;
End;
End;{KiPakli}
Function HibasEPakli(Var p:THalmaz):Boolean;
{Ef: -
Uf: HibasEPakli=not(p.siker) ES p'.siker }
Begin
HibasEPakli:=not(p.siker);
p.siker:=True
End;{HibasEPakli}
{---------------------------- K rtya: ----------------------------}
Procedure Kartya(Var k:TKartya; Const s:TSzin; Const f:TFigura);
{Ef: -
Uf: k=(s,f)}
Begin
k.szin:=s; k.figura:=f
End;{Kartya}
Function KartyaSzin(Const k:TKartya):TSzin;
{Ef: -
Uf: KartyaSzin(k)=s <=> k=(s,f)}
Begin
KartyaSzin:=k.szin
End;{KartyaSzin}
Function KartyaFigura(Const k:TKartya):TFigura;
{Ef: -
Uf: KartyaFigura(k)=f <=> k=(s,f)}
Begin
KartyaFigura:=k.figura
End;{KartyaFigura}
Procedure BeKartya(Var k:TKartya);
{Ef: ... SZIN + ',' FIGURA alakban
Uf: ...}
Var
sk,ss,sf:String;
s:TSzin; f:TFigura;
hol:Integer;
Begin {az Ef-et nem ellenrizzk}
Readln(sk); sk:=StringUpCase(sk);
hol:=Pos(',',sk); ss:=Copy(sk,1,hol-1); sf:=Copy(sk,hol+1,Length(sk));
{Szin-k˘dol s:}
s:=Makk;
While (s<Zold) and (StringUpCase(SSzin[s])<>ss) do s:=succ(s);
k.szin:=s;
{Figura-k˘dol s:}
f:=VII;
While (f<Asz) and (StringUpCase(SFigura[f])<>sf) do f:=succ(f);
k.figura:=f;
End;{BeKartya}
Procedure KiKartya(Const k:TKartya);
{Ef: -
Uf: ...}
Begin
Writeln(SSzin[k.szin],' ',SFigura[k.figura]);
End;{KiKartya}
Begin
End.
Közművelődés, kultúra, oktatás, könyvtár, pedagógia, műszaki informatika, számítástechnika
2015. január 3., szombat
Pascal bitvektoros halmaz ábrázolás példája. Magyar kártya-halmaz típusa.
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése