UNIT vector;

  (*  DESCRIPTION :
     Set of 22 functions and procedures for vector ,i.e array of real
     Manipulation de vecteur: 22 fonctions et proc‚dures

     RELEASE     :  1.0
     DATE        :  25/04/94
     AUTHOR      :  Fernand LEMOINE
                    rue du CollŠge 34
                    B-6200 CHATELET
                    BELGIQUE
     All code granted to the public domain
     Questions and comments are welcome
     REQUIREMENT :  Turbo Pascal 7.0 or later
                       *  open-string parameter
                       *  constant parameter
     Compatible with Borland Pascal protected mode
     Compatible with Borland Pascal for Windows (Wincrt)
     OPTIONS
        * accept zero for computation or not accept ( default)
           exceptions : VStd, VVar

        * lim = all : perform computation for all the values of the vector
          otherwise lim = number of values to compute
  *)

INTERFACE

CONST
  all = 0;
  accept_zero : Boolean = False;

  (* Clear all values - remise … z‚ro                                      *)
PROCEDURE VClear(VAR A : ARRAY OF Real; lim : Word);
  (* Display  of a vector  - Affichage d'un vecteur                        *)
PROCEDURE VDisplay(CONST A : ARRAY OF Real; l, m : Byte);
  (* Linear index generator - G‚n‚ration d 'index                          *)
PROCEDURE VIndex(VAR A : ARRAY OF Real; lim : Word);
  (* Random generator - G‚n‚rateur al‚atoire                               *)
PROCEDURE VRnd(VAR A : ARRAY OF Real; lim : Word);
  (* Sum   of a vector  - Somme d'un vecteur                               *)
FUNCTION VSum(CONST A : ARRAY OF Real; lim : Word) : Real;
  (* Product  of a vector  - Produit d'un  vecteur                         *)
FUNCTION VProd(CONST A : ARRAY OF Real; lim : Word) : Real;
  (* Minimum  of a vector  - Miniimum d'un vecteur                         *)
FUNCTION VMin(CONST A : ARRAY OF Real; lim : Word) : Real;
  (* Average of a vector  - Moyenne d'un vecteur                           *)
FUNCTION VAvg(CONST A : ARRAY OF Real; lim : Word) : Real;
  (* Maximum   of a vector  - Maximum d'un vecteur                         *)
FUNCTION VMax(CONST A : ARRAY OF Real; lim : Word) : Real;
  (* First value of a vector  - PremiŠre valeur d'un vecteur               *)
FUNCTION VFirst(CONST A : ARRAY OF Real; lim : Word) : Real;
  (* Last  value of a vector  - DerniŠre valeur d'un vecteur               *)
FUNCTION VLast(CONST A : ARRAY OF Real; lim : Word) : Real;
  (* Number of values of a vector - Nombre de valeurs d'un vecteur         *)
FUNCTION VSize(CONST A : ARRAY OF Real; lim : Word) : Word;

  (* Standard deviation of a vector - Ecart-type d'un vecteur              *)
(* Opt = 'P' : Population
         'S' : Sample     - Echantillon                                    *)

FUNCTION VStd(CONST A : ARRAY OF Real; opt : Char; lim : Word) : Real;
  (* Variance of a vector  - Variance d'un vecteur                         *)
(* Opt = 'P' : Population
         'S' : Sample     - Echantillon                                    *)
FUNCTION VVar(CONST A : ARRAY OF Real; opt : Char; lim : Word) : Real;

  (* Position of maximum     -  Position du maximum d'un vecteur           *)
FUNCTION VOrdMax(CONST A : ARRAY OF Real; lim : Word) : Word;
  (* Position of minimum    -  Position du minimum d'un vecteur            *)
FUNCTION VOrdMin(CONST A : ARRAY OF Real; lim : Word) : Word;
  (*  Subtract minimum from maximum of a vector
   Diff‚rence entre maximum et minimum d'un vecteur                        *)
FUNCTION VRange(CONST A : ARRAY OF Real; lim : Word) : Real;
 (*  Mean between maximum and minimum of a vector
   Moyenne du maximum et et du minimum d'un vecteur                        *)
FUNCTION VMidRange(CONST A : ARRAY OF Real; lim : Word) : Real;
 (* Median of a vector    - M‚diane d'un vecteur
    If not in ascending order , VMedian returns zero
    Doit ˆtre tri‚ en ordre ascendant  sinon valeur z‚ro
  *)
FUNCTION VMedian(CONST A : ARRAY OF Real; lim : Word) : Real;

  (* Reverse order   of a vector -  Retournement   d'un vecteur             *)
PROCEDURE VReverse(VAR A : ARRAY OF Real; lim : Word);
  (* Ascending sort of a vector -  Tri ascendant d'un vecteur               *)
PROCEDURE VAscSort(VAR A : ARRAY OF Real; lim : Word);
  (* Descending sort of a vector -  Tri descendant d'un vecteur              *)
PROCEDURE VDescSort(VAR A : ARRAY OF Real; lim : Word);


IMPLEMENTATION
USES crt;

  FUNCTION Ascending_Order(CONST A : ARRAY OF Real; lim : Word) : Boolean;
  VAR
    i, limit : Word;
    correct_order : Boolean;
  BEGIN
    correct_order := True;
    IF lim = all THEN limit := high(A)
    ELSE limit := lim - 1;
    FOR i := 0 TO limit - 1 DO
      IF A[i] > A[i + 1] THEN
        correct_order := False;
    Ascending_Order := correct_order;
  END;
    (* --------------------------------------------------------------*)
  PROCEDURE VClear(VAR A : ARRAY OF Real; lim : Word);
  VAR
    i, limit : Word;
  BEGIN
    IF lim = all THEN limit := high(A)
    ELSE limit := lim - 1;
    FOR i := 0 TO limit DO
      A[i] := 0;
  END;
    (* --------------------------------------------------------------*)
  PROCEDURE VDisplay(CONST A : ARRAY OF Real; l, m : Byte);
  VAR
    i : Word;
    total : Byte;
  BEGIN
    IF m > 0 THEN total := l + m + 1
    ELSE total := l;

    FOR i := 0 TO high(A) DO
    BEGIN
      IF wherey >= (80 - total) THEN WriteLn;
      Write(A[i]:l:m, ' ');
    END;
    WriteLn;
  END;

    (* --------------------------------------------------------------*)
  PROCEDURE VIndex(VAR A : ARRAY OF Real; lim : Word);
  VAR
    i, limit : Word;
  BEGIN
    IF lim = all THEN limit := high(A)
    ELSE limit := lim - 1;
    FOR i := 0 TO limit DO
      A[i] := i + 1;
  END;
    (* --------------------------------------------------------------*)
  PROCEDURE VRnd(VAR A : ARRAY OF Real; lim : Word);
  VAR
    i, limit : Word;
  BEGIN
    Randomize;
    IF lim = all THEN limit := high(A)
    ELSE limit := lim - 1;
    FOR i := 0 TO limit DO
      A[i] := Random(i);
  END;
    (* --------------------------------------------------------------*)
  FUNCTION VSize(CONST A : ARRAY OF Real; lim : Word) : Word;
  VAR
    i, j, limit : Word;
  BEGIN
    IF lim = all THEN limit := high(A)
    ELSE limit := lim - 1;
    j := 0;
    FOR i := 0 TO limit DO
      IF (NOT accept_zero) AND (A[i] = 0) THEN continue
      ELSE
        Inc(j);
    VSize := j;
  END;
    (* --------------------------------------------------------------*)
  FUNCTION VSum(CONST A : ARRAY OF Real; lim : Word) : Real;
  VAR
    i, limit : Word;
    S : Real;
  BEGIN
    IF lim = all THEN limit := high(A)
    ELSE limit := lim - 1;
    S := 0;
    FOR i := 0 TO limit DO
      S := S + A[i];
    VSum := S;
  END;

    (* --------------------------------------------------------------*)
  FUNCTION VProd(CONST A : ARRAY OF Real; lim : Word) : Real;
  VAR
    i, limit : Word;
    S : Real;
  BEGIN
    IF lim = all THEN limit := high(A)
    ELSE limit := lim - 1;
    S := 1;
    FOR i := 0 TO limit DO
      IF (NOT accept_zero) AND (A[i] = 0) THEN continue
      ELSE
        S := S * A[i];
    VProd := S;
  END;
    (* --------------------------------------------------------------*)
  FUNCTION VMin(CONST A : ARRAY OF Real; lim : Word) : Real;
  VAR
    i, limit : Word;
    S : Real;
  BEGIN
    S := 1E+38;
    IF lim = all THEN limit := high(A)
    ELSE limit := lim - 1;
    FOR i := 0 TO limit DO
      IF (NOT accept_zero) AND (A[i] = 0) THEN continue
      ELSE
        IF A[i] < S THEN S := A[i];
    VMin := S;
  END;
    (* --------------------------------------------------------------*)
  FUNCTION VMax(CONST A : ARRAY OF Real; lim : Word) : Real;
  VAR
    i, limit : Word;
    S : Real;
  BEGIN
    IF lim = all THEN limit := high(A)
    ELSE limit := lim - 1;
    S := A[low(A)];
    FOR i := 0 TO limit DO
      IF A[i] > S THEN S := A[i];
    VMax := S;
  END;

    (* --------------------------------------------------------------*)
  FUNCTION VAvg(CONST A : ARRAY OF Real; lim : Word) : Real;
  BEGIN
    VAvg := VSum(A, lim) / (VSize(A, lim));
  END;
    (* --------------------------------------------------------------*)

  FUNCTION VFirst(CONST A : ARRAY OF Real; lim : Word) : Real;
  VAR
    i, limit : Word;
  BEGIN
    IF accept_zero THEN
      VFirst := A[low(A)]
    ELSE
    BEGIN
      IF lim = all THEN limit := high(A)
      ELSE limit := lim - 1;
      FOR i := 0 TO limit DO
        IF A[i] <> 0 THEN
        BEGIN
          VFirst := A[i];
          break;
        END;
    END;
  END;
    (* --------------------------------------------------------------*)

  FUNCTION VLast(CONST A : ARRAY OF Real; lim : Word) : Real;
  VAR
    i, limit : Word;
  BEGIN
    IF lim = all THEN limit := high(A)
    ELSE limit := lim - 1;
    IF accept_zero THEN
      VLast := A[limit]
    ELSE
    BEGIN
      FOR i := limit DOWNTO 0 DO
        IF A[i] <> 0 THEN
        BEGIN
          VLast := A[i];
          break;
        END;
    END;
  END;

    (* --------------------------------------------------------------*)
  FUNCTION VOrdMax(CONST A : ARRAY OF Real; lim : Word) : Word;
  VAR
    i, limit : Word;
    S : Real;
  BEGIN
    IF lim = all THEN limit := high(A)
    ELSE limit := lim - 1;
    S := A[low(A)]; VOrdMax := 1;
    FOR i := 0 TO limit DO
      IF A[i] > S THEN
      BEGIN
        S := A[i];
        VOrdMax := i + 1;
      END;
  END;
   (* --------------------------------------------------------------*)

  FUNCTION VOrdMin(CONST A : ARRAY OF Real; lim : Word) : Word;
  VAR
    i, limit : Word;
    S : Real;
  BEGIN
    IF lim = all THEN limit := high(A)
    ELSE limit := lim - 1;
    S := 1E+38; VOrdMin := 1;

    FOR i := 0 TO limit DO
      IF (NOT accept_zero) AND (A[i] = 0) THEN continue
      ELSE
        IF A[i] < S THEN
        BEGIN
          S := A[i];
          VOrdMin := i + 1;
        END;
  END;

    (* --------------------------------------------------------------*)
  FUNCTION VRange(CONST A : ARRAY OF Real; lim : Word) : Real;
  BEGIN
    VRange := VMax(A, all) - VMin(A, all);
  END;

    (* --------------------------------------------------------------*)
  FUNCTION VMidRange(CONST A : ARRAY OF Real; lim : Word) : Real;
  BEGIN
    VMidRange := (VMax(A, all) + VMin(A, all)) / 2;
  END;
    (* --------------------------------------------------------------*)
  FUNCTION VMedian(CONST A : ARRAY OF Real; lim : Word) : Real;
  VAR
    j, num : Word;
  BEGIN
    IF lim = all THEN num := high(A) + 1
    ELSE num := lim;
    IF NOT Ascending_Order(A, lim) THEN
    BEGIN
      VMedian := 0;
      Exit;
    END;

    IF Odd(num) THEN
      VMedian := A[(num DIV 2)]
    ELSE
      VMedian := (A[(num DIV 2) - 1] + A[(num DIV 2)]) / 2.0
  END;
    (* --------------------------------------------------------------*)
  PROCEDURE VReverse(VAR A : ARRAY OF Real; lim : Word);
  VAR
    i, j, limit, middle : Word;
    work : Real;
  BEGIN
    IF lim = all THEN limit := high(A)
    ELSE limit := lim - 1;
    IF Odd(limit) THEN middle := (limit DIV 2) + 1
    ELSE middle := limit DIV 2;
    FOR i := 0 TO middle DO
    BEGIN
      work := A[i];
      A[i] := A[limit];
      A[limit] := work;
      Dec(limit);
    END;
  END;
  (* --------------------------------------------------------------*)

  PROCEDURE VAscSort(VAR A : ARRAY OF Real; lim : Word);
  VAR
    i, gap, limit : Word;
    exchange : Boolean;
    temp : Real;
  BEGIN
    IF lim = all THEN limit := high(A)
    ELSE limit := lim - 1;
    gap := limit DIV 2;
    REPEAT
      REPEAT
        exchange := False;
        FOR i := 0 TO limit - gap DO
          IF A[i] > A[i + gap] THEN
          BEGIN
            temp := A[i];
            A[i] := A[i + gap];
            A[i + gap] := temp;
            exchange := True;
          END;
      UNTIL NOT exchange;
      gap := gap DIV 2;
    UNTIL gap = 0;
  END;
  (* --------------------------------------------------------------*)

  PROCEDURE VDescSort(VAR A : ARRAY OF Real; lim : Word);
  VAR
    i, gap, limit : Word;
    exchange : Boolean;
    temp : Real;
  BEGIN
    IF lim = all THEN limit := high(A)
    ELSE limit := lim - 1;
    gap := limit DIV 2;
    REPEAT
      REPEAT
        exchange := False;
        FOR i := 0 TO limit - gap DO
          IF A[i] < A[i + gap] THEN
          BEGIN
            temp := A[i];
            A[i] := A[i + gap];
            A[i + gap] := temp;
            exchange := True;
          END;
      UNTIL NOT exchange;
      gap := gap DIV 2;
    UNTIL gap = 0;
  END;
  (* --------------------------------------------------------------*)
  FUNCTION VVar(CONST A : ARRAY OF Real; opt : Char; lim : Word) : Real;
  VAR
    i, limit, numobs : Word;
    S, vari : Real;
  BEGIN
    IF lim = all THEN limit := high(A)
    ELSE limit := lim - 1;
    numobs := limit + 1;

    S := 0.0; vari := 0.0;
    FOR i := 0 TO limit DO
    BEGIN
      S := S + A[i];
      vari := vari + Sqr(A[i]);
    END;

    IF Upcase(opt) = 'S' THEN
      VVar := (vari - Sqr(S) / numobs) / (numobs - 1)
    ELSE
      VVar := (vari - Sqr(S) / numobs) / numobs;
  END;
  (* --------------------------------------------------------------*)

  FUNCTION VStd(CONST A : ARRAY OF Real; opt : Char; lim : Word) : Real;
  BEGIN
    VStd := Sqrt(VVar(A, opt, lim));
  END;
  (* --------------------------------------------------------------*)
END.

{ ----------------   DEMO PROGRAM   ------------------ }

program demovect;
uses crt,vector;

const
 A : array[1..6] of real = (45,26,184,2,0,86);
var
 B : array[1..5] of real;

 begin
   clrscr;Writeln('Demo vector unit');
   VDisplay(A,3,0);

   VAscSort(A,all);
   VDisplay (A,3,0);
   VDescSort(A,all);
   VDisplay (A,3,0);

   VIndex(B,all);
   VDisplay (B,3,0);
   VReverse(B,all);
   VDisplay (B,3,0);
   VClear(B,all);
   VRnd(B,all);

(*   accept_zero := true;  *)    {   <----------- can be modified }

   writeln('Size         ',VSize(A,all):3);
   writeln('Product      ',VProd(A,all):5:0);
   writeln('Sum          ',VSum (A,all):5:0);
   writeln('Average      ',VAvg (A,all):5:2);
   writeln('Maximum      ',VMax (A,all):5:0);
   writeln('Maximum    4 ',VMax (A,4):5:0);
   writeln('Minimum      ',VMin (A,all):5:0);
   writeln('First value  ',VFirst(A,all):5:0);
   writeln('Last  value  ',VLast(A,all):5:0);
   writeln('Last value 4 ',VLast(A,4):5:0);

   writeln('Ord  max     ',VOrdMax(A,all):3);
   writeln('Ord  min     ',VOrdMin(A,all):3);
   writeln('Range        ',VRange (A,all):3:2);
   writeln('Midrange     ',VMidRange(A,all):3:2);
   VAscSort(A,all);
   writeln('Median all   ',VMedian(A,all):5:2);
   writeln('Median 4     ',VMedian(A,4):5:2);
   writeln('Variance     ',VVar(A,'S',all):5:2);
   writeln('St deviation ',VStd(A,'S',all):5:2);
   delay(3500);

  end.