feat: Pascal - Métodos de ordenação, fatorial, pilha e busca binária

Author: sswellington

Pascal/busca-binaria.pas

@@ -0,0 +1,66 @@
+program buscabinaria;
+
+const
+    MAX = 30000;
+
+type
+    Tdado = integer;
+    Tvetor = array[1..MAX]of integer;
+	Tarq = text;
+var 
+  vetor : Tvetor;
+  valor: Tdado;
+	
+procedure preencher(var vetor : Tvetor);
+var
+	i : integer;
+begin
+	for i:= 1 to MAX do
+	begin	
+		vetor[i] := i;
+	end;
+end;	
+
+procedure buscaBinariarec(vetor:Tvetor; valor:Tdado; inicio:integer; fim:integer);
+var 
+	meio : integer;
+begin
+	meio := (inicio+fim) div 2;
+	
+    {
+	writeln;	
+	writeln('--------------------------------');
+	writeln('Passo a Passo');
+	writeln('valor	',vetor[meio]);
+	writeln('posicao	',meio);
+	writeln('--------------------------------');
+	writeln;
+    }
+	
+	if(valor = vetor[meio]) then
+	begin
+		writeln('Achou!!');
+		//writeln('valor	',vetor[meio]);
+		writeln('posicao	',meio);
+	end else
+		if(meio=inicio) then	write('error 404') else
+		begin
+		if((valor > vetor[meio]) and (meio <> inicio)) then
+		begin
+			//writeln('DIREITA');
+			buscaBinariarec(vetor, valor, meio, MAX);
+		end;
+			
+		if((valor < vetor[meio]) and (meio <> inicio)) then
+		begin
+			//writeln('ESQUERDA');
+			buscaBinariarec(vetor, valor, inicio, meio);
+		end;
+	end;	
+end;
+
+begin
+	valor := 21054;
+	preencher(vetor);
+	buscaBinariarec(vetor, valor, 0, MAX);
+end.

Pascal/fatorial-recusiva.pas

@@ -0,0 +1,26 @@
+program fatorial_recursiva;
+var
+	num : longint;
+
+function fatorial (number : longint): longint;
+begin
+    if (number = 1) then
+        fatorial := 1
+    else 
+        fatorial := number * fatorial(number-1)
+end;
+
+function fatorialb(n:integer): integer;
+begin
+	if n > 1 then
+		fatorial := fatorial(n-1) * n
+	else fatorial := 1;
+end;
+
+begin
+    writeln('Informe um numero');
+    readln(num);
+    writeln(' ');
+
+    writeln(num,'! = ',fatorial(num));
+end.

Pascal/fatorial.pas

@@ -0,0 +1,19 @@
+program fatorial_pascal;
+var
+	num, cont, soma : longint;
+begin
+ soma := 1;
+ cont := 0;
+ writeln('Informe um numero');
+ readln(num);
+ writeln(' ');
+
+ 	for cont := num downto 2 do 
+ 	begin
+ 	 	//writeln(num*num-1);
+ 	 	writeln(soma);
+ 	 	soma := soma*cont;
+ 	 	writeln(soma);
+    end;
+  writeln(num,'! = ',soma);
+end.

Pascal/pilha.pas

@@ -0,0 +1,68 @@
+program exe_pilha;
+const 
+	MAX = 3;
+type 
+	Tvetor = array[1..MAX] of integer;
+var 
+	pilha : Tvetor;
+	condicao : char;
+	posicao, valor : integer;
+
+procedure push (valor : integer);
+begin
+	if(posicao>MAX) then writeln('OverFlow') else
+	begin
+		posicao := posicao + 1;
+		pilha[posicao] := valor;
+	end;
+end;
+
+function pop : integer;
+begin
+	if(posicao<1) then writeln('UnderFlow') else
+		begin
+		pop := pilha[posicao];
+		posicao := posicao - 1;
+	end;
+end;
+
+procedure exibir;
+begin
+	writeln('___________________________________ ');
+	
+	writeln('Posicao na pilha :');
+	for posicao:=1 to MAX do 
+		begin
+		writeln('Indice: ',posicao, ' = ',pilha[posicao]);
+	end;
+	writeln('___________________________________ ');
+	
+	writeln('Posicao na pilha a se retirada :');
+	for posicao:=MAX downto 1 do 
+		begin
+	writeln('Indice: ',posicao, ' = ',pilha[posicao]);
+	end;
+end;
+
+begin
+	posicao := 0;
+	
+	repeat
+		writeln('Deseja [A]dicionar , [R]etirar ou [S]air ?');
+		readln(condicao);
+
+		case condicao of
+			'A','a' : begin 
+				writeln('Valor ');
+				readln(valor);
+				push(valor);
+			end;
+
+			'r','R' : begin
+				writeln('O valor = ',pop);
+			end;
+		end;
+	until(condicao = 's') or (condicao = 'S');
+
+	exibir;
+end.

