CD Actual 15/CDACTUAL15.iso/cdactual/program/pascal/SPARSE.ZIP/SPARSE.LIB

Text File | 1986-03-27 | 4.3 KB | 188 lines

{ Sparse Matrix Library }
{ David Myers           }
{ Biochemistry Dept     }
{ Rice University       }
{ Houston TX 77251      }

{ this code requires that you define the following structures and types }
{ this code is probably useless if you have a matrix smaller than }
{ 100 by 100 }
{ STORAGE CONSUMED: }
{ 20 bytes per Node, 4kb per 100 elements in an empty square array }
{ The storage consumed for a 400 x 400 tridiagonal array =

               20 x (399 + 399 + 400) = 23960 bytes
                           20 x 801   = 16020 bytes
                           ------------------------
                                      = 39980 bytes               }

  CONST
    Maxcolms = 300;
    Maxrows  = 300;

  TYPE
    rownum = 1 .. Maxrows;
    colnum = 1 .. Maxcolms;
    NodePtr = ^NodeType;
    NodeType = RECORD
      row : rownum;
      col : colnum;
      val : real;
      nextrow : NodePtr;
      nextcol : NodePtr;
    end;

{ conventions : A is the pointer to the sparse matrix }

function FindRowPos(A : NodePtr; r: rownum;c : colnum) : NodePtr;

{ this function returns a pointer to a node in row r immediately
  preceeding the position of interest, if it exists              }

VAR
  P,Q,Z : NodePtr;

BEGIN
  P := a;
  While (p^.row < r) do
    p := p^.nextrow;
  Q := p;
  z := p^.nextCOL;
  While (p^.COL < c) and (z^.COL <> 0) do
    BEGIN
      q := p;
      p := p^.nextCOL;
      z := p^.nextCOL;
    END;
  If ( p^.COL >= c )
    then FindRowPos := q
  else FindRowPos := p;
END; { FindRowPos }

function FindColmPos(A : NodePtr; r: rownum;c : colnum) : NodePtr;

{ this function returns a pointer to a node in column c immediately
  preceeding the position of interest, if it exists              }

VAR
  P,Q,Z : NodePtr;

BEGIN
  P := a;
  While (p^.col < c) do
    p := p^.nextcol;
  Q := p;
  z := p^.nextrow;
  While (p^.row < r) and (z^.row <> 0) do
    BEGIN
      q := p;
      p := p^.nextrow;
      z := p^.nextrow;
    END;
  If ( p^.row >= r )
    then FindColmPos := q
  else FindColmPos := p;
END; { FindColmPos }

PROCEDURE InsertAfter(rowptr,colptr : NodePtr; R : real);
{ This procedure inserts a new node after rowptr^ and colptr^,
  in the same row as rowptr^ and the same col as colptr^      }

Var
  Node : NodePtr;

BEGIN
  if (rowptr = NIL) or (colptr = NIL)
    then writeln('*******VOID INSERTION******')
  else begin
    new(Node);
    Node^.val := R;
    Node^.nextcol := RowPtr^.nextcol;
    RowPtr^.nextcol := Node;
    Node^.nextrow := ColPtr^.nextrow;
    ColPtr^.nextrow := Node;
  end
END;

FUNCTION CreateArray(numrows : rownum; numcolms : colnum) : NodePtr;

{ creates an empty sparse matrix, and returns a pointer to the Matrix }
{ Note that any area where Node does not exist, the Matrix Value = 0
         by definition                                                }

VAR
  A,temp,old : NodePtr;
  i : integer;

BEGIN
  new(A);
  A^.row := 0;
  A^.col := 0;
  A^.val := 0;
  A^.nextrow := A;
  A^.nextcol := A;
  old := A;
  for i := 1 to numcolms do
    BEGIN
      new(temp);
      temp^.row := 0;
      temp^.col := i;
      temp^.val := 0;
      temp^.nextrow := temp;
      temp^.nextcol := old^.nextcol;
      old^.nextcol := temp;
      old := temp;
    END;
  old := A;
  for i := 1 to numrows do
    BEGIN
      new(temp);
      temp^.col := 0;
      temp^.row := i;
      temp^.val := 0;
      temp^.nextcol := temp;
      temp^.nextrow := old^.nextrow;
      old^.nextrow := temp;
      old := temp;
    END;
  CreateArray := A;
END; { CreateArray }

PROCEDURE EnterElement(A: NodePtr; r : rownum; c : colnum ; X : real);

{ Enters the value X into element A[r,c] }

VAR
  rptr,cptr : NodePtr;

BEGIN
  cptr := FindColmPos(A,r,c);
  if (cptr^.nextrow^.row <> r) or (cptr^.nextrow^.col <> c) then
    BEGIN
      rptr := FindRowPos(A,r,c);
      InsertAfter(rptr,cptr,X);
      cptr^.nextrow^.row := r;
      cptr^.nextrow^.col := c;
    END
  ELSE cptr^.nextrow^.val := X
END;

FUNCTION ReadElement(A: NodePtr; r : rownum; c : colnum) : real;

{ Reads the Value of A[r,c] }

VAR
  ColPtr : NodePtr;
BEGIN
  ColPtr := FindColmPos(A,r,c);
  if (ColPtr^.Nextrow^.row <> r) or (ColPtr^.Nextrow^.col <> c)
    THEN ReadElement := 0
  ELSE ReadElement := ColPtr^.Nextrow^.val;
END;