Conjuntos (v. 1.0.0)

{ paulogp }
{ mac os 7 }
program Ada23p(input, output);

uses
    MemTypes, QuickDraw, OSIntf;

Type
    Intervalo = 1..200;
    Conj_Num_Reais = array[Intervalo] of real;
    Conjunto = array[1..2] of Conj_Num_Reais;
    NumElem = array[1..2] of Intervalo;


procedure DefinirConjunto(var Elemento: Conjunto; var n_elem: NumElem);
var
    i, y: Intervalo;
    x: integer;
    j: real;

begin
    for x:= 1 to 2 do
    begin
        writeln;
        write('Número de elementos do ' , x, 'º conjunto: ');
        readln(n_elem[x]);
        for i:= 1 to n_elem[x] do
        begin
            write('v[', i:2, ']: ');
            readln(Elemento[x, i]);
            if i >= 2 then
            begin
                j :=  Elemento[x, i];
                for y :=  1 to i - 1 do
                    if Elemento[x, y] = j then
                    begin
                        writeln;
                        writeln('Erro: valor repetido!');
                        writeln('Insira outro!');
                        writeln;
                        i:=  i - 1;
                    end;
            end;
        end;
    end;
end;

procedure SubMenu(var escolha: char);

function opcoes(escolha: char): char;
begin
    opcoes:=  escolha;
end;

begin
    clearscreen;
    gotoxy(33,2);
    writeln('Menu Principal');
    gotoxy(33, 3);
    writeln('~~~~~~~~~~~~~~');
    gotoxy(25, 5);
    writeln('1- Visualizar Conjuntos;');
    gotoxy(25, 7);
    writeln('2- Teste de Elemento');
    gotoxy(25, 8);
    writeln('3- Teste de Inclusão');
    gotoxy(25, 10);
    writeln('4- Conjunto Intercepção;');
    gotoxy(25, 11);
    writeln('5- Conjunto Reunião');
    gotoxy(25, 12);
    writeln('6- Conjunto Diferença');
    gotoxy(25, 14);
    writeln('7- Definir novos conjuntos;');
    gotoxy(25, 16);
    writeln('8- Sair');
    gotoxy(25, 18);
    write('Opção: ');
    repeat
        readln(escolha);
    until (escolha >= '1') and (escolha <= '8');
    writeln('Teclado: ', opcoes(escolha));
end;

procedure MostraConjunto(Elemento: Conjunto; n_elem: NumElem);
var
    v: Intervalo;
    w: integer;

begin
    for w:=  1 to 2 do
    begin
        writeln;
        write(' ':10);
        write('Conjunto ', w, ': { ');
        for v:=  1 to n_elem[w] do write(Elemento[w,v]:2:2, ' ');
        writeln('}');
    end;
    writeln;
end;

function Teste_Elemento(Value: real; var Elemento: Conjunto; n_elem: Numelem; Conjunt: integer): Boolean;
var
    u, b: Intervalo;

begin
    for b:=  1 to n_elem[Conjunt] do Teste_Elemento:=  false;
    for u:=  1 to n_elem[Conjunt] do
        if Value = Elemento[Conjunt, u] then Teste_Elemento:=  true;
end;

function teste_inclusao(Elemento: Conjunto; n_elem: NumElem; C1, C2: integer): Boolean;
var
    c, d: Intervalo;
    f: integer;

begin
    f:= 0;
    if n_elem[C1] > n_elem[C2] then teste_inclusao:= false else
    if n_elem[C1] <= n_elem[C2] then
    for c:= 1 to n_elem[C2] do
        for d:= 1 to n_elem[C1] do
            if Elemento[C2,c] = Elemento[C1,d] then f:= f+1;

    if f = n_elem[C1] then teste_inclusao:=  true else teste_inclusao:=  false;
end;

procedure Intercepcao(Elemento: Conjunto; n_elem: NumElem; var Inter: Conj_Num_Reais);
var
    g, h: Intervalo;
    n, m: integer;