Pascal/sort/bubble-sort.pas

@@ -0,0 +1,99 @@
+program selection_sort;
+
+{dia 06/05
+Version: 0.5
+Nome: Wellington De Souza Silva
+Método : Selection Sort}
+
+// bug com dois valores altos ??? 
+
+uses crt;
+
+const
+	MAX = 10;
+
+type 
+	Tdado = integer;
+
+	Tvetor = array[1..MAX] of Tdado;
+	
+var
+	vetor : Tvetor;
+
+//usado para tester		
+procedure preencher(var vetor : Tvetor);
+begin
+	vetor[1] := 4;
+	vetor[2] := 3;
+	vetor[3] := 500;
+	vetor[4] := 7;
+	vetor[5] :=	10;
+	vetor[6] :=	1309;
+	vetor[7] :=	8;
+	vetor[8] :=	9;
+	vetor[9] :=	2;
+	vetor[10] := 6;
+end;
+
+procedure manual(var vetor:Tvetor);
+var
+	i : integer;
+begin
+	for i := 1 to MAX do
+	begin
+		writeln('informe o valor ',i);
+		readln(vetor[i]);
+	end;
+end;
+// acha o menor, nucleo do programa
+procedure kernel(var vetor : Tvetor); 
+var
+	j: integer;
+	temp : integer;
+begin
+	for j:= 1 to MAX do 
+	begin
+		if vetor[j] > vetor[j+1] then
+		begin
+			temp := vetor[j];
+			vetor[j] := vetor[j+1];
+			vetor[j+1] := temp;
+		end;
+	end;
+end;
+
+//////////////////////////////
+procedure exibir(vetor: Tvetor);
+var
+	i : integer;
+begin
+	writeln;
+	write(' | ');
+	for i:=1 to MAX do
+	begin
+		write(vetor[i]);
+		write(' | ');
+	end;
+	writeln;
+end;
+
+procedure repetir();
+var
+	i: integer;
+begin
+	for i:=MAX downto 1 do 
+	begin
+		kernel(vetor);
+		exibir(vetor);
+	end;
+end;
+
+begin
+	preencher(vetor);
+	writeln('Vetor Original');
+	exibir(vetor);
+	repetir();
+	writeln;
+	writeln('Vetor Ordenado');
+	exibir(vetor);
+end.

Pascal/sort/heapsort.pas

@@ -0,0 +1,98 @@
+program HeapSort240616;
+
+const
+  MAX = 10;
+
+type
+  Tgiven  = integer;
+  Tvector = array[0..MAX] of Tgiven;
+
+var
+  vector : Tvector;
+
+procedure auto(var vector:Tvector);
+var
+  i : integer;
+begin
+  for i := 0 to MAX-1 do
+  begin
+    vector[i]:=random(150);
+  end;
+end;
+
+procedure display( vector: Tvector );
+var
+  i: integer;
+begin
+	writeln;
+	write('=>	| ');
+  for i := 0 to MAX-1 do write(vector[i],' | ');
+  writeln;
+end;
+
+procedure swap( var a, b: integer );
+var
+  temp: integer;
+begin
+  temp := a;
+  a := b;
+  b := temp;
+end;
+
+procedure sink( var vector : Tvector; start, last: integer );
+var
+  root, child: integer;
+begin
+  root := start;
+  while ( root * 2 + 1 <= last ) do begin
+  child := root * 2 + 1;
+  if ( child < last ) and ( vector[child] < vector[child + 1] ) then
+    child := child + 1;
+  if ( vector[root] < vector[child] ) then begin
+    swap ( vector[root], vector[child] );
+    root := child;
+  end else
+    break;
+  end;
+end;
+
+procedure heighten( var vector : Tvector; count: integer );
+var
+  start: integer;
+begin
+  start := (count - 1) div 2;
+  while ( start >= 0 ) do
+  begin
+    sink (vector, start, count-1);
+    start := start - 1;
+  end;
+end;
+
+procedure heapSort( var vector : Tvector; lastVector:integer );
+var
+  last : integer;
+begin
+  heighten(vector, MAX );
+  last := MAX - 1;
+  writeln;
+  writeln('Heap');
+  display(vector);
+  while ( last > 0 ) do
+  begin
+    swap(vector[last], vector[0]);
+    last := last - 1;
+    sink(vector, 0, last);
+  end;
+end;
+
+//program
+begin
+	writeln;
+  auto(vector);
+  writeln('Original Vector');
+  display(vector);
+  heapSort (vector, MAX);
+  writeln;
+  writeln('Sorted Vector');
+  display(vector);
+end.