Power-Programmierung/CD1.mdf/magazine/drdobbs/1987/10/shamlst.oct

Text File | 1987-09-14 | 10KB | 442 lines

Listing 1.  QuickBASIC library to implement opaque matrices.

' QuickBASIC implementation of an opaque numeric matrix
' Matrix is stored as arrays of columns
' OPTION BASE 0 must be used, although the row/column indices
' start at one.

SUB InitMat(Mat#(1), Max.Row%, Max.Col%) STATIC
' Initialize matrix

Mat#(0) = Max.Row% + Max.Col% / 1000

FOR I% = 1 TO UBound(Mat#)
   Mat#(I%) = 0
NEXT I%

END SUB ' CreateMat


SUB StoreElem(Mat#(1), Row%, Col%, Elem#, OK%) STATIC

' Store Elem# in matrix position (Row%,Col%)
' OK% is zero if error has occurred, -1 if operation was done

STATIC I%, MaxR%, MaxC%

MaxR% = INT(Mat#(0))
MaxC% = 1000 * (Mat#(0) - MaxR%)

IF (MaxR% < Row%) OR (MaxC% < Col%) OR (Row% < 1) OR (Col% < 1) THEN
   OK% = 0 ' Bad row or column numbers.
   EXIT SUB
END IF

OK% = -1

' Calculate index
I% = Row% + (Col% - 1) * MaxR%
' for the arrays of rows representation use
'    I% = Col% + (Row% - 1) * MaxC%


' Store element
Mat#(I%) = Elem#

END SUB ' StoreElem


SUB RecallElem(Mat#(1), Row%, Col%, Elem#, OK%) STATIC

' Recall Elem# in matrix position (Row%,Col%)
' OK% is zero if error has occurred, -1 if operation was done

STATIC I%, MaxR%, MaxC%

MaxR% = INT(Mat#(0))
MaxC% = 1000 * (Mat#(0) - MaxR%)

IF (MaxR% < Row%) OR (MaxC% < Col%) OR (Row% < 1) OR (Col% < 1) THEN
   OK% = 0 ' Bad row or column numbers.
   EXIT SUB
END IF

OK% = -1

' Calculate index
I% = Row% + (Col% - 1) * MaxR%
' for the arrays of rows representation use
'    I% = Col% + (Row% - 1) * MaxC%

' Recall element
Elem# = Mat#(I%)

END SUB ' RecallElem



Listing 2.  True BASIC module that implements an array-based binary tree.

MODULE  Binary_Tree

! TRUE BASIC module that implements a single binary tree
! Copyright (c) 1987  Namir Clement Shammas

DECLARE DEF NIL, TRUE, FALSE
SHARE Left(1), Right(1), Node_Count, Num_Nodes, Bin_Tree$(1)


!------------ Module initialization ---------
LET Num_Nodes = 0

!----------- local functions -----------
DEF NIL = MAXNUM
DEF TRUE = 1
DEF FALSE = 0


SUB Initialize(Item$)
! Subroutine to initialize the binary tree

LET Num_Nodes = 1
LET Tree_Size = 1
LET Bin_Tree$(1) = Item$
LET Left(1) = NIL
LET Right(1) = NIL

END SUB


SUB Search(Item$, Found, Index)
! Search for Item$ and return Index if found.

LET Found = FALSE
LET Index = 1

DO WHILE (Index <> NIL) AND (Found = FALSE)
   IF Bin_Tree$(Index) = Item$ THEN
      LET Found = TRUE
   ELSE
      IF Bin_Tree$(Index) < Item$ THEN
         LET Index = Right(Index)
      ELSE
         LET Index = Left(Index)
      END IF
   END IF
LOOP

END SUB


SUB Insert(Item$)
! Insert Item$ in the "dynamic" binary tree structure

LET Num_Nodes = Num_Nodes + 1

IF Num_Nodes > Tree_Size THEN
   LET Tree_Size = Num_Nodes
   MAT REDIM Bin_Tree$(Tree_Size), Left(Tree_Size), Right(Tree_Size)
END IF

LET Index = 1
LET Found = FALSE

DO WHILE Index <> NIL
   IF Bin_Tree$(Index) < Item$ THEN
      IF Right(Index) <> NIL THEN
         LET Index = Right(Index)
      ELSE
         LET Right(Index) = Num_Nodes
         LET Index = NIL
      END IF
   ELSE
      IF Left(Index) <> NIL THEN
         LET Index = Left(Index)
      ELSE
         LET Left(Index) = Num_Nodes
         LET Index = NIL
      END IF
   END IF
LOOP

LET Bin_Tree$(Num_Nodes) = Item$
LET Right(Num_Nodes) = NIL
LET Left(Num_Nodes) = NIL

END SUB

END MODULE



Listing 3.  Pascal code for emulating opaque complex data types.



TYPE
    Opaque_Complex_type = ^Opaque_Complex_type_record;

    { record type is deliberately empty }
    Opaque_Complex_type_record = RECORD
                                 END;


    Actual_Complex_type = ^Actual_Complex_type_record;

    Actual_Complex_type_record = RECORD
                                    Reel,
                                    Imag : REAL;
                                 END;

    Convert_Complex = RECORD
                        CASE BOOLEAN OF
                            TRUE  : (Opaque : Opaque_Complex_type);
                            FALSE : (Actual : Actual_Complex_type)
                        END;



FUNCTION Convert_Opaque_to_Actual( Opaque_Complex : Opaque_Complex_type ) :
                                    Actual_Complex_type;

VAR Transfer : Convert_Complex;

BEGIN
    Transfer.Opaque := Opaque_Complex;
    Convert_Opaque_to_Actual := Transfer.Actual
END; { Convert_Opaque_to_Actual }



FUNCTION Convert_Actual_to_Opaque( Actual_Complex : Actual_Complex_type ) :
                                    Opaque_Complex_type;

VAR Transfer : Convert_Complex;

BEGIN
    Transfer.Actual := Actual_Complex;
    Convert_Actual_to_Opaque := Transfer.Opaque
END; { Convert_Actual_to_Opaque }



FUNCTION Real_Imag_Complex(Re, Im : REAL) : Opaque_Complex_type;
{ Convert from Real/Imaginary numbers to opaque complex numbers }
VAR Transfer : Actual_Complex_type;

BEGIN
    NEW(Transfer);
    Transfer^.Reel := Re;
    Transfer^.Imag := Im;
    Real_Imag_Complex:= Convert_Actual_to_Opaque(Transfer);
END; { Real_Imag_Complex }


FUNCTION Polar_Complex(Angle, Modulus : REAL) : Opaque_Complex_type;
{ Convert from polar coordinates to opaque complex numbers }
VAR Transfer : Actual_Complex_type;

BEGIN
    NEW(Transfer);
    Transfer^.Reel := Modulus * SIN(Angle);
    Transfer^.Imag := Modulus * COS(Angle);
    Real_Imag_Complex:= Convert_Actual_to_Opaque(Transfer);
END; { Polar_Complex }



PROCEDURE Get_Real_Imag(MyComplex : Opaque_Complex_type;
                        VAR Re, Im : REAL { output});
{ Convert opaque complex numbers into Real/Imaginary components }
VAR Transfer : Actual_Complex_type;

BEGIN
    Transfer := Convert_Opaque_to_Actual(MyComplex);
    Re := Transfer^.Reel;
    Im := Transfer^.Imag;
END; { Get_Real_Imag }


PROCEDURE Get_Polar(MyComplex : Opaque_Complex_type;
                    VAR Angle, Modulus : REAL { output});
{ Convert opaque complex numbers into polar components }
VAR Transfer : Actual_Complex_type;

BEGIN
    Transfer := Convert_Opaque_to_Actual(MyComplex);
    WITH Transfer^ DO BEGIN
        Modulus := SQRT(SQR(Reel) + SQR(Imag));
        Angle   := Imag / Reel;
    END; { WITH }
END; { Get_Polar }



FUNCTION Add_Complex(C1, C2 : Opaque_Complex_type) : Opaque_Complex_type;


VAR Transfer : Actual_Complex_type;
    Re, Im : REAL;

BEGIN
    { Get first complex number }
    Transfer := Convert_Opaque_to_Actual(C1);
    Re := Transfer^.Reel;
    Im := Transfer^.Imag;
    { Get second complex number }
    Transfer := Convert_Opaque_to_Actual(C2);
    Re := Re + Transfer^.Reel;
    Im := Im + Transfer^.Imag;
    { Update result }
    Transfer^.Reel := Re;
    Transfer^.Imag := Im;
    Add_Complex := Convert_Actual_to_Opaque(Transfer);
END; { Add_Complex }



Listing 4.  Modula-2 code for opaque complex data types.


DEFINITION MODULE Complex;

EXPORT QUALIFIED Complex, RealImagComplex, PolarComplex,


TYPE  Complex; (* opaque type *)


PROCEDURE RealImagComplex(Re, Im : REAL) : Complex;
(* Convert from Real/Imaginary numbers to opaque complex numbers *)

PROCEDURE PolarComplex(Angle, Modulus : REAL) : Complex;
(* Convert from polar coordinates to opaque complex numbers *)

PROCEDURE GetRealImag(MyComplex : Complex; VAR Re, Im : REAL (* output *));
(* Convert opaque complex numbers into Real/Imaginary components *)


PROCEDURE GetPolar(MyComplex : Complex; VAR Angle, Modulus : REAL (* output*));
(* Convert opaque complex numbers into polar components *)

PROCEDURE AddComplex(C1, C2 : Complex) : Complex;

END Complex.



IMPLEMENTATION MODULE Complex;

FROM MathLib0 IMPORT sqrt, sin, cos;

TYPE

    ComplexRecord = RECORD
                       Reel,
                       Imag : REAL;
                    END;

    (* opaque type mus be a pointer *)
    Complex = POINTER TO ComplexRecord;


PROCEDURE RealImagComplex(Re, Im : REAL) : Complex;
(* Convert from Real/Imaginary numbers to opaque complex numbers *)

VAR C : Complex;

BEGIN
    NEW(C);
    C^.Reel := Re;
    C^.Imag := Im;
    RETURN(C)
END RealImagComplex;


FUNCTION PolarComplex(Angle, Modulus : REAL) : Complex;
(* Convert from polar coordinates to opaque complex numbers *)

VAR C : Complex;

BEGIN
    NEW(C);
    C^.Reel := Modulus * sin(Angle);
    C^.Imag := Modulus * cos(Angle);
    RETURN(C)
END PolarComplex;



PROCEDURE GetRealImag(MyComplex : Complex; VAR Re, Im : REAL (* output *));
(* Convert opaque complex numbers into Real/Imaginary components *)

BEGIN
    Re := MyComplex^.Reel;
    Im := MyComplex^.Imag;
END GetRealImag;


PROCEDURE GetPolar(MyComplex : Complex; VAR Angle, Modulus : REAL (* output*));
(* Convert opaque complex numbers into polar components *)

BEGIN
    WITH MyComplex DO
      Modulus := sqrt(Reel*Reel + Imag*Imag);
      Angle   := Imag / Reel;
    END;
END GetPolar;



PROCEDURE AddComplex(C1, C2 : Complex) : Complex;

VAR C : Complex;
    Re, Im : REAL;

BEGIN
    (* Get first complex number *)
    Re := C1^.Reel;
    Im := C1^.Imag;
    (* Get second complex number *)
    Re := Re + C2^.Reel;
    Im := Im + C2^.Imag;
    (* Update result *)
    C^.Reel := Re;
    C^.Imag := Im;
    RETURN(C)
END AddComplex;

END Complex.





SUB Jekyll.and.Hyde(<argument list>, Menu.Choice) STATIC

STATIC <list of scalar and arrays used to implement opaque structure>

SELECT CASE Menu.Choice

  CASE 1

      <sequence of statements>

  CASE 2

      <sequence of statements>

  CASE 3

      <sequence of statements>

  ELSE

      <sequence of statements>

END SELECT

END SUB

Example 1: General scheme for using static local variables in QuickBASIC and Turbo BASIC