Computação TOP10

program teste;

uses crt;

var
ft:integer;

function fat(n:integer):real;
begin
if(n = 0)then
begin
fat:=1;
end
else
begin
fat:=n*fat(n-1);
end;
end;

begin
clrscr;
write('Digite a fatorial:'); read(ft); writeln;
if(ft < 0)then
begin
writeln('Numero invalido!');
end
else
begin
writeln('Fatorial de ',ft,' = ',fat(ft):1:0);
end;
readkey;
end.


Vamos a explicação.

function fat(n:integer):real;
begin
if(n = 0)
then fat:=1;
else fat:=n*fat(n-1);
end

Fat(5)
5*Fat(4)
4*Fat(3)
3*Fat(2)
2*Fat(1)
1*Fat(0) - iteração não necessária, poderia-se alterar a condição do If para n=1, pois fat(0) e fat(1) tem o mesmo valor.

Observe que na primeira iteração, estou mandando o 5 para a variável N DA função fat, no IF a função verifica que N não é igual a zero, portanto vai para o ELSE, fazendo o seguinte 5*Fat(4) (n*fat(n-1)), isso se repete até o fim, quando a condição do IF for verdadeira, os valores serão devolvidos ao local que foram chamados, começando de baixo para cima

Fat(5) = 120.
5*Fat(4) = 5*24 = 120, envia 120 para a linha de cima
4*Fat(3) = 4*6 = 24, envia 24 para a linha de cima
3*Fat(2) = 3*2 = 6, envia 6 para a linha de cima
2*Fat(1) = 2*1 = 2, envia 2 para a linha de cima
1*Fat(0) = 1, envia 1 para a linha de cima

Program Pzim ;
 const max = 100;
 type Fila = record
  dados : array[1..max]of integer;
      inicio, fim : integer;
     end;
      var
  f1 : Fila;
  num, bus, valor : integer;
   
 procedure criar(var F:Fila);
 begin
     F.inicio := 1;
     F.fim := 1;
 end;

 function filaVazia(F:Fila):boolean;
 begin
     if F.inicio = F.fim then
      filaVazia := true
     else
      filaVazia := false;
 end;

 function filaCheia(F:Fila):boolean;
 begin
     if F.fim > max then
      filaCheia := true
     else
      filaCheia := false;
 end;

 procedure enqueue(var F:Fila;s:integer);
 begin
     if filaCheia(F)then
      writeln('A fila tá cheia!')
     else
     begin
         F.dados[F.fim] := s;
         F.fim := F.fim + 1;
         writeln('Inserção efetuada!');
     end;
 end;

 function dequeue(var F:Fila):integer;
 begin
     if filaVazia(F)then
      writeln('A fila tá vazia!')
     else
     begin
      dequeue := F.dados[F.inicio];
      F.inicio := F.inicio + 1;
     end;
 end;

 function busca(F:Fila; x: integer):integer;
 var
    res: integer;
 begin
   res := 0;
    while not filaVazia(f) do
      begin
        if (f.dados[f.inicio] = x) then
  res := res +1;
  f.inicio := f.inicio +1;
      end;
        busca := res;
 end;
 Begin
     textcolor(white);
criar(f1);
     writeln('A fila está vazia? ', filaVazia(f1));
     writeln('A fila está cheia? ', filaCheia(f1));
     repeat
          writeln ('digite o elemento da lista ou "0" para sair');
          readln (num);
          enqueue (f1, num);
     until (num = 0);
     writeln (' digite o valor que deseja buscar');
     readln (bus);
     valor := busca(f1, bus);
     writeln (' o valor aparece ', valor, ' na lista');
 End.

program ListaEncadeada;
       
   type
         ListEnc = ^No;
 
No = record
                  obj: String;
                  prox: ListEnc;
             end;
     var
  L :ListEnc;
  bus : string;

         //CRIA LISTA VAZIA
         procedure criar(var L:ListEnc);
         begin
             L := nil;
         end;
       
   //INFORMA SE A LISTA ESTÁ VAZIA OU NÃO
         function vazia(L: ListEnc):boolean;
         begin
             if L = nil then
                vazia := true
             else
                vazia := false;
         end;

         //INSERE UM ELEMENTO NA LISTA
         procedure inserir(var L: ListEnc; s: string);
         var
            N, P: ListEnc;
          begin
            new(N);
            N^.obj := s;
            if vazia(L)then
               begin
                    N^.prox := L;
                    L := N;
               end
           else
  begin
          P := L;
          while (P^.prox <> nil)do
                          P := P^.prox;
          N^.prox := P^.prox;
          P^.prox := N;
  end;
  end;
 
