Wiki Portugal-a-Programar

Ferramentas de Site

Está aqui: Wiki P@P » Desenvolvimento Geral » Pascal » Tutorial de Pascal » Propostas de Resolução de Exercícios e Desafios
dev_geral:pascal:tutorial:resolucao_exdes

Tabela de Conteúdos

Propostas de Resolução de Exercícios e Desafios

Notas Finais <<

São apresentadas propostas de resolução a exercícios e desafios. Os programas aqui apresentados não incluem comentários, excepto o número de linhas utilizado por cada um.

As presentes resoluções são propostas pelo autor. Aceitam-se novas propostas de resolução, funcionais e dentro das normas de cada um.
Faltam propostas de resolução para os seguintes exercícios/desafios:
  • Desafio 5;

Exercício 1

program ex1; // 33 linhas
uses crt;
var a, b : real;
    oper : string[1];
    valido : boolean;
 
begin
     writeln('CALCULADORA SIMPLES');
     write('Valor 1: ');
     readln(a);
 
     repeat
           write('Operador (+, -, /, *): ');
           readln(oper);
     until (oper='+') or (oper='-') or (oper='/') or (oper='*');
 
     repeat
           write('Valor 2: ');
           readln(b);
           if (oper='/') and (b=0) then begin
              valido := false;
              writeln('ERRO! Divisao por zero!');
           end else valido := true;
     until valido;
 
     write('Resultado: ');
 
     if (oper='+') then writeln(a+b:0:10)
     else begin
          if (oper='-') then writeln(a-b:0:10)
          else begin
               if (oper='*') then writeln(a*b:0:10)
               else writeln(a/b:0:10);
          end;
     end;
 
     write('Prima ENTER para fechar...');
     readln;
end.

Exercício 2

program ex2; // 18 linhas
uses crt;
var i, alunos, avaliacao, positivas : integer;
 
begin
     writeln('CONTADOR DE AVALIACOES POSITIVAS');
     write('Numero de alunos? ');
     readln(alunos);
 
     for i:=1 to alunos do begin
         repeat
               write('Nota do aluno ',i,': ');
               readln(avaliacao);
         until ((avaliacao>=0) and (avaliacao<=20));
         if (avaliacao>=10) then positivas := positivas + 1;
     end;
 
     writeln;
     writeln('Existem ',positivas,' positivas (',(positivas/alunos)*100:0:1,'%)');
     readln;
end.

Exercício 3

program ex3; // 19 linhas
uses crt;
var numero, maior : real;
    n, i : integer;
 
begin
     repeat
           write('Quantos numeros vai introduzir? (5-50) ');
           readln(n);
     until (n>=5) and (n<=50);
     maior := 0;
     for i:=1 to n do begin
         write(i,'o numero: ');
         readln(numero);
         if (numero > maior) then maior := numero;
     end;
     writeln;
     writeln('O maior numero foi: ',maior:0:10);
     readln;
end.

Exercício 4

program ex4; // 24 linhas
uses crt;
var s : string;
    i, j : integer;
 
begin
     writeln('Este programa tira os espacos a mais de uma STRING');
     writeln;
     write('Escreva uma STRING: ');
     readln(s);
     j := 0;
     for i:=1 to length(s) do
     begin
          j := j+1;
          if (s[i] = ' ') then begin
             s[j] := ' ';
             while (s[i] = ' ') do
                   i := i+1;
                   j := j+1
             end;
          s[j] := s[i];
     end;
     writeln('Nova STRING: ',s);
     readln;
end.

Exercício 5

program ex5; // 24 linhas
uses crt;
var numero : real;
function factorial(n : integer) : integer;
var i, temp : integer;
begin
     if (n=0) or (n=1) then factorial := 1
     else begin
          temp := n;
          for i:=n-1 downto 1 do begin
              temp := temp * i;
          end;
          factorial := temp;
     end;
end;
 
begin
     repeat
           write('Numero para calcular factorial: ');
           readln(numero);
     until (numero = ROUND(numero)) and (numero>=0);
     writeln;
     writeln('Factorial de ',ROUND(numero),': ',factorial(ROUND(numero)));
     readln;
end.

Exercício 6

program ex6;  // 46 linhas
uses crt;
var a, b : real;
    oper : string[1];
 