begin
    n:= 0;
    for g:= 1 to n_elem[1] do
        for h:= 1 to n_elem[2] do
            if Elemento[1, g]= Elemento[2, h] then
            begin
                n:=  n+1;
                Inter[n]:= Elemento[1, g];
            end;
    writeln;
    write(' ':10, 'Conjunto 1 * Conjunto 2= { ');
    for m:=  1 to n do write(Inter[m]:2:2,' ');
    writeln('}');
end;

procedure ConjuntoReuniao(Elemento: Conjunto; n_elem: NumElem);

function Dif(x: real; Elemento: Conjunto; n_elem: NumElem): Boolean;
var
    r: Intervalo;

begin
    Dif:=  true;
    for r:=  1 to n_elem[1] do
        if x = Elemento[1,r] then Dif:= false;
end;

var
    p, q: Intervalo;

begin
    write(' ':3, 'Conjunto 1 + Conjunto 2= { ');
    for p:=  1 to n_elem[1] do write(Elemento[1, p]:2:2, ' ');
    for q:=  1 to n_elem[2] do
        if Dif(Elemento[2,q], Elemento, n_elem) then write(Elemento[2, q]:2:2, ' ');
    writeln('}');
end;

procedure ConjuntoDiferenca2(Elemento: Conjunto; n_elem: NumElem; x1, x2: integer);
function dif2(x: real; x2: integer; Elemento: Conjunto; n_elem: NumElem): Boolean;
var
    r: Intervalo;

begin
    dif2:=  true;
    for r:=  1 to n_elem[x2] do
        if x = Elemento[x2, r] then dif2:= false;
end;

var
    e: Intervalo;

begin
    write(' ':7, 'Conjunto ', x1,' - Conjunto ', x2, '= { ');
    for e:= 1 to n_elem[x1] do
        if dif2(Elemento[x1, e], x2, Elemento, n_elem) then write(Elemento[x1, e]:2:2, ' ');
    writeln('}');
end;

procedure ConjuntoDiferenca(Elemento: Conjunto; n_elem: NumElem; var Inter: Conj_Num_Reais);
var
    g, h: Intervalo;
    n, m, i: integer;
    aux: integer;

begin
    n:= 0;
    if n_elem[1] > n_elem[2] then aux:= n_elem[1] else aux:= n_elem[2];
    for i:= 1 to aux do

    {for g:= 1 to n_elem[1] do
    for h:= 1 to n_elem[2] do}

        if Elemento[1, g] <> Elemento[2, h] then
        begin
            n:= n + 1;
            Inter[n]:= Elemento[1, g];
        end;

    writeln;
    write(' ':10, 'Conjunto 1 * Conjunto 2= { ');
    for m:=  1 to n do write(Inter[m]:2:2,' ');
    writeln('}');
end;

var
    disjuncao: Conj_Num_Reais;
    Elemento: Conjunto;
    n_elementos: NumElem;
    opcao, a, s: char;
    valor: real;
    aditivo, subtractivo: integer;

