Algorítmo 500 do Livro "500 algorítmos resolvidos" em Pascalzim

Esta é uma pré-visualização de arquivo. Entre para ver o arquivo original

Program DesafioSubprogramas3; 
// Universidade Federal de Roraima
// Curso: Engenharia Elétrica
// Função: Calcula logarítmo em qualquer base e raíz em qualquer índice
// Autor: Pedro Gabriel Lucas da Silva
// Matrícula: 1201414711
// Data: 18/06/2014
var
 opcao: integer;
 comando: string;
 
//-----------------------------------------(SUBPROGRAMA 1 - LOGARÍTMO)-------------------------------------------------
Procedure logaritmo;
var 
 logaritmando, base: real;
Begin
 textbackground (2); // Muda a cor da tela para azul e os caracteres para branco
 clrscr;
 textcolor (white);
 
 writeln (' CÁLCULO DE UM LOGARÍTMO EM QUALQUER BASE'); 
 writeln; // Pula linha
 
 write ('Digite a base do logarítmo: ');
 read (base);
 
 while (base <= 0) or (base = 1) do // Condição de existência do logarítmo: a base é sempre positiva e diferente de 1
 Begin
 write ('Base inválida, digite um valor positivo ou diferente de 1: ');
 read (base);
 End;
 
 write ('Digite o logaritmando: ');
 read (logaritmando);
 
 while (logaritmando <= 0) do // Condição de existência do logarítmo: o logaritmando é sempre positivo
 Begin
 write ('Logaritmando inválido, digite um valor positivo: ');
 read (logaritmando);
 End;
 
 writeln ('Logarítmo: ',ln(logaritmando)/ln(base):0:5); // Fórmula da mudança de base
 
 writeln; // Pula linha
 writeln ('Digite "sair" para encerrar a operação ou qualquer caractere para continuar: '); 
 read (comando);
 
 While (comando <> 'sair') do // Verifica se a operação contiuará
 Begin
 
 textbackground (2); // Limpa a tela
 clrscr;
 textcolor (white);
 
 writeln (' CÁLCULO DE UM LOGARÍTMO EM QUALQUER BASE');
 writeln; // Pula linha 
 
 write ('Digite a base do logarítmo: ');
 read (base);
 
 while (base <= 0) or (base = 1) do // Condição de existência do logarítmo: a base é sempre positiva e diferente de 1
 Begin
 write ('Base inválida, digite um valor positivo ou diferente de 1: ');
 read (base);
 End;
 
 write ('Digite o logaritmando: ');
 read (logaritmando);
 
 while (logaritmando <= 0) do // Condição de existência do logarítmo: o logaritmando é sempre positivo
 Begin
 write ('Logaritmando inválido, digite um valor positivo: ');
 read (logaritmando);
 End;
 
 writeln ('Logarítmo: ',ln(logaritmando)/ln(base):0:5); // Fórmula da mudança de base
 
 writeln; // Pula linha
 writeln ('Digite "sair" para encerrar a operação ou qualquer caractere para continuar: '); 
 read (comando); 
 
 End; 
 
End;
//-----------------------------------------(SUBPROGRAMA 1 - RAÍZ)------------------------------------------------------
Procedure raiz;
var
 indice: integer;
 radicando, aux: real; 
