Conjuntos (v. 1.0.1)

{ paulogp }
{ mac os 7 }
program Ada24p;

uses
    MemTypes, QuickDraw, OSIntf;

const
    MAX = 20;

type
    Conjunto = Array [1..MAX] of real;

{* Verificação da existência do valor no conjunto - Método recursivo *}
function NaoEsta(a: real; q: Conjunto; k: integer): boolean;
begin
    if k > 0 then
        if a = q[k] then NaoEsta:= false else NaoEsta:= NaoEsta(a, q, k - 1)
    else NaoEsta:= true;

    {achou:= false;   i:= 1;
    while not achou and(i <= N)
    do if a = x[i] then achou:= true else i:= i + 1;
    NaoEsta:= achou}
end;

{* localização de um valor dentro de um conjunto *}
procedure ProcurarElemento(a: real; q: Conjunto; k: integer);
var
    i, contador: integer;

begin
    contador:=  0;
    if k > 0 then
    begin
        for i:=  k downto 1 do
            if q[i] = a then contador:= i;

        if contador > 0 then writeln('Encontra-se na ', contador, ' ª posição.') else
            writeln('Não existe.');
    end;
end;

{* construção de conjuntos *}
procedure ConstroiConjunto(var q: Conjunto; var qn: integer);
var
    a, c: real;
    i, j: integer;

begin
    repeat
        write('Número de elementos [1,', MAX, ']: ');
        readln(qn);
    until (qn > 0) and (qn <= MAX);
    writeln;
    i:= 1;
    repeat
        writeln;
        write('Introduza o ', i, 'º elemento: ');
        readln(a);
        if NaoEsta(a, q, i - 1) then
        begin
            q[i]:=  a;
            i:= i + 1;
        end else
        begin
            writeln;
            writeln('ERRO: Elemento repetido.')
        end;
    until i = qn + 1;

    {* Ordena *}
    for i:= 2 to qn do
        for j:= 1 to qn - 1 do
            if q[i] < q[j] then
            begin
                c:= q[i];
                q[i]:= q[j];
                q[j]:= c;
            end;
end;

{* Visualização de conjuntos - Método Recursivo *}
procedure MostrarConjunto(q: Conjunto; k: integer);
begin
    if k = 1 then writeln('pos(', k, '): ', q[1]:2:2) else
    begin
        MostrarConjunto(q, k - 1);
        writeln('pos(', k, '): ', q[k]:2:2)
    end
end;

{* União de conjuntos *}
procedure UniaoConjunto(q, r: Conjunto; var s: Conjunto; qn, rn: integer; var sn: integer);
var
    i: integer;

begin
    sn:= qn;
    s:= q;
    for i:= 1 to rn do
        if NaoEsta(r[i], s, sn) then
        begin
            sn:= sn + 1;
            s[sn]:= r[i];
        end;
end;

{* intersecção de conjuntos *}
procedure InterseccaoConjunto(q, r: Conjunto; var s: Conjunto; qn, rn: integer; var sn: integer);
var
    contador, i: integer;

begin
    contador:= 0;
    sn:= 0;
    if qn > rn then contador:= qn else contador:= rn;
    for i:= 1 to contador do
        if NaoEsta(q[i], r, rn) = false then
        begin
            sn:= sn + 1;
            s[sn]:= q[i];
        end;
end;

{* diferença de conjuntos *}
procedure DiferencaConjunto(q, r: Conjunto; var s: Conjunto; qn, rn: integer; var sn: integer);
var
    i: integer;

begin
    sn:= 0;
    for i:= 1 to qn do
        if NaoEsta(q[i], r, rn) = true then
        begin
            sn:= sn + 1;
            s[sn]:= q[i];
        end;

    for i:= 1 to rn do
        if NaoEsta(r[i], q, qn) = true then
        begin
            sn:= sn + 1;
            s[sn]:= r[i];
        end;
end;

{** titulo **}
procedure Titulo(x: integer; nome: String);
var
    i: integer;

begin
    clearscreen;
    gotoxy(x,2);
    writeln(nome);
    gotoxy(x,3);
    for i:= 1 to length(nome) do write('~');
    writeln;
    writeln;
end;

{* pausa *}
procedure Pausa;
begin
    writeln;
    writeln;
    write('Prima uma tecla para continuar!');
    readln;
end;