begin
     REPEAT
 
     textcolor(15);
     writeln('CALCULADORA SIMPLES');
     write('Valor 1: ');
     readln(a);
     write('Operador (+, -, *, /): ');
     readln(oper);
     if (oper='/') then begin
        repeat
              write('Valor 2: ');
              readln(b);
              if (b=0) then begin
                 textcolor(12);
                 writeln('ERRO! Divisao por zero!');
                 textcolor(15);
              end;
        until (b<>0);
     end else begin
         write('Valor 2: ');
         readln(b);
     end;
     writeln;
     write('RESULTADO da operacao: ');
     textcolor(14);
     if (oper='+') then write(a+b:0:10)
     else begin
          if (oper='-') then write(a-b:0:10)
          else begin
               if (oper='*') then write(a*b:0:10)
               else write(a/b:0:10);
          end;
     end;
     textcolor(15);
     writeln('1 > Repetir operacao');
     writeln('0 > Sair');
     repeat
           readln(oper);
     until (oper='1') or (oper='0');
     if (oper='1') then writeln;
 
     UNTIL (oper='0');
end.

Exercício 7

program ex7;  // 17 linhas
uses crt;
var i, j : integer;
 
begin
     for i:=1 to 20 do begin
         for j:=1 to 45 do begin
             case j of
                  1..15 : textbackground(1);
                  16..30 : textbackground(7);
                  31..45 : textbackground(4);
             end;
             write(' ');
         end;
         writeln;
     end;
     readln;
end.

Exercício 8

program ex8;  // 60 linhas
uses crt;
var aluno : array[1..30] of record  // RECORD referido no exercício
          nome : string[60];
          matematica : real;
          portugues : real;
    end;
    media : record  // RECORD facultativo: depende do método de cada programador
          matematica : real;
          portugues : real;
    end;
    quantos, i : integer;
 
begin
     writeln('ESTATISTICA DA TURMA');
     writeln;
     repeat
           write('Quantos alunos sao? (1-30) ');
           readln(quantos);
     until (quantos>=1) and (quantos<=30);
     writeln;
     for i:=1 to quantos do begin
         writeln('ALUNO ',i);
         with aluno[i] do begin
              write('Nome: ');
              readln(nome);
              repeat
                    write('Media a Matematica: ');
                    readln(matematica);
              until (matematica>=0) and (matematica <=20);
              repeat
                    write('Media a Portugues: ');
                    readln(portugues);
              until (portugues>=0) and (portugues<=20);
         end;
         writeln;
     end;
     for i:=1 to quantos do begin
         media.matematica += aluno[i].matematica;
         media.portugues += aluno[i].portugues;
     end;
     with media do begin
          matematica := matematica / quantos;
          portugues := portugues / quantos;
     end;
     writeln;
     writeln('TURMA');
     writeln('Media a Portugues: ',media.portugues:0:2);
     writeln('Media a Matematica: ',media.matematica:0:2);
     writeln;
     writeln('ALUNOS APTOS A COMPARECER AO EXAME NACIONAL DE MATEMATICA:');
     for i:=1 to quantos do begin
        if (aluno[i].matematica>=9.5) then writeln('   ',aluno[i].nome);
     end;
     writeln;
     writeln('ALUNOS APTOS A COMPARECER AO EXAME NACIONAL DE PORTUGUES:');
     for i:=1 to quantos do begin
         if (aluno[i].portugues>=9.5) then writeln('   ',aluno[i].nome);
     end;
     readln;
end.

Exercício 9

program ex9;  // 48 linhas
uses crt;
var operacao : record
             a : real;
             b : real;
             oper : char;
    end;
    opcao : char;
 
begin
    REPEAT
 
     textbackground(7);
     textcolor(16);
     clrscr;
     writeln('CALCULADORA');
     with operacao do begin
          write('   Valor 1: ');
          readln(a);
          write('   Operacao (+, -, *, /): ');
          repeat
                oper := readkey;
          until (char(oper)='+') or (char(oper)='-') or (char(oper)='*') or (char(oper)='/');
          if (oper='/') then begin
             repeat
                   write('   Valor 2: ');
                   readln(b);
             until (b<>0);
          end else begin
              write('   Valor 2: ');
              readln(b);
          end;
          write('Resultado: ');
          if (char(oper)='+') then write(a+b:0:10)
          else begin
               if (char(oper)='-') then write(a-b:0:10)
               else begin
                    if (char(oper)='*') then write(a*b:0:10)
                    else write(a/b:0:10);
               end;
          end;
     end;
     writeln;
     writeln('1 > Repetir operacao');
     writeln('0 > Sair');
     repeat
           opcao := readkey;
     until (char(opcao)='1') or (char(opcao)='0');
 
     UNTIL (char(opcao)='0');
