Exercicios - Folha 2

{ paulogp }
{ mac os 7 }
program Ada21p;

uses
    MemTypes, QuickDraw, OSIntf;

const
    MAX = 1000;
    MX = 10;

type
    x = array[1..MX] of integer;

var
    i: integer;
    tecla, opcao: string;
    chave: char;
    vector: x;

procedure acerca;
begin
    clearscreen;
    writeln('Paulo G.P.');
    writeln;
    writeln('27 de Dezembro de 2001');
    writeln;
    writeln('Prima uma tecla para continuar.');
    readln;
end;

{* Exercício 1a *}
function soma_rec(n: integer): integer;
begin
    if n=1 then soma_rec:= 1 else soma_rec:= soma_rec(n - 1) + n;
end;

procedure exercicio1a;
const
    MAX = 900;
    MIN = 0;

var
    n, soma: integer;

begin
    clearscreen;
    writeln('Exercício 1');
    writeln('Alínea a)');
    writeln('------------');
    writeln;
    soma:= 0;
    n:= 1;
    repeat
        writeln;
        if (n >= MAX) or (n <= MIN) then writeln('Atenção!!!');
        write('Introduza um número inteiro positivo ]', MIN, ';', MAX, '[: ');
        readln(n);
    until (n > MIN) and (n < MAX);
    writeln;
    writeln('soma = ', soma_rec(n));
    writeln;
    writeln;
    write('Repetir (s/n): ');
    readln(opcao);
    uprstring(opcao, true);
    if opcao = 'S' then exercicio1a;
end;

{** Exercício 1b **}
function fact_rec(n: integer): integer;
begin
    if (n = 0) or (n = 1) then fact_rec:= 1 else
    fact_rec:= fact_rec(n - 1) * n;
end;

procedure exercicio1b;
const
    MAX = 18;
    MIN = 0;

var
    n: integer;

begin
    clearscreen;
    writeln('Exercício 1');
    writeln('Alínea b)');
    writeln('------------');
    writeln;
    n:= 1;
    repeat
        writeln;
        if (n >= MAX) or (n <= MIN) then writeln('Atenção!!!');
        write('Introduza um número inteiro positivo ]', MIN, ';', MAX, '[: ');
        readln(n);
    until (n >= MIN) and (n < MAX);
    writeln;
    writeln('b) Fact = ', fact_rec(n));
    writeln;
    writeln;
    write('Repetir (s/n): ');
    readln(opcao);
    uprstring(opcao, true);
    if opcao='S' then exercicio1b;
end;

{** Exercício 1c **}
function mdc(a, b: integer): integer;
begin
    if b = 0 then mdc:= a else mdc:= mdc(b, a mod b);
end;

function mmc(a, b: integer): integer;
begin
    if (a = 0) or (b = 0) then mmc:= 0 else mmc:= (a * b) div (mdc(a, b));
end;

procedure exercicio1c;
var
    a,b: integer;

begin
    clearscreen;
    writeln('Exercício 1');
    writeln('Alínea c)');
    writeln('------------');
    writeln;

    a:= 0;
    b:= 0;

    repeat
        writeln;
        if a < 0 then writeln('Atenção!');
        write('Introduza um número inteiro: ');
        readln(a);
    until a >= 0;
    repeat
        writeln;
        if b < 0 then writeln('Atenção!');
        write('Introduza um número inteiro: ');
        readln(b);
    until b >= 0;
    writeln;
    writeln('c) MMC = ', mmc(a, b));
    writeln;
    write('Repetir (s/n): ');
    readln(opcao);
    uprstring(opcao, true);
    if opcao = 'S' then exercicio1c;
end;

{** Exercício 2 **}
function subfactorial(n: integer): integer;
begin
    if n = 0 then subfactorial:= 1 else
    if not odd(n) then subfactorial:= subfactorial(n - 1) * n + 1 else
        subfactorial:= subfactorial(n - 1) * n - 1;
end;

procedure exercicio2a;
const
    MAX = 10;
    MIN = 0;

var
    i, n, x: integer;

begin
    clearscreen;
    writeln('Exercício 2');
    writeln('Alínea a)');
    writeln('------------');
    writeln;
    n:= 1;
    repeat
        writeln;
        if (n >= MAX) or (n < MIN) then writeln('Atenção!');
        write('Introduza um número inteiro positivo [', MIN, ';', MAX, '[: ');
        readln(n);
    until (n >= MIN) and (n < MAX);
    writeln;
    writeln;
    writeln('Factorial recursivo = ', subfactorial(n));
    writeln;
    writeln;
    write('Repetir (s/n): ');
    readln(opcao);
    uprstring(opcao, true);
    if opcao = 'S' then exercicio2a;
end;

{** Exercício 2b **}
procedure exercicio2b;
const
    MAX = 10;
    MIN = 0;

var
    i, n, x: integer;

begin
    clearscreen;
    writeln('Exercício 2');
    writeln('Alínea b)');
    writeln('------------');
    writeln;
    n:= 1;
    repeat
        writeln;
        if (n >= MAX) or (n < MIN) then writeln('Atenção!');
        write('Introduza um número inteiro positivo [', MIN, ';', MAX, '[: ');
        readln(n);
    until (n >= MIN) and (n < MAX);
    writeln;
    writeln;
    x:= 1;
    for i:= 1 to n do
        if odd(i) then x:= x * i - 1 else x:= x * i + 1;
    writeln('Factorial iterativo = ', x);
    writeln;
    writeln;
    write('Repetir (s/n): ');
    readln(opcao);
    uprstring(opcao, true);
    if opcao = 'S' then exercicio2b;