//REMOVE UM ELEMENTO DA LISTA
          function remover(var L: ListEnc; s: string):boolean;
          var
            P, Q: ListEnc;
          begin
           if vazia(L)then
              remover := false
           else
            if (L^.obj = s)then
            begin
              P := L;
              L := L^.prox;
              dispose(P);
              remover := true;
            end
            else
               begin
                P := L;
                    while ((P^.prox <> nil)and (P^.prox^.obj <> s)) do
                    begin
                        P := P^.prox;
                    end;
                    if (P^.prox <> nil) and (P^.prox^.obj = s) then
                    begin
                         Q := P^.prox;
                         P^.prox := Q^.prox;
                         dispose(Q);
                         remover := true;
                    end
                    else
                    begin
                        remover := false;
                    end;
end;        
end;

         // IMPRIME A LISTA
         procedure imprimir(L: ListEnc);
         var
            P: ListEnc;
         begin
            if vazia(L)then
               writeln('LISTA VAZIA!!!')
            else
            begin
                P := L;
                while (P <> nil) do
                begin
write(P^.obj,' | ');
                     P := P^.prox;
                end;
            end;
         end;
   function busca(L: ListEnc; x: string):boolean;
         var
            P: ListEnc;
         begin
                P := L;
                busca := false;
                while (P <> nil) do
                begin
if P^.obj = x then
   busca := true;
                     P := P^.prox;
                end;
            end;          

 //INICIO DO PROGRAMA PRINCIPAL

 Begin
   criar(L);
 writeln(vazia(L));
 inserir(L, 'MACACO');
 inserir(L, 'CACHORRO');
 inserir(L, 'GATO');
 inserir(L, 'LEÃO');
 inserir(L, 'RATO');
 inserir(L, 'CAMELO');
 inserir(L, 'CORUJA');
 imprimir(L);
 writeln;
 writeln(remover(L,'RATO'));
 writeln('APÓS A REMOÇÃO...');
 writeln;
 imprimir(L);

 writeln ('busca');
 readln (bus);
 writeln (busca(L, bus));
 readln;
 End.

Program Pzim ;
 const max = 7;
 type Fila = record
  dados : array[1..max]of string;
      inicio, fim : integer;
     end;
 

         ListEnc = ^No;
 
No = record
                  obj: String;
                  prox: ListEnc;
             end;
var
  L :ListEnc;
     f1 : Fila;
     v: string;
   
 procedure criar(var F:Fila);
 begin
     F.inicio := 1;
     F.fim := 1;
 end;

 function filaVazia(F:Fila):boolean;
 begin
     if F.inicio = F.fim then
      filaVazia := true
     else
      filaVazia := false;
 end;

 function filaCheia(F:Fila):boolean;
 begin
     if F.fim > max then
      filaCheia := true
     else
      filaCheia := false;
 end;

 procedure enqueue(var F:Fila;s:string);
 begin
     if filaCheia(F)then
      writeln('A fila tá cheia!')
     else
     begin
         F.dados[F.fim] := s;
         F.fim := F.fim + 1;
         writeln('Inserção efetuada!')
     end;
 end;

 function dequeue(var F:Fila):string;
 begin
     if filaVazia(F)then
      writeln('A fila tá vazia!')
     else
     begin
      dequeue := F.dados[F.inicio];
      F.inicio := F.inicio + 1;
     end;
 end;

 procedure mostrarFila(F:Fila);
 begin
     if filaVazia(F)then
      writeln('A fila tá vazia!')
     else
     begin
      while not filaVazia(F)do
write(dequeue(F),'|');
     end;
     writeln;
 end;
   procedure Lcriar(var L:ListEnc);
         begin
             L := nil;
         end;
       
   //INFORMA SE A LISTA ESTÁ VAZIA OU NÃO
         function vazia(L: ListEnc):boolean;
         begin
             if L = nil then
                vazia := true
             else
                vazia := false;
         end;

         //INSERE UM ELEMENTO NA LISTA
         procedure inserir(var L: ListEnc; s: string);
         var
            N, P: ListEnc;
          begin
            new(N);
            N^.obj := s;
            if vazia(L)then
               begin
                    N^.prox := L;
                    L := N;
               end
           else
  begin
          P := L;
          while (P^.prox <> nil)do
                          P := P^.prox;
          N^.prox := P^.prox;
          P^.prox := N;
  end;
  end;
 
