515 lines
13 KiB
Plaintext
515 lines
13 KiB
Plaintext
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}
|
||
|
||
|