end;

{** Exercício 3a **}
function recur(x: real; n: integer): real;
begin
    if n = 0 then recur:= 1 else
    if n > 0 then recur:= recur(x, n - 1) * x else recur:= recur(x, n + 1) / x;
end;

procedure exercicio3a;
var
    n: integer;
    x: real;

begin
    clearscreen;
    writeln('Exercício 3');
    writeln('Alínea a)');
    writeln('------------');
    writeln;
    n:= 1;
    writeln;
    write('Introduza um número real (x): ');
    readln(x);
    writeln;
    write('Introduza um número inteiro (n): ');
    readln(n);
    writeln;
    writeln;
    writeln('Método recursivo: x^n = ', recur(x, n):2:1);
    writeln;
    writeln;
    write('Repetir (s/n): ');
    readln(opcao);
    uprstring(opcao, true);
    if opcao = 'S' then exercicio3a;
end;

{** Exercício 3b **}
procedure exercicio3b;
var
    i, n: integer;
    x, ite: real;

begin
    clearscreen;
    writeln('Exercício 3');
    writeln('Alínea b)');
    writeln('------------');
    writeln;
    n:= 1;
    writeln;
    write('Introduza um número real (x): ');
    readln(x);
    writeln;
    write('Introduza um número inteiro (n): ');
    readln(n);
    writeln;
    writeln;
    if n = 0 then ite:= 1 else
    if n < 0 then
    begin
        ite:= 1 / x;
        n:= n * (-1);
        for i:= 1 to (n - 1) do ite:= ite * (1 / x);
    end else
    begin
        ite:= x;
        for i:= 1 to (n - 1) do ite:= ite * x;
        if (x < 0) and not odd(n) then ite:= ite * (-1);
    end;
    writeln('Método iterativo: x^n = ', ite:2:4);
    writeln;
    writeln;
    write('Repetir (s/n): ');
    readln(opcao);
    uprstring(opcao, true);
    if opcao = 'S' then exercicio3b;
end;

{** Exercício 4 **}
function Inver(n, a: integer): integer;
begin
    if (n div 10) > 0 then
    begin
        a:= (a + (n mod 10)) * 10;
        Inver:= Inver(n div 10, a);
    end;
    if (n div 10) = 0 then Inver:= a + n;
end;

procedure exercicio4;
var
    n: longint;

begin
    clearscreen;
    writeln('Exercício 4');
    writeln('------------');
    writeln;
    n:= 1;
    repeat
        writeln;
        if n<0 then writeln('Atenção!');
        write('Introduza um número inteiro: ');
        readln(n);
    until (n >= 0) and (n <= 9000);
    writeln;
    writeln('número inserido:  ', n);
    writeln;
    writeln('número invertido: ', Inver(n, 0));
    writeln;
    writeln;
    write('Repetir (s/n): ');
    readln(opcao);
    uprstring(opcao, true);
    if opcao = 'S' then exercicio4;
end;

{** Exercício 5 **}
function locate (v:x;k,comp:integer):integer;
begin
    if comp = 1 then
    if v[1] = k then locate:= 1 else locate:= 0;
    if comp > 1 then
        if v[comp] = k then locate:= locate(v, k, comp - 1) + 1 else
            locate:= locate(v, k, comp - 1);
end;

procedure exercicio5;
var
    k, i, comp: integer;

begin
    clearscreen;
    writeln('Exercício 5');
    writeln('-----------');
    writeln;
    repeat
        write('Comprimento do vector: ');
        readln(comp);
        if (comp <= 0) or (comp > MX) then writeln('Atenção!');
        writeln;
    until (comp > 0) and (comp <= MX);
    writeln;
    for i:= 1 to comp do
    begin
        write('vector[', i,'] = ');
        readln(vector[i]);
    end;
    writeln;
    write('v = [ ');
    for i:= 1 to comp - 1 do write(vector[i], ', ');
    write(vector[comp], ']');
    writeln;
    writeln;
    write('Elemento a localizar: ');
    readln(k);
    writeln;
    writeln('O elemento ', k, ' ocorre ', locate(vector, k, comp),' vez(es).');
    writeln;
    writeln;
    write('Repetir (s/n): ');
    readln(opcao);
    uprstring(opcao, true);
    if opcao = 'S' then exercicio5;
end;

{** Corpo principal **}
begin
    repeat
        clearscreen;
        writeln('Folha 2 - ADA.');
        writeln('--------------');
        writeln;
        writeln('Exercício 1:                                  Exercício 4:');
        writeln(' a) Série.                                     h) Ordem inversa.');
        writeln(' b) Factorial.');
        writeln(' c) MMC.                                      Exercício 5:');
        writeln('                                               i) Localizador.');
        writeln('Exercício 2:');
        writeln(' d) Factorial recursivo.');
        writeln(' e) Factorial iterativo.');
        writeln;
        writeln('Exercício 3:');
        writeln(' f) x^n -> Método recursivo.');
        writeln(' g) x^n -> Método iterativo.');
        writeln;
        writeln;
        writeln('? - Acerca dos autores.');
        writeln('s - Saír do programa.');
        writeln;
        write('Opção: ');
        readln(tecla);
        uprstring(tecla, true);
        chave:= tecla[1];
        case chave of
            'A': exercicio1a;
            'B': exercicio1b;
            'C': exercicio1c;
            'D': exercicio2a;
            'E': exercicio2b;
            'F': exercicio3a;
            'G': exercicio3b;
            'H': exercicio4;
            'I': exercicio5;
            '?': acerca;
        end;
    until tecla = 'S';
end.