//REMOVE UM ELEMENTO DA LISTA
          function remover(var L: ListEnc; s: string):boolean;
          var
            P, Q: ListEnc;
          begin
           if vazia(L)then
              remover := false
           else
            if (L^.obj = s)then
            begin
              P := L;
              L := L^.prox;
              dispose(P);
              remover := true;
            end
            else
               begin
                P := L;
                    while ((P^.prox <> nil)and (P^.prox^.obj <> s)) do
                    begin
                        P := P^.prox;
                    end;
                    if (P^.prox <> nil) and (P^.prox^.obj = s) then
                    begin
                         Q := P^.prox;
                         P^.prox := Q^.prox;
                         dispose(Q);
                         remover := true;
                    end
                    else
                    begin
                        remover := false;
                    end;
end;        
end;

         // IMPRIME A LISTA
         procedure imprimir(L: ListEnc);
         var
            P: ListEnc;
         begin
            if vazia(L)then
               writeln('LISTA VAZIA!!!')
            else
            begin
                P := L;
                while (P <> nil) do
                begin
write(P^.obj,' | ');
                     P := P^.prox;
                end;
            end;
         end;    

 Begin
     textcolor(white);
criar(f1);
Lcriar(L);
     writeln('A fila está vazia? ', filaVazia(f1));
     writeln('A fila está cheia? ', filaCheia(f1));
     enqueue(f1,'Macaco');
     enqueue(f1,'Cachorro');
     enqueue(f1,'Gato');
     enqueue(f1,'Coruja');
     enqueue(f1,'Cobra');
     enqueue(f1,'Porco');
    while not filaVazia(f1) do
     begin
 v := dequeue(f1);
       inserir(L, v);
     end;
     writeln ('imprimindo a lista');
 imprimir(L);
     readln;
 End.

program exe5;
//Autor: Cícero Amauri
const max = 5;
type
   pilha = record
              obj: array [1..max] of string;
              i: integer;
            end;
procedure criar (x: pilha);
  begin
    x.i := 0;
  end;
  procedure push(var x:pilha; y: string);
    begin
      x.i:= x.i +1;
      x.obj[x.i] := y;
    end;
    procedure pop(var x:pilha);
    begin
        repeat
          writeln( x.obj[x.i]);
          x.i := x.i - 1;
        until (x.i = 0);
end;
var
  p: pilha;
  elemento: string;
  a : integer;
begin
  criar(p);
  for a := 1 to max do
  begin
    readln(elemento);
    push (p, elemento);
  end;
   pop(p);
end.

PROGRAM EXE4;
// AUTOR: CÍCERO AMAURI
TYPE
   PILHA = RECORD
         OBJ: ARRAY [1..100] OF STRING;
         N: INTEGER;
       END;
  PROCEDURE INIT (VAR X: PILHA);
  BEGIN
     X.N := 0;
  END;
  PROCEDURE PUSH ( VAR X: PILHA; Y: STRING);
  BEGIN
    X.N := X.N + 1;
    X.OBJ[X.N] := Y;
    WRITELN ('ELEMENTO ADICIONADO');
  END;
  FUNCTION Q(X: PILHA): INTEGER;
  BEGIN
     Q:= X.N;
  END;
VAR
  P: PILHA;
  I, QTDE: INTEGER;
  ELEMENTO: STRING;
BEGIN
  INIT(P);
  REPEAT
     WRITELN ('ADICIONE OS ELEMENTOS NA PILHA: ');
     READLN (ELEMENTO);
     PUSH (P, ELEMENTO);
     WRITELN ('DIGITE');
     WRITELN ( '1 PARA ADICIONAR OUTRO ELEMENTO');
     WRITELN ( '2 PARA VERIFICAR QUANTOS ELEMENTOS TEM NA PILHA');
     READLN (I);
     IF I = 2 THEN
     BEGIN
       QTDE := Q(P);
       WRITELN ('NA PILHA POSSUEM ',QTDE,' ELEMENTOS');
     END;
  UNTIL (I > 1);
END.

program exe3;
//autor: Cícero Amauri
const max = 5;
type
   pilha = record
              x: integer;
              obj :array [1..max] of string;
            end;
 procedure init(var n:pilha);
 begin
   n.x := 0;
 end;
 procedure push(var n:pilha; o: string);
 begin
   n.x := n.x + 1;
   n.obj[n.x]:= o;
 end;
 function IsEmpty ( n: pilha):boolean;
 begin
   if n.x = 0 then
   IsEmpty := true
   else
   IsEmpty := false;
 end;
 procedure pop (var n:pilha);
 begin
  writeln (n.obj[n.x]);
   n.x:= n.x - 1;
 end;
