The FreePascal Project

program PascalTriangle;

const
   numRows = 5;
   Max_size = 20;
   Tab = ^I;

var
   fact   : Longint;
   n      : integer;
   number : integer;

procedure Draw_Triangle(num : integer);

var
   i, j : integer;
   n    : integer;
   A    : array[1..Max_size, 1..Max_size] of integer;

begin
   n := num;
   for i := 1 to n do begin
      for j := 1 to i do begin
         if (j = 1) or (i = j) then
            A[i,j] := 1
          else
             begin
                A[i,j] := A[i-1, j] + A[i-1, j-1];
             end;
      end;
   end;
   for i := 1 to n do begin
      {Gotoxy(41-i,i);}
      for j := 1 to i do
         Write(A[i,j], ' ');
      WriteLn
   end;
   { ReadLn; }
end;

function factorial(n : integer) : Longint;
begin
   if (n < 1) then
      factorial := 1
   else begin
      factorial := n * factorial(n - 1);
   end;
end;


(* # binomial theorem, n choose k *)

function binomial(n,k : integer) : integer;
begin
   if (n - k) <= 0 then
      binomial := 1;

   if k <= 0 then
      binomial := 1
   else
      binomial := Round(factorial(n) / (factorial(k) * factorial(n - k)));
end;

begin
   number := 12;
   { Clrscr;}
   Write('Factorial program in FreePascal');
   WriteLn;
   Write('Enter a Number : ');
   Readln(n);
   fact := factorial(n);
   WriteLn;
   WriteLn('The factorial of ', n:1, ' = ', fact, '.');
   WriteLn;
   WriteLn(Tab, '*** PASCAL TRIANGLE ***');
   WriteLn;
   Write('Enter a Number : ');
   Readln(number);
   Draw_Triangle(number);
end.

{ End of File }
  

~kc4zvw: ./pascal_triangle
Factorial program in FreePascal
Enter a Number : 5

The factorial of 5 = 120.

        *** PASCAL TRIANGLE ***

Enter a Number : 6
1
1 1
1 2 1
1 3 3 1
1 4 6 4 1
1 5 10 10 5 1
~kc4zvw:

  

program HeapSortDemo;

{$mode objfpc}{$h+}{$b-}

procedure HeapSort(var a: array of Integer);
  procedure SiftDown(Root, Last: Integer);
  var
    Child, Tmp: Integer;
  begin
    while Root * 2 + 1 <= Last do begin
      Child := Root * 2 + 1;
      if (Child + 1 <= Last) and (a[Child] < a[Child + 1]) then
        Inc(Child);
      if a[Root] < a[Child] then begin
        Tmp := a[Root];
        a[Root] := a[Child];
        a[Child] := Tmp;
        Root := Child;
      end else exit;
    end;
  end;
var
  I, Tmp: Integer;
begin
  for I := Length(a) div 2 downto 0 do
    SiftDown(I, High(a));
  for I := High(a) downto 1 do begin
    Tmp := a[0];
    a[0] := a[I];
    a[I] := Tmp;
    SiftDown(0, I - 1);
  end;
end;

procedure PrintArray(const Name: string; const A: array of Integer);
var
  I: Integer;
begin
  Write(Name, ': [');
  for I := 0 to High(A) - 1 do
    Write(A[I], ', ');
  WriteLn(A[High(A)], ']');
end;

var
  a1: array[-7..5] of Integer = (-34, -20, 30, 13, 36, -10, 5, -25, 9, 19, 35, -50, 29);
  a2: array of Integer = (-9, 42, -38, -5, -38, 0, 0, -15, 37, 7, -7, 40);
  a3: array of Integer = ( 12, 07, 08, 25, 23, 19, 01, 06, 13, 22, 05, 11, 28, 10, 21,
                           20, 18, 24, 04, 30, 02, 09, 03, 14, 26, 27, 29, 16, 15, 17);

begin
  HeapSort(a1);
  PrintArray('a1', a1);
  HeapSort(a2);
  PrintArray('a2', a2); 
  HeapSort(a3);
  PrintArray('a3', a3); 
end.

(*
 *  vim: tabstop=3 nowrap syntax=pascal:
 *
 ***** *)

  

$ ./heapsort_demo
a1: [-50, -34, -25, -20, -10, 5, 9, 13, 19, 29, 30, 35, 36]
a2: [-38, -38, -15, -9, -7, -5, 0, 0, 7, 37, 40, 42]
a3: [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30]
$

  

program ShellSort_Example;

uses
  UShellSort;

const
  MaxNum = 100;

var
  a : array [0..MaxNum] of LongInt; 
  i : Integer;

procedure DisplayNumbers;

var 
  j : Integer;

begin
  for j := 1 to MaxNum do begin
    Write(a[j]:5);
    if (j mod 10) = 0 then WriteLn;
  end;
  WriteLn;
end;

begin
  Randomize; { This way we generate a new sequence every time
               the program is run}

  for i := MaxNum downto 1 do begin
    a[i] := Random(100) + 1;
  end;  
  a[0] := 1000;

  WriteLn;
  WriteLn('Example program to sort a list of numbers');
  WriteLn;

  WriteLn('Unsorted Numbers');
  DisplayNumbers();

  ShellSort(a);

  WriteLn('Sorted Numbers');
  DisplayNumbers();

  WriteLn('');
  WriteLn('Finished.');
end.

{ End of File }
  

{ new stuff }

unit UShellSort;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;

type
  TShellSortItem = integer;

procedure ShellSort(var a: array of TShellSortItem);

implementation

procedure ShellSort(var a: array of TShellSortItem);
var i, j, h, n, v : integer;
begin
  n := length(a);
  h := 1;
  repeat
    h := 3*h + 1
  until h > n;

  repeat
    h := h div 3;
    for i := h + 1 to n do begin
      v := a[i];
      j := i;
      while (j > h) and (a[j-h] > v) do begin
        a[j] := a[j-h];
        j := j - h;
      end;
      a[j] := v;
    end
  until h = 1;
end;

end.

(*
 *  vim: ts=3 nowrap syntax=pascal:
 *
 ***** *)