UNIT misc1;
{
This unit provides a number of functions of general utility.
}

{

Copyright 1989 by Wesley R. Elsberry.  All rights reserved.

Commercial use of this software is prohibited without written consent of
the author.

For information, bug reports, and updates contact

Wesley R. Elsberry
528 Chambers Creek Drive South
Everman, Texas 76140
Telephone: (817) 551-7018

}


INTERFACE

USES DOS;


 CONST
    ASCII_NUL = #0;
    ASCII_SOH = #1;
    ASCII_STX = #2;
    ASCII_ETX = #3;
    ASCII_EOT = #4;
    ASCII_ENQ = #5;
    ASCII_ACK = #6;
    ASCII_BEL = #7;
    ASCII_BS = #8;
    ASCII_HT = #9;
    ASCII_LF = #10;
    ASCII_VT = #11;
    ASCII_FF = #12;
    ASCII_CR = #13;
    ASCII_SO = #14;
    ASCII_SI = #15;
    ASCII_DLE = #16;
    ASCII_DC1 = #17;
    ASCII_XON = #17;
    ASCII_DC2 = #18;
    ASCII_DC3 = #19;
    ASCII_XOFF = #19;
    ASCII_DC4 = #20;
    ASCII_NAK = #21;
    ASCII_SYN = #22;
    ASCII_ETB = #23;
    ASCII_CAN = #24;
    ASCII_EM  = #25;
    ASCII_SUB = #26;
    ASCII_EOF = #26;
    ASCII_ESC = #27;
    ASCII_FS  = #28;
    ASCII_GS  = #29;
    ASCII_RS  = #30;
    ASCII_US  = #31;
    ASCII_SP  = #32;
    ASCII_EXCL = #33;
    ASCII_DQUOTE = #34;
    ASCII_POUND = #35;
    ASCII_DOLLAR = #36;
    ASCII_PERCENT = #37;
    ASCII_AMPERSAND = #38;
    ASCII_SQUOTE = #39;
    ASCII_OPAREN = #40;
    ASCII_CPAREN = #41;
    ASCII_ASTERISK = #42;
    ASCII_PLUS = #43;
    ASCII_COMMA = #44;
    ASCII_DASH = #45;
    ASCII_PERIOD = #46;
    ASCII_SLASH = #47;
    ASCII_ZERO = #48;
    ASCII_ONE = #49;
    ASCII_TWO = #50;
    ASCII_THREE = #51;
    ASCII_FOUR = #52;
    ASCII_FIVE = #53;
    ASCII_SIX = #54;
    ASCII_SEVEN = #55;
    ASCII_EIGHT = #56;
    ASCII_NINE = #57;
    ASCII_COLON = #58;
    ASCII_SEMICOLON = #59;
    ASCII_LESSTHAN = #60;
    ASCII_EQUAL = #61;
    ASCII_GREATERTHAN = #62;
    ASCII_QMARK = #63;
    ASCII_AT = #64;
    ASCII_OBRACKET = #91;
    ASCII_BACKSLASH = #92;
    ASCII_CBRACKET = #93;
    ASCII_CARAT = #94;
    ASCII_UNDERLINE = #95;
    ASCII_BACKQUOTE = #96;
    ASCII_OBRACE = #123;
    ASCII_VLINE = #124;
    ASCII_CBRACE = #125;
    ASCII_TILDE = #126;
    ASCII_DEL = #127;



 TYPE
    Time_rec_ = RECORD
       h,m,s,f : INTEGER;
       END;


PROCEDURE Time(VAR TR : Time_rec_);
{Gets system time from MS-DOS}

