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