{* string "Conjunto"*}
procedure NomeConjunto(c: Char);
begin
    writeln('Conjunto ', c);
end;

{* alinhamento do texto *}
procedure Alinha(y: integer);
begin
    gotoxy(23, y);
end;

{* corpo principal *}
var
 n1, n2, n3, i: integer;
 opcao, tecla: char;
 extra: string;
 x, y, z: Conjunto;
 valor: real;
 desistir: boolean;

begin
    Titulo(28, 'Definição dos Conjuntos');
    NomeConjunto('A');
    ConstroiConjunto(x, n1);
    Titulo(28, 'Definição dos Conjuntos');
    NomeConjunto('B');
    ConstroiConjunto(y, n2);
    repeat
        Titulo(32, 'MENU PRINCIPAL');
        Alinha(6);
        writeln('1 - Mostrar conjuntos');
        Alinha(8);
        writeln('2 - União entre dois conjuntos');
        Alinha(9);
        writeln('3 - Intersecção entre dois conjuntos');
        Alinha(10);
        writeln('4 - Diferença entre dois conjuntos');
        Alinha(12);
        writeln('5 - Procurar elemento');
        Alinha(13);
        writeln('6 - Novo conjunto');
        Alinha(15);
        writeln('7 - Autor');
        Alinha(17);
        writeln('8 - Saír');
        Alinha(20);
        write('Opção: ');
        readln(extra);
        opcao:= extra[1];

        Case opcao of
            '1': begin
                    Titulo(28, 'Visualização dos Conjuntos');
                    NomeConjunto('A');
                    MostrarConjunto(x, n1);
                    writeln;
                    NomeConjunto('B');
                    MostrarConjunto(y, n2);
                    Pausa;
                end;
            '2': begin
                    Titulo(30, 'Reunião dos Conjuntos');
                    UniaoConjunto(x, y, z, n1, n2, n3);
                    MostrarConjunto(z, n3);
                    Pausa;
                end;
            '3': begin
                    Titulo(30, 'Reunião dos Conjuntos');
                    InterseccaoConjunto(x, y, z, n1, n2, n3);
                    MostrarConjunto(z, n3);
                    Pausa;
                end;
            '4': begin
                    Titulo(30, 'Reunião dos Conjuntos');
                    DiferencaConjunto(x, y, z, n1, n2, n3);
                    MostrarConjunto(z, n3);
                    Pausa;
                end;
            '5': repeat
                    Titulo(30, 'Localização de Valor');
                    write('valor a localizar: ');
                    readln(valor);
                    writeln;
                    writeln('Conjunto A');
                    ProcurarElemento(valor, x, n1);
                    writeln;
                    writeln;
                    NomeConjunto('B');
                    ProcurarElemento(valor, y, n2);
                    writeln;
                    writeln;
                    write('Repetir (s/n): ');
                    readln(extra);
                    uprstring(extra, true);
                    tecla:=  extra[1];
                until tecla = 'N';
            '6': repeat
                    desistir:=  false;
                    Titulo(30, 'Definição de Conjuntos');
                    write('Conjunto a editar (A, B, N: Saír): ');
                    readln(extra);
                    uprstring(extra, true);
                    tecla:= extra[1];
                    writeln;
                    writeln;
                    Case tecla of
                        'A': begin
                                NomeConjunto('A');
                                ConstroiConjunto(x, n1);
                            end;
                        'B': begin
                                NomeConjunto('B');
                                ConstroiConjunto(y, n2);
                            end;
                        'N': desistir:= true;
                    end;

                    if desistir = false then
                    begin
                        writeln;
                        write('Repetir (s/n): ');
                        readln(extra);
                        uprstring(extra, true);
                        tecla:= extra[1];
                    end;
                until tecla = 'N';
            '7': begin
                    Titulo(32, 'Autor do Programa');
                    gotoxy(20, 6);
                    writeln('Análise e Desenvolvimento de Algoritmos');
                    gotoxy(22, 8);
                    writeln('professor: António Ferreira Pereira');
                    gotoxy(25, 11);
                    writeln('Paulo G.P.');
                    gotoxy(36, 12);
                    writeln('23 134');
                    gotoxy(1, 21);
                    writeln('27 de Novembro de 2001');
                    Pausa;
                end;
            '8': halt;
        end;
    until opcao = '8';
end.