Begin
 textbackground (3); // Muda a cor da tela para azul e os caracteres para branco
 clrscr;
 textcolor (white);
 
 writeln (' CÁLCULO DE UMA RAÍZ DE QUALQUER ÍNDICE');
 writeln; // Pula linha
 
 write ('Digite o índice da raíz: ');
 read (indice);
 
 While (indice <= 1) do // Não permite a entrada de valores inválido para o índice
 Begin
 
 textbackground (3); // Limpa a tela antes de mostrar o erro
 clrscr;
 textcolor (white); 
 
 writeln (' CÁLCULO DE UMA RAÍZ DE QUALQUER ÍNDICE'); 
 writeln ('ERRO: O ÍNDICE TEM QUE SER MAIOR QUE 1.'); 
 write ('Digite novamente o índice da raíz: ');
 read (indice);
 End;
 
 write ('Digite o radicando: ');
 read (radicando);
 
 If (indice mod 2 = 0) then // Verifica se o índice é par. Se for, só aceitará valores positivos 
 Begin
 While (radicando < 0) do
 Begin
 
 writeln (' CÁLCULO DE UMA RAÍZ DE QUALQUER ÍNDICE'); 
 writeln ('ERRO: O RADICANDO TEM QUE SER POSITIVO COM ÍNDICES PARES.');
 write ('Digite novamente o radicando: ');
 read (radicando);
 End;
 End;
 
 If (radicando < 0) then // O logaritmando não recebe valores negativos, então, para não dar erro, o sinal é trocado
 Begin
 aux := radicando; // Auxilia quando for exibir a saída, no caso de um índice ímpar e um radicando negativo
 radicando := radicando*-1
 End
 
 Else aux := 1; 
 
 If (aux < 0) then // Se o radicando era negativo, então a variável 'aux' é negativa e o resultado da operação é multiplicado por -1 para ser negativo
 Begin 
 writeln ('Resultado: ',exp(1/indice*ln(radicando))*-1) 
 End
 
 Else
 writeln ('Resultado: ', exp(1/indice*ln(radicando))); // Se o radicando era positivo, o resultado é exibido sem nenhuma alteração 
 writeln; // Pula linha
 writeln ('Digite "sair" para encerrar a operação ou qualquer caractere para continuar: '); 
 read (comando);
 
 While (comando <> 'sair') do // Verifica se a operação contiuará
 Begin
 
 textbackground (3); // Limpa a tela
 clrscr;
 textcolor (white);
 
 writeln (' CÁLCULO DE UMA RAÍZ DE QUALQUER ÍNDICE');
 writeln; // Pula linha
 
 write ('Digite o índice da raíz: ');
 read (indice);
 
 While (indice <= 1) do // Não permite a entrada de valores inválido para o índice
 Begin
 
 textbackground (3); // Limpa a tela antes de mostrar o erro
 clrscr;
 textcolor (white); 
 
 writeln ('ERRO: O ÍNDICE TEM QUE SER MAIOR QUE 1.'); 
 write ('Digite novamente o índice da raíz: ');
 read (indice);
 End;
 
 write ('Digite o radicando: ');
 read (radicando);
 
 If (indice mod 2 = 0) then // Verifica se o índice é par. Se for, só aceitará valores positivos 
 Begin
 While (radicando < 0) do
 Begin
 
 writeln ('ERRO: O RADICANDO TEM QUE SER POSITIVO COM ÍNDICES PARES.');
 write ('Digite novamente o radicando: ');
 read (radicando);
 End;
 End;
 
 If (radicando < 0) then // O logaritmando não recebe valores negativos, então, para não dar erro, o sinal é trocado
 Begin
 aux := radicando; // Auxilia quando for exibir a saída, no caso de um índice ímpar e um radicando negativo
 radicando := radicando*-1
 End
 
 Else aux := 1; 
 
 If (aux < 0) then // Se o radicando era negativo, então a variável 'aux' é negativa e o resultado da operação é multiplicado por -1 para ser negativo
 Begin 
 writeln ('Resultado: ',exp(1/indice*ln(radicando))*-1) 
 End
 
 Else
 writeln ('Resultado: ', exp(1/indice*ln(radicando))); // Se o radicando era positivo, o resultado é exibido sem nenhuma alteração 
 writeln; // Pula linha
 writeln ('Digite "sair" para encerrar a operação ou qualquer caractere para continuar: '); 
 read (comando); 
 End;
End;
//-----------------------------------------(PROGRAMA PRINCIPAL)--------------------------------------------------------
Begin
 textbackground (blue); 
 clrscr;
 textcolor (white);
 
 gotoxy(32, 10); writeln ('ESCOLHA UMA OPÇÃO: '); // Menu de opções
 gotoxy(23, 12); writeln ('0 - Sai do programa');
 gotoxy(23, 14); writeln ('1 - Calcula qualquer logarítmo');
 gotoxy(23, 16); writeln ('2 - Calcula qualquer raíz');
 
 read (opcao);
 
 While (opcao < 0) or (opcao > 2) do // Não permite valores inválidos
 Begin 
 
 textbackground (blue); // Limpa a tela após digitado um valor inválido
 clrscr;
 textcolor (white);
gotoxy(23, 8); write ('Valor inválido, digite novamente a opcão: ');
 writeln; // Pula linha
 gotoxy(32, 10); writeln ('ESCOLHA UMA OPÇÃO: '); // Menu de opções
 gotoxy(23, 12); writeln ('0 - Sai do programa');
 gotoxy(23, 14); writeln ('1 - Calcula qualquer logarítmo');
 gotoxy(23, 16); writeln ('2 - Calcula qualquer raíz'); 
 read (opcao);
 
 End;
 
 While (opcao <> 0) do // O usuário repete as operações quantas vezes quiser
 Begin 
 
 Case opcao of
 1 : logaritmo;
 2 : raiz;
 End;
 
 gotoxy(32, 10); writeln ('ESCOLHA UMA OPÇÃO: '); // Menu de opções
 gotoxy(23, 12); writeln ('0 - Sai do programa');
 gotoxy(23, 14); writeln ('1 - Calcula qualquer logarítmo');
 gotoxy(23, 16); writeln ('2 - Calcula qualquer raíz'); 
 
 read (opcao); 
 
 While (opcao < 0) or (opcao > 2) do // Não permite valores inválidos
 Begin 
 
 textbackground (blue); // Limpa a tela após digitado um valor inválido
 clrscr;
 textcolor (white);
 gotoxy(23, 8); write ('Valor inválido, digite novamente a opcão: ');
 writeln; // Pula linha
 gotoxy(32, 10); writeln ('ESCOLHA UMA OPÇÃO: '); // Menu de opções
 gotoxy(23, 12); writeln ('0 - Sai do programa');
 gotoxy(23, 14); writeln ('1 - Calcula qualquer logarítmo');
 gotoxy(23, 16); writeln ('2 - Calcula qualquer raíz'); 
 read (opcao);
 
 End; 
 
 End;
 
 
 
 gotoxy (32, 18); writeln ('PROGRAMA ENCERRADO.'); 
End.