var
  p: pilha;
  i: integer;
  elem: string;
begin
  init(p);
  for i := 1 to max do
  begin
    readln (elem);
    push (p, elem);
  end;
  while not IsEmpty (p) do
  begin
    pop (p);
  end;
  writeln ('a pilha esta vazia ? ', IsEmpty(p));
end.

program exe2;
// Autor: Cícero Amauri
const max = 5;
type
   pilha = record
              obj: array [1..max] of string;
              i: integer;
            end;
procedure criar (x: pilha);
  begin
    x.i := 0;
  end;
  procedure push(var x:pilha; y: string);
    begin
      x.i:= x.i +1;
      x.obj[x.i] := y;
    end;
    procedure pop (var x:pilha; y: string);
    var
      e, a: integer;
      ver: string;
    begin
       a := 0;
       repeat
          ver:= x.obj[x.i];
          x.i := x.i - 1;
          if (x.i = max) then
          e := 0;
             if (ver = y) then
             begin
                e:= e + 1;
                a:= 1
             end;
        if (x.i = 0 ) then
         begin
            writeln ('o elemento ',y,' repete ',e,' vezes na pilha');
         end;
         if (x.i = 0) and (a <> 1 ) then
 writeln ('o elemento não está na pilha');
 until (x.i = 0);      
end;
var
  p: pilha;
  elemento,busca: string;
  a : integer;
begin
  criar(p);
  for a := 1 to max do
  begin
    readln(elemento);
    push (p, elemento);
  end;
 writeln ('digite o elemento que deseja procurar ');
 readln (busca);
   pop(p, busca);
end.

Program pilha ;
// autor: Cícero Amauri
const max = 4;
type  pilha = record
                 obj : array[1..max] of string;
                 j : integer;
              end;
var
 p1 : pilha;
 i: integer;
 objeto: string;
procedure criar ( var p: pilha); // cria a pilha
   begin
       p.j := 0;
   end;
procedure push(var p:pilha; ob: string); // adiciona elementos na pilha
  begin
      p.j := p.j + 1;
      p.obj[p.j] := ob;
  end;
function pop (var p: pilha):string;  // retira os elementos da pilha
  begin
    pop := p.obj[p.j];
    p.j:= p.j-1;
  end;
  function vazia(var p: pilha):boolean; // indica se a pilha está vazia
  begin
     if p.j = 0 then
vazia:= true
else
 vazia := false;
  end;
 Begin
    criar (p1);
    for i:= 1 to max do
    begin
      readln (objeto);// o usuario informar os elementos para inserir na pilha
      push (p1,objeto); // chama o procedimento para colocar os elementos na pilha
    end;
    writeln ('saída da pilha');
    repeat
       writeln(pop(p1));
    until (vazia(p1)= true); // repete até que a pilha esteja vazia
 End.

Crie um algorítimo que recebe uma matriz 4x4 de números inteiros, depois adicione a linha 2 da matriz em um vetor com 4 elementos (mostre o vetor). Crie um registro capaz de receber um cadastro de 5 clientes contendo nome e telefone de cada cliente, após preencher ordene o registro por nome e mostre o resultado.

Resposta:

Program exe;
//Autor: Cícero Amauri
type
   cad= record
               nome: string;
               tel: integer;
             end;
var
  a: array [1..4,1..4]of integer;
  res: array[1..5] of cad;
  vetor: array [1..4] of integer;
  i, auxt, j: integer;
  auxn: string;
  mudou: char;
 Begin
     for i := 1 to 4 do
     begin
       for j := 1 to 4 do
       begin
         write('digite a ',i,' linha e a ',j,' coluna da matriz: ');
         readln (a[i,j]);
         if (a[i,j] <= 0) then
         begin
          repeat
            writeln ('número invalido' );
            write('digite a ',i,' linha e a ',j,' da matriz: ');
            readln (a[i,j]);
          until (a[i,j] > 0);
         end;
       end;
     end;
     for i := 1 to 4 do
begin
 for j := 1 to 4 do
 begin
   if (i = 2) then
   begin
     vetor[i] := a[i,j];
     writeln ('o vetor é: ', vetor[i])
   end; 
 end;
end; 
    for i := 1 to 5 do
    begin
      write(' digite o ',i,' nome: ');
readln(res[i].nome);
write('digite o telefone: ');
readln (res[i].tel);
    end;
    for i := 1 to 5 do
    begin
     writeln (res[i].nome);