PROCEDURE  Elapsed_time(VAR TR1, TR2 : Time_rec_);
{Computes the difference between TR1 and TR2, returns result in TR1.
 TR1's previous value is destroyed.}

FUNCTION Convert_time_to_real(VAR CTR : Time_rec_):REAL;
{}

PROCEDURE Convert_real_to_time(VAR RT : REAL; VAR CTR : Time_rec_);
{}

PROCEDURE Trim(VAR alex : STRING;tchar : CHAR);
{ This procedure trims a string variable of type STRING beginning

PROCEDURE StrUp(VAR strng : STRING);
{ This procedure maps the characters of a string of type STRING to uppercase}

FUNCTION IsUpper(x : CHAR):BOOLEAN;
{Returns true if x is an uppercase letter}

FUNCTION IsLower(x : CHAR):BOOLEAN;
{Returns true if x is a lowercase letter}

PROCEDURE Error(msg : STRING);
{ writes error message out to screen}

FUNCTION Gaussian(x,mu,sigma : REAL):REAL;
{returns the gaussian density function of x, where mu is the}

FUNCTION Normal_Prob(x,mu,sigma : REAL):REAL;
{uses a polynomial approximation to estimate
the area under the normal curve}

FUNCTION Power(num,expon : REAL):REAL;
{returns num^expon}

FUNCTION Slope(sumx,sumy,sumxy,sumx2,n :REAL):REAL;
{returns linear regression determined slope of line}

FUNCTION Intercept(sumx,sumy,n,m : REAL):REAL;
{returns linear regression determined intercept of line}

FUNCTION CorrCo(m,sigmax,sigmay : REAL):REAL;
{returns correlation coefficient of x and y}

FUNCTION SD(sum,sum_sqrd,n : REAL):REAL;
{returns standard deviation given the sum of values, the sum of 
 the squares of values, and the number of values}

FUNCTION Map_Real(mapval, domain_min, domain_max,
                  range_min, range_max : REAL): REAL;
{ this functions maps the value passed to it into a new range }

FUNCTION Map_Int(mapval, domain_min, domain_max,
                  range_min, range_max : INTEGER): INTEGER;
{ this functions maps the value passed to it into a new range }
{ must have MAP_REAL as above in program }

FUNCTION Map_Int_From_Real(mapval, domain_min, domain_max : REAL;
                           range_min, range_max : INTEGER): INTEGER;
{ this functions maps the value passed to it into a new range of type integer}

FUNCTION dir_console_IO (VAR ch :CHAR) : BOOLEAN;
{Returns TRUE if a character has been captured at the keyboard, FALSE
 otherwise.  If a character has been captured, CH contains it.}

FUNCTION check_kbd_status : BOOLEAN;
{Returns TRUE if a key has been pressed, FALSE otherwise}

FUNCTION max_single(s1,s2 : SINGLE):SINGLE;
{Returns the greater of two SINGLE type values}

FUNCTION min_single(s1,s2 : SINGLE):SINGLE;
{Returns the lesser of two SINGLE type values}


IMPLEMENTATION


 PROCEDURE Time(VAR TR : Time_rec_);
{Gets system time from MS-DOS}

    CONST
       lllama = 0;

    VAR
       regs : registers;

    BEGIN                          {Time}
       WITH regs DO BEGIN
          ax:=$2c00;
          MSDos(regs);
          TR.h := Hi(cx);
          TR.m := Lo(cx);
          TR.s := Hi(dx);
          TR.f := Lo(dx);
          END;
       END;                        {Time}

 FUNCTION Convert_time_to_real(VAR CTR : Time_rec_):REAL;
{}

    VAR
       Tempr : REAL;

    BEGIN                          {Convert_time_to_real}
       WITH CTR DO Tempr := f + (s*100.0) + (m*6000.0) + (h*360000.0);
       Convert_time_to_real := Tempr;
       END;                        {Convert_time_to_real}

 PROCEDURE Convert_real_to_time(VAR RT : REAL;
      VAR CTR : Time_rec_);
{}

    VAR
       TempI : INTEGER;
       Tempr1, Tempr2 : REAL;

    BEGIN                          {Convert_real_to_time}
       WITH CTR DO BEGIN
          Tempr2 := RT;
          Tempr1 := INT(Tempr2 / 360000.0);
          h := Trunc(Tempr1);
          Tempr2 := Tempr2 - (Tempr1 * 360000.0);
          Tempr1 := INT(Tempr2 /6000.0);
          m := Trunc(Tempr1);
          Tempr2 := Tempr2 - (Tempr1 * 6000.0);
          Tempr1 := INT(Tempr2 / 100);
          s := Trunc(Tempr1);
          Tempr2 := Tempr2 - (Tempr1 * 100);
          Tempr1 := INT(Tempr2);
          f := Trunc(Tempr1);
          END;
       END;                        {Convert_real_to_time}


 PROCEDURE  Elapsed_time(VAR TR1, TR2 : Time_rec_);
{Computes the difference between TR1 and TR2, returns result in TR1.
 TR1's previous value is destroyed.}

    VAR
       Dif : TIme_rec_;
       T1 , T2 : REAL;


    BEGIN                          {Elapsed_time}
       Write('Time difference ',TR2.h:2,ascii_Colon,TR2.m:2,ascii_Colon,
            TR2.s:2,ascii_Colon,TR2.f:2, ' - ',TR1.h:2,ascii_Colon,TR1.m:
            2,ascii_Colon,TR1.s:2,ascii_Colon,TR1.f:2);
       T1 := Convert_time_to_real(TR1);
       T2 := Convert_time_to_real(TR2);
       IF (T2 < T1) THEN           {}
            BEGIN
          T2 := T2 + 8640000.0;
          END
       ELSE                        {}
            BEGIN
          END;
       T1 := T2 - T1;
       Convert_real_to_time(T1,TR1);
       Writeln(' = ',TR1.h:2,ascii_Colon,TR1.m:2,ascii_Colon,TR1.s:2,
            ascii_Colon,TR1.f:2);
       END;                        {Elapsed_time}


{$V-}
 PROCEDURE TRIM(VAR alex : STRING;
      tchar : CHAR);
{ This procedure trims a string variable of type STRING beginning
with the first occurrence of the character TCHAR}

    VAR
       ii,jj :INTEGER;

    BEGIN
       ii := Pos(tchar,alex);
       IF ii <> 0 THEN alex := Copy(alex,1,ii-1);
       END;
{$V+}

{$V-}

 PROCEDURE STRUP(VAR strng : STRING);
{ This procedure maps the characters of a string of type STRING to
 uppercase}

    VAR
       ii : INTEGER;

    BEGIN
       FOR ii := 1 TO Length(strng) DO strng[ii] := UpCase(strng[ii]);
       END;
{$V+}


 FUNCTION ISUPPER(x : CHAR):BOOLEAN;
{Returns true if x is an uppercase letter}

    BEGIN
       IF (x IN ['A'..'Z']) THEN isupper := TRUE
       ELSE isupper := FALSE;
       END;

 FUNCTION ISLOWER(x : CHAR):BOOLEAN;
{Returns true if x is a lowercase letter}

    BEGIN
       IF (x IN ['a'..'z']) THEN islower := TRUE
       ELSE islower := FALSE;
       END;

{$V-}

 PROCEDURE ERROR(msg : STRING);
{ writes error message out to screen}

    CONST
       bell = ^G;

    BEGIN
       Write(bell,msg);
       END;
{$V+}


 FUNCTION GAUSSIAN(x,mu,sigma : REAL):REAL;
{returns the gaussian density function of x, where mu is the
mean and sigma is the standard deviation}

    BEGIN
       gaussian := (1/(sigma*Sqrt(2*Pi)))*Exp(-Sqr(x-mu)/(2*Sqr(sigma)));
       END;

 FUNCTION NORMAL_PROB(x,mu,sigma : REAL):REAL;
{uses a polynomial approximation to estimate
the area under the normal curve}

    CONST
       b1 = 0.319381530;
       b2 = -0.356563782;
       b3 = 1.781477937;
       b4 = -1.821255978;
       b5 = 1.330274429;
       p = 0.2316419;
       epsi = 7.5E-09;

    VAR
       t, t2, t3, t4, t5, q, z : REAL;

    BEGIN
       z := gaussian(x,mu,sigma) * ((x-mu)/sigma);
       t := 1/(1+p*x);
       t2 := t*t;
       t3 := t2*t;
       t4 := t3*t;
       t5 := t4*t;
       q := z * (b1*t + b2*t2 + b3*t3 + b4*t4 + b5*t5) + epsi;
       normal_prob := 1-q;
       END;

 FUNCTION POWER(num,expon : REAL):REAL;
{returns num^expon}

    CONST
       Machine_infinity = 1E37;

    VAR
       temp : REAL;

    BEGIN
       temp := expon*Ln(num);
       IF temp >= Ln(machine_infinity) THEN power := machine_infinity
       ELSE power := Exp(temp);
       END;

 FUNCTION SLOPE(sumx,sumy,sumxy,sumx2,n :REAL):REAL;
{returns linear regression determined slope of line}

    BEGIN
       slope := (sumxy-(sumx*sumy/n))/ (sumx2-(Sqr(sumx)/n));
       END;

 FUNCTION INTERCEPT(sumx,sumy,n,m : REAL):REAL;
{returns linear regression determined intercept of line}

    BEGIN
       intercept := ((sumy-(m*sumx))/n);
       END;

 FUNCTION CORRCO(m,sigmax,sigmay : REAL):REAL;
{returns correlation coefficient of x and y}

    BEGIN
       corrco := m*sigmax/sigmay;
       END;

 FUNCTION SD(sum,sum_sqrd,n : REAL):REAL;
{returns standard deviation given the sum of values, the sum of
the squares of values, and the number of values}

    BEGIN
       sd := Sqrt((sum_sqrd-(Sqr(sum)/n))/(n-1));
       END;

 FUNCTION MAP_REAL(mapval, domain_min, domain_max, range_min, range_max :
      REAL): REAL;
{ this functions maps the value passed to it into a new range }

    BEGIN
       map_real :=  (((mapval - domain_min)/(domain_max - domain_min)) * (
            range_max - range_min))  + range_min;
       END;

 FUNCTION MAP_INT(mapval, domain_min, domain_max, range_min, range_max :
      INTEGER): INTEGER;
{ this functions maps the value passed to it into a new range }
{ must have MAP_REAL as above in program }

    VAR
       mv, dn, dx, rn, rx : REAL;

    BEGIN
       mv := mapval;
       dn := domain_min;
       dx := domain_max;
       rn := range_min;
       rx := range_max;
       map_int := Round(map_real(mv,dn,dx,rn,rx));
       END;

 FUNCTION MAP_INT_FROM_REAL(mapval, domain_min, domain_max : REAL;
      range_min, range_max : INTEGER): INTEGER;
{ this functions maps the value passed to it into a new range of type
 integer}

    BEGIN
       map_int_from_real := Round(map_real(mapval,domain_min,domain_max,
            range_min,range_max));

       END;


 FUNCTION dir_console_IO (VAR ch :CHAR) : BOOLEAN;

    VAR
       regs : registers;           {From the DOS unit}

    BEGIN
       regs.AH := $06;
       regs.DL := $FF;
       MSDos(regs);
       IF ((regs.flags AND FZERO) = 0) THEN BEGIN
          ch := Chr(regs.AL);
          dir_console_IO := TRUE;
          END
       ELSE BEGIN
          dir_console_IO := FALSE;
          END;
       END;

 FUNCTION check_kbd_status : BOOLEAN;

    VAR
       regs : registers;           {From the DOS unit}

    BEGIN
       regs.AH := $0B;
       MSDos(regs);
       IF (Ord(regs.AL) = $FF) THEN BEGIN
          check_kbd_status := TRUE;
          END
       ELSE BEGIN
          check_kbd_status := FALSE;
          END;
       END;

 FUNCTION max_single(s1,s2 : SINGLE):SINGLE;
{Returns the greater of two SINGLE type values}

    BEGIN
       IF s1 >= s2 THEN max_single := s1
       ELSE max_single := s2;
       END;


 FUNCTION min_single(s1,s2 : SINGLE):SINGLE;
{Returns the lesser of two SINGLE type values}

    BEGIN
       IF s1 < s2 THEN min_single := s1
       ELSE min_single := s2;
       END;

BEGIN {initialize}
END. {INITIALIZE}