end.

Exercício 10

program ex10;  // 58 linhas
(* Há muitas mais propostas possíveis, inclusive mais interactivas.
   O objectivo deste é tão-somente exemplificar a utilização dos métodos.*)
uses crt;
var s, sp : string[80];
    a : string[80];
    p, l : byte;
    opc : char;
 
begin
     write('A primeira frase nunca se altera. So pode trabalhar com esta!');
     write('Escreva uma frase: ');
     readln(s);
 
     repeat
           writeln;
           writeln('1 - Procurar');
           writeln('2 - Apagar');
           writeln('3 - Inserir');
           writeln('0 - Sair');
           repeat
                 opc := readkey;
 
                 writeln;
                 if not (opc = '0') then begin
                    writeln('FRASE: ');
                    writeln(s); writeln;
                 end;
 
                 case opc of
                      '1' : begin
                            write('Procurar: ');
                            readln(sp);
                            p := Pos(sp, s);
                            if not (p = 0) then writeln('Primeira ocorrencia na posicao ', p)
                                           else writeln('Nao existe na frase');
                            end;
 
                      '2' : begin
                            write('Posicao onde comecar a apagar: ');
                            readln(p);
                            write('Quantas letras apagar: ');
                            readln(l);
                            a := s;
                            Delete(a, p, l);
                            writeln('Frase final: ', a);
                            end;
 
                      '3' : begin
                            write('Posicao onde comecar a inserir: ');
                            readln(p);
                            write('Expressao a inserir: ');
                            readln(sp);
                            a := s;
                            Insert(sp, s, p);
                            writeln('Frase final: ', a);
                            end;
                 end;
 
           until (opc in ['0'..'3']);
 
           write('Deseja repetir? (S/N) ');
           repeat
                 opc := readkey;
           until (UpCase(opc) in ['S', 'N']);
 
           writeln; writeln;
     until (UpCase(opc) = 'N');
end.

Exercício 11

program ex11;  // 20 linhas
uses crt;
var face : array[1..6] of integer;
    i : integer;
 
begin
     randomize;
     for i:=1 to 1000000 do
         inc(face[random(6)+1]);
     for i:=1 to 6 do writeln('Face ',i,': ',face[i]);
     readln;
end.

Exercício 12

program ex12; // 35 linhas
 
type  TLetra = record
               Qual  : char;
               Vezes : word;
      end;
 
const vogais     : set of char = ['A', 'E', 'I', 'O', 'U'];
      consoantes : set of char = ['A'..'Z'] - ['A', 'E', 'I', 'O', 'U'];
 
var Linha : string[80];
    Letras : array [1..26] of TLetra;
    i : integer;
 
procedure IniciarLetras(var L : array of TLetra);
var j : integer;
begin
     for j:=1 to 26 do begin
         L[j].Qual := char(j+64);
         L[j].Vezes := 0;
     end;
end;
 
begin
     write('Introduza linha de texto: ');
     readln(Linha);
 
     IniciarLetras(Letras);
 
     for i:=1 to length(Linha) do
         inc(Letras[ord(UpCase(Linha[i]))-63].Vezes);
 
     writeln('VOGAIS:');
     for i:=1 to 26 do
         if (Letras[i].Qual in vogais) and (Letras[i].Vezes > 0) then
            writeln(Letras[i].Qual,' = ',Letras[i].Vezes);
 
     writeln('CONSOANTES:');
     for i:=1 to 26 do
         if (Letras[i].Qual in consoantes) and (Letras[i].Vezes > 0) then
            writeln(Letras[i].Qual,' = ',Letras[i].Vezes);
 
     readln; // pausa
end.

Exercício 13

{$MODE DELPHI}
program ex13; // 27 linhas
uses windows, sysutils, strutils;
 
var Num : integer;
    Rom : string;
    Mensagem : pchar;
 
