DUzun's Web
Programare, proiecte personale, divertisment

unit p168_15a;

interface

const Max_Elem=1000;

​

     {Elementul nr 0 din orice multime va indica nr de elemente din multime}

type Elemente=0..Max_Elem;

     Multime=array[Elemente]of word;

​

​

     {Se afiseaza elementele multimii A precedate de mesajul Msg}

Procedure Afiseaza(a:Multime;Msg:string);

​

     {Daca A se include in B, functia intoarce valoarea "True"}

Function Includere(a,b:Multime):Boolean;

​

     {C va fi multimea obtinuta in rezultatul operatiei, iar functia va indica nr de elemente din multimea C}

Function Intersectia(a,b:Multime;var c:Multime):Elemente;

Function Reuniunea(a,b:Multime;var c:Multime):Elemente;

Function Complementara(a,b:Multime;var c:Multime):Elemente;

​

​

Procedure ReadM(var M:multime;Titlu:string);

​

implementation

uses crt;

var i,j:Elemente;

    e:word;

    m:Multime;

​

Procedure Schimb(var m,n:word);

var d:word;

begin

 d:=m; m:=n; n:=d;

end;

​

Function Apartine(e:Word;M:Multime):Boolean;

var i:Elemente;

begin

 i:=1;

 while(i<M[0])and(e<>M[i])do inc(i);

 Apartine:=(M[0]>0)and(e=M[i]);

end;

​

{Intoarce "True" daca elementul a fost atribuit, "False daca elementul deja apartine multimii}

Function Atribuie(e:Word;var M:Multime):Boolean;

begin

 if Apartine(e,m)then Atribuie:=false

 else begin

  inc(m[0]);

  m[m[0]]:=e;

  Atribuie:=true;

 end;

end;

​

{Aranjeaza elementele multimii C in ordine crescatoare}

Procedure Ordoneaza(var C:Multime);

begin

 i:=1;

 while(i<c[0])do begin

  j:=i;

  while(j<c[0])do begin

   inc(j);

   if c[i]>c[j]then Schimb(c[i],c[j]);

  end;

  inc(i);

 end;

end;

​

{Inlatura toate elementele duble din multimea C}

Procedure Filtru(Var C:Multime);

begin

 m[0]:=0;

 For i:=1 to c[0]do Atribuie(c[i],m);

 c:=m;

end;

​

Procedure Afiseaza;

begin

 Write(Msg);

 for i:=1 to a[0] do begin

  if WhereY=hi(windmax)then begin

   Writeln('Apasa o tasta!');

   readkey;

   clrscr;

  end;

  Write(A[i]:8);

 end;

 writeln;

end;

​

Function Includere;

begin

 i:=0;

 while(i<a[0])and Apartine(a[i+1],b) do inc(i);

 Includere:=i=a[0];

end;

​

Function Intersectia(a,b:Multime;var c:Multime):Elemente;

begin

 c[0]:=0;

 for i:=1to a[0] do

 if Apartine(a[i],b) then Atribuie(a[i],c);

 Intersectia:=c[0];

end;

​

Function Reuniunea;

begin

 c[0]:=0;

 for i:=1to a[0] do Atribuie(a[i],c);

 for i:=1to b[0] do Atribuie(b[i],c);

 Ordoneaza(c);

 Reuniunea:=c[0];

end;

​

Function Complementara;

begin

 c[0]:=0;

 if Includere(a,b)then for i:=1to b[0] do

 if not Apartine(b[i],a) then Atribuie(b[i],c);

 Complementara:=c[0];

end;

​

Procedure ReadM;

label ask;

var ne:Elemente;

    max,min:word;

    k:char;

begin

 m[0]:=0;

 Writeln('Introdu nr de elemente din multimea '+Titlu+' (0..',max_elem,')');Readln(ne);

 Writeln('Doriti sa generez ',ne,' elemente in ',Titlu,' (D/N)?');

 ask: k:=UpCase(readKey);

 if k='D'then begin

  Writeln('Elementul minim (0..',$ffff,'): ');readln(min);

  Writeln('Elementul maxim (',min,'..',$ffff,'): ');readln(max);

  for i:=1 to ne do Atribuie(random(Max-Min+1)+min,m);

 end else

 if k='N' then for i:=1 to ne do begin

  Write(i,') ');

  Readln(e);

  Atribuie(e,m);

 end else begin

  writeln('Alegerea se face tastand ''D'' sau ''N''!'#$D#$A' (D/N)?');

  goto ask;

 end;

 Filtru(m);

 Ordoneaza(m);

end;

​

End.

​