




                                APNDICE G            
            
                      RESPOSTAS DOS EXERCCIOS PROPOSTOS 
            
            
            CAPTULO 1            
            1) a) Sin(2*x) = 2*Sin(x)*Cos(x)  b) x*x*x + 5*x*x - 2*x + 4
               c) 1/(Ln(x + Ln(x)) + 1)       d) Exp(ArcTan(x) + Abs(x))
            
            2) a) i) 6      ii) -3      iii) 0      iv) 1      v) 0,5
               b) i) a  inteiro e 1 + 3*y  real
                 ii) (n-1)/2  real, logo no pode ser parmetro de MOD
                iii) falta fechar um parntese
                 iv) z + 5 no  um nome de identificador vlido
            
            3) a) TRUE     b) TRUE      c) FALSE      d) TRUE
            
            4) a) FALSE    b) TRUE      c) FALSE      d) FALSE
            
            CAPTULO 2            
            1) a) 2.8317000000E+00   2247200
               b)     2.83   2247200
               c) O telefone da UFPB  2247200
            
            2) - Falta um USES CRT;
               - Falta um ponto-e-vrgula depois de "REAL"
               - Aps o END final, deve vir um ponto, e no um ponto-e-
            vrgula
            
            3) PROGRAM Vetores;
            
               (* Calcula os produtos vetorial e escalar de v e w *)
            
               VAR
                 a, b,           (* coordenadas do vetor v *)
                 x, y, z,          (* coordenadas do vetor w *)
                 ProdInterno,      (* produto interno v.w    *)
                 vet1, vet2, vet3: (* coordenadas de v x w   *)
                                   REAL;
            
               BEGIN
                 Write('Forneca as coordenadas de v: ');
                 Readln(a, b, c);
                 Write('Forneca as coordenadas de w: ');
                 Readln(x, y, z);
            
                 ProdInterno := a*x + b*y + c*z;
                 vet1 := b*z - c*y;
                 vet2 := c*x - a*z;
                 vet3 := a*y - b*x;
            
                 Writeln;

                                       - 234 -





                 Writeln('v.w = ', ProdInterno:8:4);
                 Writeln;
                 Writeln('v x w = (', vet1:8:4, ',', vet2:8:4, ',',
                          vet3:8:4, ')' );
               END.
            
            CAPTULO 3            
            1) PROGRAM Cap3_Ex_1;
            
               VAR n: word;
            
               BEGIN
                 Write('Forneca um inteiro positivo n: '); Readln(n);
            
                 IF (n mod 7 = 0) THEN
                   Writeln('n e'' multiplo de 7.')
                 ELSE
                   Writeln('n nao e'' multiplo de 7.');
            
                 IF (1992 mod n = 0) THEN
                   Writeln('n e'' divisor de 1992')
                 ELSE
                   Writeln('n nao e'' divisor de 1992');
            
                 IF Sqr(Round(Sqrt(n))) = n THEN
                   Writeln('a raiz quadrada de n e'' inteira')
                 ELSE
                   Writeln('a raiz quadrada de n nao e'' inteira');
                 (* Outra possibilidade para esse IF:
                    ---------------------------------
                    IF Frac(Sqrt(n)) = 0 THEN ... Apesar de mais simples
                    que a primeira, pode ter problemas de aproximacao *)
            
               END.
            
            2) PROGRAM IR;
            
               VAR
                 imposto: real;
                 salario: longint;
            
               BEGIN
                 Write('Forneca o valor do salario: '); Readln(salario);
            
                 if (salario <= 200000) then
                   imposto := 0
                 else if (salario >= 200001) and (salario<= 300000) then
                   imposto := salario*0.05 - 10000
                 else if (salario >= 300001) and (salario<= 400000) then
                   imposto := salario*0.10 - 25000
                 else if (salario >= 400001) and (salario<= 500000) then
                   imposto := salario*0.15 - 45000
                 else if (salario >= 500001) then

                                       - 235 -





                   imposto := salario*0.20 - 70000;
            
                 Writeln('Imposto a pagar = ', imposto:10:2);
               END.
            
            3) a) x = 4    b) x = 5    c) x = 2    d) x = 5    e) x = 0
            
            4) So equivalentes [(c) e (d)] e [(b) e (f)].
            
            CAPTULO 4            
            1) PROGRAM SomaProdPares;
               {$E+,N+} (* ---> para poder usar o tipo "extended" *)
               VAR
                 soma, produto: extended;
                 n: byte;
            
               BEGIN
                 soma := 0; produto := 1;
                 for i := 1 to 49 do
                 begin
                   soma := soma + 2*i;
                   produto := produto*(2*i);
                 end;
                 Writeln('Soma = ', soma:8:0,' Produto = ',produto:8:0);
               END.
            
            2) a) PROGRAM Somatorio1;        b) PROGRAM Somatorio2;
            
                  VAR                           VAR
                    soma: real;                   soma: real;
                    i: byte;                      i: byte;
            
                  BEGIN                         BEGIN
                    soma := 0;                    soma := 0;
                    for i := 1 to 50 do           for i := 1 to 100 do
                      soma := soma + (2*i-1)/i;     if Odd(i) then
                    Writeln('S = ', soma:10:2);       soma := soma + 1/i
                  END.                              else
                                                      soma := soma -1/i;
                                                  Writeln('S = ',
                                                             soma:10:2);
                                                END.
            
            3) PROGRAM DuploSomatorio;
            
               VAR
                 i, j: byte;
                 s: real;
            
               BEGIN
                 s := 0;
                 for i := 1 to 30 do
                   for j := 1 to 40 do

                                       - 236 -





                     s := s + Exp(Ln(Sin(1/i + 1/j))/3);
                 Writeln('S = ', s:10:2);
               END.
            
            4) a) PROGRAM Divisores;
            
                  VAR n, d: longint;
            
                  BEGIN
                    Write('Valor de N? '); Readln(n);
                    Writeln('Divisores positivos menores do que N:');
                    for d := 1 to n div 2 do
                      if (n mod d = 0) then
                        Writeln(d:10);
                  END.
            
               b) PROGRAM NumerosPerfeitos;
            
                  VAR
                    n, d, soma: word;
            
                  BEGIN
                    for n := 1 to 1000 do
                    begin
                      soma := 0; { valor inicial da soma dos divisores }
            
                      for d := 1 to n div 2 do   { Para cada divisor d }
                        if (n mod d = 0) then       { de n,  feito um }
                          soma := soma + d;    { acrscimo de d unida- }
                      if (soma = n) then Write(n:5);     { des  soma. }
                    end;
                  END.
            
            5) PROGRAM NumerosComo9801;
            
               VAR
                 n: word;
            
               BEGIN
                 for n := 1000 to 9999 do
                   if Sqr(n div 100 + n mod 100) = n then
                     Writeln(n);
               END.
            
            6) PROGRAM ContagemDeNumPositivos;
            
               VAR
                 n, cont: word;
            
               BEGIN
                 cont := 0;
                 for n := 1 to 1000 do
                   if Sin(n/91)/Cos(n/17) > 0 then
                     cont := cont + 1;

                                       - 237 -





                 Writeln('Resp.: ', cont, ' numeros positivos.');
               END.
            
            7) PROGRAM DistanciaEntre2Pontos;
            
               VAR
                 a, b,  d, distancia: real;
            
               BEGIN
                 repeat
                   Write('Forneca 4 numeros: '); Readln(a, b,  d);
                   distancia := Sqrt(Sqr(a - c) + Sqr(b - d));
                   Writeln('Distancia = ', distancia:8:4);
                 until (a = 0) and (b = 0) and (c = 0) and (d = 0)
               END.
            
            8) PROGRAM Fatorial;
            
               VAR
                 n, i: integer;
                 fat: real;
            
               BEGIN
                 n := 0;
                 repeat
                   n := n + 1;
                   fat := 1;
                   for i := 2 to n do
                     fat := fat*i;
                 until (fat > 1E10);
                 Writeln(n, ' e'' o menor inteiro que tem fatorial ',
                                               'maior que 10 bilhoes.');
               END.
            
            9) PROGRAM Desigualdade;
            
               VAR
                 n: integer;
                 teste: boolean;
                 x: real;
            
               BEGIN
                 n := 0;
                 repeat
                   n := n + 1;
                   x := 3 + 1/n;
                   teste := Abs(Exp(x+Exp(-x)) - Exp(3+Exp(-3)))< 0.001;
                 until teste;
                 Writeln('x = ', x:9:6);
               END.
            
            10) PROGRAM ProvaDe25Questoes;
            
                VAR

                                       - 238 -





                  gab: string[25];
                  n, quant, acertos: integer;
                  nota, soma, media: real;
            
                CONST
                  Gabarito_Correto: string =
                                            'ACEDBCAEDABECDDACABECDEBA';
                  Valor_de_cada_questao: real = 0.4;
            
                BEGIN
                  soma := 0;    (* valor inicial da soma das notas *)
                  quant := 0;   (* quantidade inicial de notas     *)
            
                  repeat
                    quant := quant + 1;
                    Writeln(' ':23, '....|....|....|....|....|');   
                    Write('Forneca o gabarito ', quant:2, ': ');
                    Readln(gab);
                    nota := 0;
                    if Length(gab) = 25 then
                    begin
                      for n := 1 to 25 do
                        if UpCase(gab[n]) = Gabarito_Correto[n] then
                          nota := nota + Valor_de_cada_questao;
                      soma := soma + nota;
                      Writeln('Nota = ', nota:6:2);
                    end;
                  until Length(gab) <> 25;
            
                  media := soma/(quant - 1);
                  Writeln;
                  Writeln('Media das notas = ', media:6:2);
                END.
            
                 A funo  UPCASE  transforma  uma  letra  minscula  na
            respectiva letra maiscula.
            
            CAPTULO 5            
            1) a) FUNCTION Multiplo(n, p: integer): boolean;
                  begin
                    Multiplo := (n mod p = 0)
                  end;
            
               b) FUNCTION Bin(m, n: word): word;
                  begin
                    Bin := Fat(m) DIV (Fat(m - n)*Fat(n))
                  end; (* Fat  a funo fatorial definida no Cap. 5 *)
            
               c) FUNCTION QDiv(n: word): word;
                  var
                    d, quant: word;
                  begin
                    quant := 0;

                                       - 239 -





                    for d := 1 to n do
                      if (n mod d = 0) then
                        quant := quant + 1;
                    QDiv := quant
                  end;
            
               d) FUNCTION Distancia(x, y: string): byte;
                  var
                    i, dif: byte;
                  begin
                    dif := 0;
                    if Length(x) <> Length(y) then Exit;
                    for i := 1 to Length(x) do
                      if x[i] <> y[i] then
                        dif := dif + 1;
                    Distancia := dif
                  end;
            
               e) FUNCTION Inverso(x: string): string;
                  var
                    i: byte;
                    aux: string;
                  begin
                    for i := 1 to Length(x) do
                      aux[Length(x) - i + 1] := x[i];
                    Inverso := aux
                  end;
            
               f) FUNCTION Retira(ch: char; str: string): string;
                  var
                    aux: string;
                    i: byte;
                  begin
                    aux := '';
                    for i := 1 to Length(str) do
                      if str[i] <> ch then
                        aux := aux + str[i];
                    Retira := aux
                  end;
            
            2) TYPE
                 FuncaoDe2Variaveis = function(x, y: real): real;
            
               FUNCTION DParcial(f: FuncaoDe2Variaveis; coord: byte;
                                 a, b: real): real;
               const
                 h = 1E-10;
               begin
                 if (coord = 1) then
                   DParcial := (f(a + h, b) - f(a, b))/h
                 else
                   DParcial := (f(a, b + h) - f(a, b))/h
               end;
            

                                       - 240 -





            
            3) FUNCTION Maiuscula(x: string): string;
               var
                 i: byte;
                 aux: string;
               begin
                 aux := x;
                 for i := 1 to Length(x) do
                   if (x[i] >= 'a') and (x[i] <= 'z') then
                     aux[i] := Chr(Ord(x[i]) - 32);
                 Maiuscula := aux
               end;
            
                 A funo  MINSCULA   anloga a  essa,  com  diferena
            apenas no seguinte IF:
            
                   if (x[i] >= 'A') and (x[i] <= 'Z') then
                     aux[i] := Chr(Ord(x[i]) + 32);
            
            4) PROGRAM BinomioDeNewton;
            
               VAR
                 a, b, n, i: shortint;
                 coeficiente: real;
                 sinal: char;
            
               {$I FUNCOES.PAS} (* FUNCOES.PAS deve conter as defini- *)
                                (* coes de POT e BIN.                 *)
            
               BEGIN
                 Writeln('                            n');
                 Writeln('Desenvolvimento de (ax + by)');
                 Writeln;
                 Write('Valor de a = '); Readln(a);
                 Write('Valor de b = '); Readln(b);
                 Write('Valor de n = '); Readln(n);
            
                 if b > 0 then sinal := '+' else sinal := '-';
                 Writeln;
                 Write('(', a, 'x ', sinal, Abs(b), 'y)^', n,  ' = ');
            
                 for i := 0 to n do
                 begin
                   coeficiente := Bin(n, i)*Pot(a, n - i)*Pot(b, i);
                   if coeficiente > 0 then sinal := '+' else sinal:='-';
                   coeficiente := Abs(coeficiente);
                   Write(sinal, coeficiente:8:0, 'x^', n-i,' y^',i,'  ')
                 end;
            
                 Writeln; Writeln;
                 Writeln('Notacao: m^n = m elevado a n');
               END.
            
            

                                       - 241 -





            CAPTULO 8            
            1) PROGRAM Ex_1_Cap_8;
            
            TYPE
              sequencia = array [1..20] of real;
            
            VAR
              a: sequencia;
              i: byte;
              s: real;
            
            BEGIN
              Writeln('Forneca os 20 elementos da sequencia:');
              for i := 1 to 20 do Read(a[i]);
              s := 0;
              for i := 1 to 20 do
                s := s + a[i]/(Sqr(a[21 - i]) + 1);
              Writeln('S = ', s:10:2)
            END.
            
            2) PROGRAM VetorDeVetores;
            
            CONST
              quant = 50;
            
            TYPE
              vetor = array [1..quant] of real;
            
            VAR
              w: vetor;
              v: array[1..4] of vetor;
              i, j: byte;
              s, min: real;
            
            BEGIN
              for j := 1 to 4 do
              begin
                Writeln('Forneca os elementos de V[', j, ']:');
                for i := 1 to quant do Read(v[j][i]);
              end;
            
              (* Caso (a) *)
              for i := 1 to quant do
                W[i] := (v[1][i] + v[2][i] + v[3][i] + v[4][i])/4;
            
              (* Caso (b) *)
              for i := 1 to quant do
              begin
                min := v[1][i];
                s := 0;
                for j := 1 to 4 do
                begin
                  if (min > v[j][i]) then min := v[j][i];

                                       - 242 -





                  s := s + v[j][i];
                end;
                W[i] := (s - min)/3
              end;
            END.
            
            3) PROGRAM Multiplicando_polinomios;
            
            CONST
              GrauMax = 30; (* Grau maximo dos polinomios *)
            
            TYPE
              polinomio = record
                grau: byte;
                a: array [0..GrauMax] of real
              end;
            
            (* ------------------------------------------------------ *)
            
            PROCEDURE MultiplicaPolinomios(f, g: polinomio;
                                                      VAR p: polinomio);
            
            (* Calcula p(x) = f(x)g(x) *)
            
            VAR
              soma: real;
              i, k: byte;
            
            BEGIN
              p.grau := f.grau + g.grau;
            
              for i := f.grau + 1 to p.grau do  (* Anula alguns coefi-*)
                f.a[i] := 0;                    (* cientes  de  f e g *)
              for i := g.grau + 1 to p.grau do  (* que serao necessa- *)
                g.a[i] := 0;            (* rios no calculo de p.a[i]. *)
            
              for k := 0 to p.grau do
              begin
                soma := 0;
                for i := 0 to k do
                  soma := soma + f.a[i]*g.a[k - i];
                p.a[k] := soma;
              end;
            END;
            
            (* ------------------------------------------------------ *)
            
            VAR
              f, g, p: polinomio;
              i: byte;
            
            BEGIN (* Inicio do programa principal *)
              Writeln;
              Write('Grau do polinomio f(x): '); Readln(f.grau);

                                       - 243 -





              Writeln('Coeficientes de f(x) (ordem decrescente das'
                                                ' potencias de "x") :');
              for i := f.grau downto 0 do Read(f.a[i]);
              Writeln;
              Write('Grau do polinomio g(x): '); Readln(g.grau);
              Writeln('Coeficientes de g(x) (ordem decrescente das'
                                                ' potencias de "x") :');
              for i := g.grau downto 0 do Read(g.a[i]);
            
              MultiplicaPolinomios(f, g, p);
            
              Writeln;
              Write('Grau de p(x) = f(x)g(x) : '); Writeln(p.grau);
              Writeln('Coeficientes de p(x) (ordem decrescente das'
                                                ' potencias de "x") :');
              for i := p.grau downto 0 do
                Write(p.a[i]:8:2);
            END. (* Fim do programa *)
            
            4) TYPE
                 matriz = record
                   linhas, colunas: byte;
                   a: array [1..10, 1..10] of real
                 end;
            
            PROCEDURE Transposta(m: matriz; VAR t: matriz);
            
            VAR
              i, j: byte;
            
            BEGIN
              t.linhas := m.colunas;
              t.colunas := m.linhas;
              for i := 1 to t.linhas do
                for j := 1 to t.colunas do
                  t.a[i, j] := m.a[j, i]
            END;
            
            5) PROGRAM Matriz_aleatoria;
            
            USES
              Crt;
            
            TYPE
              matriz = record
                linhas, colunas: byte;
                a: array [1..10, 1..10] of shortint
              end;
            
            PROCEDURE MatrizAleatoria(VAR m: matriz);
            
            VAR
              i, j: byte;
            

                                       - 244 -





            BEGIN
              Randomize;
              m.linhas := 1 + Random(10);
              m.colunas := 1 + Random(10);
              for i := 1 to m.linhas do
                for j := 1 to m.colunas do
                  m.a[i, j] := Random(3) - 1
            END;
            
            VAR
              m: matriz;
              i, j: byte;
            
            BEGIN
              repeat
                MatrizAleatoria(m);
                Writeln; Writeln;
                for i := 1 to m.linhas do
                begin
                  for j := 1 to m.colunas do
                    Write(m.a[i,j]:4);
                  Writeln;
                end;
                Delay(1000);
              until KeyPressed;
            END.
            
            6) CONST
                 max = 10; (* Quantidade maxima de linhas ou colunas *)
            
            TYPE
              matriz = record
                m, n: byte;
                elem: array[1..max, 1..max] of real
              end;
            
            a) FUNCTION Traco(mat: matriz): real;
            
            VAR
              i: byte;
              soma: real;
            
            BEGIN
              if (mat.m <> mat.n) then Exit;
              soma := 0;
              for i := 1 to mat.m do
                soma := soma + mat.elem[i, i];
              Traco := soma
            END;
            
            b) FUNCTION Simetrica(mat: matriz): boolean;
            
            VAR
              i, j: byte;

                                       - 245 -





            
            BEGIN
              if (mat.m <> mat.n) then
              begin
                Simetrica := false;
                Exit
              end
              else
              begin
                for i := 1 to mat.m do
                  for j := 1 to mat.n do
                    if (mat.elem[i, j] <> mat.elem[j, i]) then
                    begin
                      Simetrica := false;
                      Exit
                    end;
              end;
              Simetrica := true;
            END;
            
            c) FUNCTION Diagonal(mat: matriz): boolean;
            
            VAR
              i, j: byte;
            
            BEGIN
              if (mat.m <> mat.n) then
              begin
                Diagonal := false;
                Exit
              end
              else
              begin
                for i := 1 to mat.m do
                  for j := 1 to mat.n do
                    if (i <> j) and (mat.elem[i, j] <> 0) then
                    begin
                      Diagonal := false;
                      Exit
                    end;
              end;
              Diagonal := true;
            END;
            
            d) FUNCTION SomaQuadrados(mat: matriz): real;
            
            VAR
              soma: real;
              i, j: byte;
            
            BEGIN
              soma := 0;
              for i := 1 to mat.m do
                for j := 1 to mat.n do

                                       - 246 -





                  soma := soma + Sqr(mat.elem[i, j]);
              SomaQuadrados := soma
            END;
            
            e) FUNCTION QNegativos(mat: matriz): word;
            
            VAR
              i, j: byte;
              quant: word;
            
            BEGIN
              quant := 0;
              for i := 1 to mat.m do
                for j := 1 to mat.n do
                  if (mat.elem[i, j] < 0) then Inc(quant);
              QNegativos := quant
            END;
            
            f) FUNCTION QLinhasNulas(mat: matriz): word;
            
            VAR
              i, j: byte;
              soma: real;
              quant: word;
            
            BEGIN
              quant := 0;
              for i := 1 to mat.m do
              begin
                soma := 0;
                for j := 1 to mat.n do
                  soma := soma + Abs(mat.elem[i, j]);
                if soma = 0 then Inc(quant)
              end;
              QLinhasNulas := quant;
            END;
            
            7) TYPE
                 vetor = record
                   n: byte;
                   elem: array [1..100] of integer
                 end;
            
            PROCEDURE EliminaRepeticao(v: vetor; VAR w: vetor);
            
            VAR
              j, k : byte;
              elemento_repetido: boolean;
            
            BEGIN
            
            (* O primeiro elemento de v  o primeiro elemento de w *)
              w.n := 1; w.elem[1] := v.elem[1];
            

                                       - 247 -





            (*
               Para cada elemento de v, a partir do segundo, o FOR j...
               a seguir testa se esse elemento ja' esta' em w. Se esti-
               ver, entao ele  e'  ignorado;  se  nao estiver, entao  o
               tamanho de w e' aumentado e o elemento e' inserido em w.
            *)
            
              for k := 2 to v.n do
              begin
                elemento_repetido := false;
                for j := 1 to w.n do
                  if v.elem[k] = w.elem[j] then
                    elemento_repetido := true;
                if not elemento_repetido then
                begin
                  Inc(w.n);
                  w.elem[w.n] := v.elem[k]
                end;
              end;
            END;
            
            
            CAPTULO 9            
            1) PROGRAM ContaLetras;
            
            VAR
              arq: text;
              nome: string;
              ch: char;
              n: word; (* quantidade de letras "A" *)
            
            BEGIN
              if (ParamCount = 0) then Halt;
              nome := ParamStr(1);
              Assign(arq, nome);
              Reset(arq);
              n := 0;
              repeat
                Read(arq, ch);
                if (UpCase(ch) = 'A') then Inc(n);
              until Eof(arq);
              Writeln(nome, ' tem ', n, ' letras "A".');
              Close(arq)
            END.
            
            2) PROGRAM EliminaVirgulas;
            
            VAR
              arq, arq_aux: text;
              nome1, nome2: string;
              ch: char;
            
            BEGIN

                                       - 248 -





              if (ParamCount < 2) then Halt;
              nome1 := ParamStr(1);
              nome2 := ParamStr(2);
              Assign(arq, nome1);
              Assign(arq_aux, nome2);
              Reset(arq);
              Rewrite(arq_aux);
              repeat
                Read(arq, ch);
                if (ch <> ',') then Write(arq_aux, ch);
              until Eof(arq);
              Close(arq);
              Close(arq_aux);
            END.
            
            3) So  os caracteres  #13 e  #10, que no aparecem na tela.
            Para descobri-los,  declare o  arquivo como sendo um FILE OF
            BYTE e liste os bytes do arquivo na tela.
            
            4) PROGRAM Nomes_salarios_matriculas;
            
            CONST
              quant = 100; (* Quantidade de funcionarios *)
            
            TYPE
              registro1 = record
                matricula: string[10];
                salario: real
              end;
            
              registro2 = record
                matricula: string[10];
                nome: string[30]
              end;
            
              registro_auxiliar = record
                nome: string[30];
                salario: real
              end;
            
              vetor1    = array [1..quant] of registro1;
              vetor2    = array [1..quant] of registro2;
              vetor_aux = array [1..quant] of registro_auxiliar;
            
              arquivo1 = file of vetor1;
              arquivo2 = file of vetor2;
            
            PROCEDURE Classifica(VAR v: vetor_aux);
            
            (* Ordena alfabeticamente o vetor de registros VETOR_AUX *)
            
            PROCEDURE Troca(VAR v1, v2: registro_auxiliar);
            
            VAR

                                       - 249 -





              aux: registro_auxiliar;
            
            BEGIN
              aux := v1; v1 := v2; v2 := aux
            END; (* fim de TROCA *)
            
            VAR
              i: byte;
              esta_ordenado: boolean;
            
            BEGIN (* Inicio de CLASSIFICA *)
              repeat
                esta_ordenado := true;
                for i := 1 to quant - 1 do
                  if v[i].nome > v[i + 1].nome then
                  begin
                    esta_ordenado := false;
                    Troca(v[i], v[i + 1]);
                  end;
              until esta_ordenado;
            END; (* fim de CLASSIFICA *)
            
            VAR
              v1: vetor1;
              v2: vetor2;
              aux: vetor_aux;
              arq1: arquivo1;
              arq2: arquivo2;
              i, j: byte;
            
            CONST
              nome1: string[12] = 'C:\ARQUIVO.1';
              nome2: string[12] = 'C:\ARQUIVO.2';
            
            BEGIN (* Inicio do programa principal *)
              Assign(arq1, nome1);
              Assign(arq2, nome2);
              Reset(arq1);
              Reset(arq2);
              Read(arq1, v1);
              Read(arq2, v2);
              Close(arq1);
              Close(arq2);
            
              for i := 1 to quant do
              begin
                aux[i].nome := v2[i].nome;
                j := 0;
                repeat
                  Inc(j);
                until v2[i].matricula = v1[j].matricula;
                aux[i].salario := v1[j].salario;
              end;
            

                                       - 250 -





              Classifica(aux);
              Writeln('             NOME                     SALARI);
              Writeln('----------------------------------------------');
              for i := 1 to quant do
                Writeln(aux[i].nome:32, aux[i].salario:15:2);
              Writeln('----------------------------------------------');
            END.  (* Fim do programa *)
            
            5) PROGRAM Imprimindo_letras_acentuadas;
            
            USES
              Printer;
            
            VAR
              arq: file of char;
              x, y, z: char;
            
            CONST
              Acentos: SET OF char = [',' , '''', '`', '^', '~', '"'];
            
            BEGIN
              if (ParamCount = 0) then Halt;
              Assign(arq, ParamStr(1));
              Reset(arq);
            
              repeat
                Read(arq, x);
                if (x = '\') then
                begin
                  Read(arq, y);
                  if y in Acentos then
                  begin
                    Read(arq, z);
                    Write(Lst, y, #8, z)
                  end
                  else
                    Write(Lst, x, y)
                end
                else
                  Write(Lst, x);
              until Eof(arq);
            
              Close(arq)
            END.
            
            
            CAPTULO 10            
            1) a[1]^ := 'Razinha'; a[2]^ := 'Marina';  ...
            
               b^[1]^ := 'Teste'; b^[2]^ := '5/2/92';  ...
            
               c[1]^.x := 1;   (* Analogamente definem-se *)
               c[1]^.y := 2;   (* c[2]^.x, c[2]^.y, etc.  *)

                                       - 251 -





               c[1]^.z := 3;
            
               d.sol1^[1]^.x := 3;  ...  d.sol1^[5]^.z := 4;
               d.sol2^[1]^.x := 2;  ...  d.sol2^[8]^.z := 0;
               d.sol3^.centro.x := 0;  d.sol3^.centro.y := -1;
               d.sol3^.centro.z := 1;  d.sol3^.raio := 2;
            
            2) TYPE
                 MatTela = array [1..4000] of byte;
            
            PROCEDURE GravaTela(nome_arq: string);
            
            (* Grava a tela no arquivo de nome NOME_ARQ *)
            
            VAR
              arq: file of MatTela;
              X: MatTela;
              T: MatTela absolute $b800:0;
            
            BEGIN
              Move(T, X, 4000);
              Assign(arq, nome_arq);
              Rewrite(arq);
              Write(arq, X);
              Close(arq)
            END;
            
            PROCEDURE LeTela(nome_arq: string);
            
            (* Le no arquivo de nome NOME_ARQ uma tela *)
            
            VAR
              arq: file of MatTela;
              X: MatTela;
              T: MatTela absolute $b800:0;
            
            BEGIN
              Assign(arq, nome_arq);
              Reset(arq);
              Read(arq, X);
              Close(arq);
              Move(X, T, 4000)
            END;
            
            
            CAPTULO 11            
            1) FUNCTION Pot(x: real; n: word): real;
            
               BEGIN
                 if (n = 0) then
                   Pot := 1
                 else
                   Pot := x*Pot(x, n - 1)

                                       - 252 -





               END;
            
            2) FUNCTION Fib(n: byte): longint;
            
               BEGIN
                 if n <= 2 then
                   Fib := 1
                 else
                   Fib := Fib(n - 2) + Fib(n - 1)
               END;
            
            3) FUNCTION Per(n: word): real;
            
                 function L(n: word): real;
            
                 {$I POT_2.PAS}  (* POT_2.PAS foi definido no cap. 5 *)
            
                 begin
                   if not PotenciaDeDois(n) then
                   begin
                     Writeln(n, ' nao e'' potencia de 2.');
                     Halt
                   end
                   else
                     if (n = 4) then
                       L := Sqrt(2)
                     else
                       L := Sqrt(2 - Sqrt(4 - Sqr(L(n div 2))))
                 end;
            
               begin
                 Per := n*L(n)
               end;
            
            4) Apresentaremos  apenas o fragmento principal do programa.
            Suporemos que os algoritmos de classificao esto definidos
            nos procedimentos QuickSort e Classifica.
                      ...
                      for i := 1 to 1000 do v[i] := Random(20001);
                      w := v;
                      GetTime(h, min, seg, cents);
                      inicio := h*3600 + min*60 + seg + cents/100;
                      QuickSort(v, 1, 1000);
                      GetTime(h, min, seg, cents);
                      fim := h*3600 + min*60 + seg + cents/100;
                      Tempo_gasto_pelo_QuickSort := fim - inicio;
                      w := v;
                      GetTime(h, min, seg, cents);
                      inicio := h*3600 + min*60 + seg + cents/100;
                      Classifica(v, 1, 1000);
                      GetTime(h, min, seg, cents);
                      fim := h*3600 + min*60 + seg + cents/100;
                      Tempo_gasto_pelo_Classifica := fim - inicio;
                      ...

                                       - 253 -