begin
    gotoxy(32, 2);
    writeln('Definir Conjuntos');
    gotoxy(32, 3);
    writeln('~~~~~~~~~~~~~~~~~');
    gotoxy(8, 4);
    DefinirConjunto(elemento, n_elementos);
    SubMenu(opcao);
    repeat
        if opcao = '1' then
        begin
            clearscreen;
            gotoxy(35, 2);
            writeln('Conjuntos');
            gotoxy(35, 2);
            writeln('~~~~~~~~~');
            writeln;
            MostraConjunto(elemento, n_elementos);
            writeln;
            write('Prima uma tecla para voltar ao menu principal.');
            readln;
            SubMenu(opcao);
        end;

        if opcao = '2' then
        begin
            repeat
                clearscreen;
                gotoxy(33, 2);
                writeln('Teste de Membro');
                gotoxy(33, 3);
                writeln('~~~~~~~~~~~~~~~');
                writeln;
                MostraConjunto(elemento, n_elementos);
                writeln;
                write('Digite o valor: ');
                readln(valor);
                begin
                    if ((Teste_Elemento(valor, elemento, n_elementos, 1)) and (Teste_Elemento(valor, elemento, n_elementos, 2))) then
                        writeln(valor:2:2,' pertence aos dois conjuntos.')
                    else
                    if Teste_Elemento(valor, elemento, n_elementos, 1) then
                        writeln(valor:2:2,' pertence ao conjunto 1.')
                    else
                    if Teste_Elemento(valor, elemento, n_elementos, 2) then
                        writeln(valor:2:2,' pertence ao conjunto 2.')
                    else
                    writeln(valor:2:2,' não pertence a nenhum dos conjuntos.');
                end;
                writeln;
                writeln('Sub-Menu:');
                writeln(' 1- Repetir o teste.');
                writeln(' 2- Voltar ao menu.');
                writeln;
                readln(a);
            until a = '2';
            SubMenu(opcao);
        end;

        if opcao = '3' then
        begin
            clearscreen;
            gotoxy(33, 2);
            writeln('Teste de Inclusão');
            gotoxy(33, 3);
            writeln('~~~~~~~~~~~~~~~~~');
            writeln;
            writeln;
            MostraConjunto(elemento, n_elementos);
            writeln;
            if ((teste_inclusao(elemento, n_elementos, 1, 2)) and (teste_inclusao(elemento, n_elementos, 2, 1))) then
                writeln('Os dois conjuntos são iguais.')
            else
            if teste_inclusao(elemento, n_elementos, 1, 2) then
                writeln('O conjunto 1 está contido no conjunto 2.')
            else
            if teste_inclusao(elemento, n_elementos, 2, 1) then
                writeln('O conjunto 2 está contido no conjunto 1.')
            else
                writeln('Não há inclusão de nenhum conjunto noutro.');
            writeln;
            write('Prima uma tecla para voltar ao menu principal.');
            readln;
            SubMenu(opcao);
        end;

        if opcao = '4' then
        begin
            clearscreen;
            gotoxy(31, 2);
            writeln('Conjunto Intersecção');
            gotoxy(31, 3);
            writeln('~~~~~~~~~~~~~~~~~~~~');
            writeln;
            Intercepcao(elemento, n_elementos, disjuncao);
            writeln;
            writeln;
            writeln;
            write('Prima uma tecla para voltar ao menu principal.');
            readln;
            SubMenu(opcao);
        end;

        if opcao = '5' then
        begin
            clearscreen;
            gotoxy(33, 2);
            writeln('Conjunto Reunião');
            gotoxy(33, 3);
            writeln('~~~~~~~~~~~~~~~~~');
            writeln;
            ConjuntoReuniao(elemento, n_elementos);
            writeln;
            writeln;
            writeln;
            write('Prima uma tecla para voltar ao menu principal.');
            readln;
            SubMenu(opcao);
        end;

        if opcao = '6' then
        begin
            repeat
                clearscreen;
                gotoxy(32,2);
                writeln('Conjunto Diferença');
                gotoxy(32, 3);
                writeln('~~~~~~~~~~~~~~~~~~');
                writeln;
                MostraConjunto(elemento, n_elementos);

                {repeat
                    writeln;
                    write('Digite o conjunto: ');
                    readln(aditivo);
                until (aditivo >= 1) and (aditivo <= 2);
                repeat
                    writeln;
                    write('Digite o conjunto que lhe vai subtrair: ');
                    readln(subtractivo);
                until (subtractivo >= 1) and (subtractivo <= 2);
                writeln;}

                aditivo:= 2;
                subtractivo:= 1;
                ConjuntoDiferenca(elemento, n_elementos, disjuncao);
                writeln;
                writeln('Menu:');
                writeln(' 1 - Fazer nova subracção.');
                writeln(' 2 - Voltar ao menu.');
                writeln;
                readln(s);
            until s = '2';
            SubMenu(opcao);
        end;

        if opcao = '7' then
        begin
            clearscreen;
            gotoxy(33, 2);
            writeln('Novo Conjunto');
            gotoxy(33, 3);
            writeln('~~~~~~~~~~~~~');
            writeln;
            DefinirConjunto(elemento, n_elementos);
            SubMenu(opcao);
        end;
    until opcao = '8';
end.