writeln (res[i].tel);  
    end;
    repeat
      mudou := 'n';
      for i := 1 to 4 do
      begin
        if (res[i].nome > res[i+1].nome) then
        begin
          auxn:= res[i].nome;
          auxt:= res[i].tel;
          res[i].nome:= res[i+1].nome;
          res[i].tel := res[i+1].tel;
          res[i+1].nome:= auxn;
          res[i+1].tel:= auxt;
          mudou := 's';
        end;
      end;
    until (mudou = 'n');
    writeln (' vetor ordenado por nome ');
    for i := 1 to 5 do
    begin
     writeln (res[i].nome);
writeln (res[i].tel);  
    end;
 End.

1. Faca um algoritmo capaz de ler via teclado e armazenar em um vetor 12 nomes. Verificar:
   1. Qual o maior nome
   2. Quantos elementos possuem um nome com o tamanho igual ao maior tamanho.
   3. Escrever os nomes e sua posição no vetor.
      
      
      
      
      resposta:
      
      
      program exe2;
      // Autor: Cícero Amauri
      var 
            nome: array [1..12] of string;
            i, cont: integer;
            mnome: string;
      begin
           textbackground (blue); // Altera a cor do fundo
           textcolor (yellow); // Altera a cor da letra
           cont := 0;
        for i := 1 to 12 do
        begin
             write ('digite o ',i,' nome: ');
             readln (nome[i]);
            if (i = 1 ) then
            mnome := nome[i];
               if (length (nome[i]) > length (mnome)) then
               mnome:= nome[i];
        end;
        writeln ('O maior nome é: ', mnome);
         for i := 1 to 12 do
         begin
              if ( length(nome[i]) = length(mnome)) then
              begin
                 cont := cont + 1;
                 writeln;
                 writeln ('o maior nome está na posição ',i,' é o nome: ',nome[i]);
             end;
         end;
         gotoxy (1,14); // Mostra a mensagem na linha 14 e na coluna 1
         writeln ('a quantidade de nomes com a mesma quantidade de letras é: ', cont); 
      end.
      
      

Crie um tipo registro com a seguinte estrutura:
Nome do funcionário, Data de admissão … dd –mm-aaaa, onde dd  contem um valor de {1,…,31} e mm de {1,..,12}, Salario base – nao pode ser menor que o salario minimo, Dias trabalhados nos ultimos 12 meses.

Crie um trecho de algoritmo que faça uma consulta a um funcionário já cadastrado:
O usuario deve fornecer o primeiro nome do funcionario, ou parte do nome, caso encontre, o programa deve mostrar seus dados.

Resposta:



Program funcionario;
// Autor: Cícero Amauri
const s = 545; 
type
    fun = record
                  nfun: string;
                  diaadm: integer;
                  mesadm: integer;
                  anoadm: integer;
                  sal: real;
                 diatrab: integer;
              end;
  var
    func: array [1..3] of fun;
    i: integer;
    digit: string; 
    resp: char;         
Begin
  for i := 1 to 3 do
  begin
           write ('digite o nome do funcionario: ');
           readln (func[i].nfun);
       repeat
              write ('digite o dia de admisão do funcionario: ');
              readln(func[i].diaadm);
       until ( func[i].diaadm >= 1) and ( func[i].diaadm <= 31);
       repeat
              write ('digite o mes de admisão do funcionario: ');
              readln(func[i].mesadm);
       until ( func[i].mesadm >= 1) and (func[i].mesadm <= 12);
       repeat
              write ('digite o ano de admisão do funcionario: ');
              readln(func[i].anoadm);
       until ( func[i].anoadm <= 2011 );
       write('digite o salario do funcionario: ');
       readln (func[i].sal);
       if (func[i].sal < s) then
         repeat
     writeln('salario invalido'); 
              write('digite o salario do funcionario: ');
              readln (func[i].sal);
         until ( func[i].sal > s );
          write('digite os dias trabalhados: ');
 readln(func[i].diatrab);
  end;
   repeat
 writeln ('digite o nome que deseja procurar: ');
 readln(digit);
 for i := 1 to 3 do
 begin
      if copy(func[i].nfun,1,length(digit))= (digit)then
  begin
               writeln ('o nome do funcionario é: ',func[i].nfun);
               writeln ('a data de admissão é: ', func[i].diaadm, '/', func[i].mesadm, '/', func[i].anoadm);
               writeln ('o salario é: ',func[i].sal:2:2);
               writeln ('os dias trabalhados são: ',func[i].diatrab);
      end;
 end;
  writeln('deseja fazer outra pesquisa s ou n: ');
  readln (resp); 
  until (resp = 'n');
End.