begin
     try
        writeln('INTEIRO --> ROMANO');
        write('Numero? ');
        readln(Num);
        writeln('Romano = ', IntToRoman(Num));
        writeln;
        writeln('ROMANO --> INTEIRO');
        write('Romano? ');
        readln(Rom);
        Rom := UpCase(Rom);
        writeln('Numero = ', RomanToInt(Rom));
     except
           ON ex:exception do begin
              Mensagem := @ex.message[1];
              MessageBox(0, Mensagem, 'Ocorreu um erro', 0 + MB_ICONHAND);
           end;
     end;
     readln; // pausa
end.

Desafio 1

program des1; // 21 linhas
uses crt;
var texto : string;
 
procedure ler(var s : string);
begin
     readln(s);
end;
 
procedure escrever(s : string);
var i : integer;
begin
     for i:=length(s) downto 1 do write(s[i]);
end;
 
begin
     write('Escreva linha de texto: ');
     ler(texto);
     writeln;
     write('Texto por ordem inversa: ');
     escrever(texto);
     writeln;
     readln;
end.

Desafio 2

program des2;  // 23 linhas
uses crt;
var i, j : integer;
    key : char;
 
begin
     writeln('Cores disponiveis: ');
     writeln;
     for i:=1 to 8 do write(i,'        ');
     writeln;
     for i:=1 to 16 do begin
         for j:=1 to 8 do begin
             textcolor(i);
             textbackground(j);
             if (i>=1) and (i<=9) then write('0');
             write(i,' TESTE ');
         end;
         writeln;
     end;
     textbackground(8);
     textcolor(7);
     writeln;
     readln;
end.

Desafio 3

program des3;  // 16 linhas
uses crt;
var i, j : integer;
 
begin
     writeln('Tabela ASCII do presente computador:');
     writeln;
     for i:=32 to 255-9 do begin
         write(i,' ',char(i),'   ',i+1,' ',char(i+1),'   ',i+2,' ',char(i+2));
         write('   ',i+3,' ',char(i+3),'   ',i+4,' ',char(i+4));
         write('   ',i+5,' ',char(i+5),'   ',i+6,' ',char(i+6));
         write('   ',i+7,' ',char(i+7),'   ',i+8,' ',char(i+8));
         writeln('   ',i+9,' ',char(i+9));
         i := i+9;
     end;
     readln;
end.

Desafio 4

program des4;  // 19 linhas
uses crt;
 
function BolToBin(v : boolean) : integer;
begin
     case v of
          true : BolToBin := 1;
          false : BolToBin := 0;
     end;
end;
 
function BinToBol(v : integer) : boolean;
begin
     case v of
          1 : BinToBol := true;
          0 : BinToBol := false;
     end;
end;
 
begin
     // programa
end.

Desafio 5

Desafio 6

program des6;
uses crt;
var numero : integer;
 
function multiplo(mult, num : integer) : boolean;
begin
     if (mult mod num = 0) then multiplo := true
     else multiplo := false;
end;
 
procedure mostrar_primos(n : integer);
var lista : set of byte;
    primos : set of byte;
    i : integer;
    j : integer;
    l : integer;
begin
     lista := [2..n];
     primos := [];
     i:=2;
     while ([i] <= lista) do begin
           primos += [i];
           for j:=i to n do begin
               if multiplo(j,i) then lista -= [j];
           end;
           l:=2;
           while (not ([l] <= lista)) and (l<=n) do l += 1;
           i := l; // Assim que determinado, é atribuído a I, que é primo.
     end;
     write('PRIMOS: ');
     for i:=2 to n do begin
         if ([i] <= primos) then write(i,', ');
     end;
end;
 
begin
     repeat
           write('Calcular numeros primos ate: '); readln(numero);
     until (numero in [2..maxint]);
     writeln;
     mostrar_primos(numero);
     writeln;
     write('ENTER para sair...'); readln;
end.

Algoritmo proposto no artigo da Wiki sobre o Crivo de Eratosthenes - o programa está comentado neste artigo.

Notas Finais <<

,
dev_geral/pascal/tutorial/resolucao_exdes.txt · Última modificação em: 2018/05/14 21:37 (edição externa)

Ferramentas de Página

Excepto menção em contrário, o conteúdo neste wiki está sob a seguinte licença: CC Attribution-Noncommercial-Share Alike 4.0 International
CC Attribution-Noncommercial-Share Alike 4.0 International Donate Powered by PHP Valid HTML5 Valid CSS Driven by DokuWiki