rtsi.com/2014.01.www.rtsi.com.tar/www.rtsi.com/OS9/OSK/EFFO/forum8.lzh/PROGRAMME/MODULA/SET/bigset.mod

Text File | 1989-01-19 | 7KB | 285 lines

(* Module Version V#011, Gdos /1.3l/, Begonnen: 19.01.86, Stand: 12.04.86 *)
(*                                                              Alex Wyss *)
(* Anpassung Miele-M2 / OS-9  19-12-88                        W. Stehling *)

IMPLEMENTATION MODULE BigSet ;

FROM Storage IMPORT
(* proc *)      ALLOCATE , DEALLOCATE
;

CONST
  fulls      = BITSET {  0 ,  1 ,  2 ,  3 ,  4 ,  5 ,  6 ,  7 ,
                         8 ,  9 , 10 , 11 , 12 , 13 , 14 , 15 } ;
  maxsetnr   = $FFFE ;              (* maxset * 16 {TSIZE(BITSET)} *)
  maxset     = maxsetnr DIV 16 ;    (* maximal number of array elements *)

TYPE
  maxsetsize = [ 0 .. maxset ] ;
  bigsettype = RECORD
                 bigsetsize ,
                 nrofelem   : CARDINAL ;
                 lastset    : BITSET ;
                 elem       : ARRAY maxsetsize OF BITSET ;
               END ;
  bigset     = POINTER TO bigsettype ;

PROCEDURE define ( setsize : CARDINAL ) : bigset ;
VAR
  bs : bigset ;
  sz : CARDINAL ;
BEGIN
  IF setsize > maxsetnr THEN
    RETURN NIL ;
  ELSE
    sz := setsize DIV 16  ;         (* sz := setsize DIV TSIZE ( BITSET ) ; *)
    ALLOCATE ( bs , ( sz + 4 ) * 2 ) ;
    WITH bs^ DO
      nrofelem   := setsize ;
      bigsetsize := sz ;
      sz := ( setsize + 1 ) MOD 16 ;
      IF sz = 0 THEN
        lastset := fulls ;
      ELSE
        lastset := {} ;
        LOOP
          INCL ( lastset , CARDINAL ( sz ) ) ;
          IF sz = 0 THEN
            EXIT ;
          END ; (* if *)
          DEC ( sz ) ;
        END ; (* loop *)
      END ; (* if *)
    END ; (* with *)
    nullset ( bs ) ;
    RETURN bs ;
  END ; (* if *)
END define ;

PROCEDURE destroy ( forget : bigset ) ;
BEGIN
  DEALLOCATE ( forget , ( forget^.bigsetsize + 4 ) * 2 ) ;
END destroy ;

PROCEDURE nullset ( VAR bs : bigset ) ;
VAR
  i : CARDINAL ;
BEGIN
  WITH bs^ DO
    i := bigsetsize ;
    LOOP
      elem [ i ] := {} ;
      IF i = 0 THEN
        EXIT ;
      ELSE
        DEC ( i ) ;
      END ; (* if *)
    END ; (* loop *)
  END ; (* with *)
END nullset ;

PROCEDURE fullset ( VAR bs : bigset ) ;
VAR
  i : CARDINAL ;
BEGIN
  WITH bs^ DO
    i := bigsetsize ;
    elem [ i ] := lastset ;
    LOOP
      IF i = 0 THEN
        EXIT ;
      ELSE
        DEC ( i ) ;
      END ; (* if *)
      elem [ i ] := fulls ;
    END ; (* loop *)
  END ; (* with *)
END fullset ;

PROCEDURE assign ( fromset : bigset; VAR toset : bigset ) ;
VAR
  i : CARDINAL ;
BEGIN
  WITH toset^ DO
    IF fromset^.nrofelem = nrofelem THEN
      FOR i := 0 TO bigsetsize DO
        elem [ i ] := fromset^.elem [ i ] ;
      END ; (* for *)
      (* MoveWords ( ADR ( fromset^.elem [ 0 ] ) , ADR ( elem [ 0 ] ) ,
                     bigsetsize * 2L ) ; *)
    END ; (* if *)
  END ; (* with *)
END assign ;

PROCEDURE include ( VAR bs : bigset ; nr : CARDINAL ) ;
BEGIN
  WITH  bs^  DO
    IF  nr <= nrofelem  THEN
      INCL ( elem [ nr DIV 16 ] , nr MOD 16 )
    END
  END
END include ;

PROCEDURE exclude ( VAR bs : bigset ; nr : CARDINAL ) ;
BEGIN
  WITH  bs^  DO
    IF  nr <= nrofelem  THEN
      EXCL ( elem [ nr DIV 16 ] , nr MOD 16 )
    END
  END
END exclude ;

PROCEDURE union ( aset , bset : bigset; VAR cset : bigset ) ;
VAR
  i : CARDINAL ;
BEGIN
  WITH cset^ DO
    IF ( bset^.nrofelem = nrofelem ) AND
       ( aset^.nrofelem = nrofelem) THEN
      FOR i := 0 TO bigsetsize DO
        elem [ i ] := aset^.elem [ i ] + bset^.elem [ i ] ;
      END ; (* for *)
    END ; (* if *)
    elem [ bigsetsize ] := lastset * elem [ bigsetsize ] ;
  END ; (* with *)
END union ;

PROCEDURE intersection ( aset , bset : bigset; VAR cset : bigset ) ;
VAR
  i : CARDINAL ;
BEGIN
  WITH cset^ DO
    IF ( bset^.nrofelem = nrofelem ) AND
       ( aset^.nrofelem = nrofelem) THEN
      FOR i := 0 TO bigsetsize DO
        elem [ i ] := aset^.elem [ i ] * bset^.elem [ i ] ;
      END ; (* for *)
    END ; (* if *)
    elem [ bigsetsize ] := lastset * elem [ bigsetsize ] ;
  END ; (* with *)
END intersection ;

PROCEDURE diff ( aset , bset : bigset; VAR cset : bigset ) ;
VAR
  i : CARDINAL ;
BEGIN
  WITH cset^ DO
    IF ( bset^.nrofelem = nrofelem ) AND
       ( aset^.nrofelem = nrofelem) THEN
      FOR i := 0 TO bigsetsize DO
        elem [ i ] := aset^.elem [ i ] - bset^.elem [ i ] ;
      END ; (* for *)
    END ; (* if *)
    elem [ bigsetsize ] := lastset * elem [ bigsetsize ] ;
  END ; (* with *)
END diff ;

PROCEDURE symdiff ( aset , bset : bigset; VAR cset : bigset ) ;
VAR
  i : CARDINAL ;
BEGIN
  WITH cset^ DO
    IF ( bset^.nrofelem = nrofelem ) AND
       ( aset^.nrofelem = nrofelem) THEN
      FOR i := 0 TO bigsetsize DO
        elem [ i ] := aset^.elem [ i ] / bset^.elem [ i ] ;
      END ; (* for *)
    END ; (* if *)
    elem [ bigsetsize ] := lastset * elem [ bigsetsize ] ;
  END ; (* with *)
END symdiff ;

PROCEDURE complement ( VAR bs : bigset ) ;
VAR
  ns : bigset ;
BEGIN
  WITH bs^ DO
    ALLOCATE ( ns , ( bigsetsize + 4 ) * 2 ) ;
    ns^.nrofelem   := nrofelem ;
    ns^.bigsetsize := bigsetsize ;
    ns^.lastset    := lastset ;
    (* ns := bigset ( define ( nrofelem ) ) ; *)
    fullset ( ns ) ;
    diff ( ns , bs , bs ) ;
    destroy ( ns ) ;
  END ; (* with *)
END complement ;


PROCEDURE inset ( bs : bigset ; nr : CARDINAL ) : BOOLEAN ;
BEGIN
  RETURN CARDINAL ( nr MOD 16 ) IN bs^.elem [ nr DIV 16 ] ;
END inset ;

PROCEDURE subset ( subs , bs : bigset ) : BOOLEAN ;
VAR
  i : CARDINAL ;
BEGIN
  WITH bs^ DO
    IF subs^.nrofelem # nrofelem THEN
      RETURN FALSE ;
    ELSE
      i := bigsetsize ;
      LOOP
        IF subs^.elem [ i ] <= elem [ i ] THEN
          IF i > 0 THEN
            DEC ( i ) ;
          ELSE
            RETURN TRUE ;
          END ; (* if *)
        ELSE
          RETURN FALSE ;
        END ; (* if *)
      END ; (* loop *)
    END ; (* if *)
  END ; (* with *)
END subset ;

PROCEDURE superset ( sups , bs : bigset ) : BOOLEAN ;
VAR
  i : CARDINAL ;
BEGIN
  WITH bs^ DO
    IF sups^.nrofelem # nrofelem THEN
      RETURN FALSE ;
    ELSE
      i := bigsetsize ;
      LOOP
        IF sups^.elem [ i ] >= elem [ i ] THEN
          IF i > 0 THEN
            DEC ( i ) ;
          ELSE
            RETURN TRUE ;
          END ; (* if *)
        ELSE
          RETURN FALSE ;
        END ; (* if *)
      END ; (* loop *)
    END ; (* if *)
  END ; (* with *)
END superset ;

PROCEDURE equalset ( equs , bs : bigset ) : BOOLEAN ;
VAR
  i : CARDINAL ;
BEGIN
  WITH bs^ DO
    IF equs^.nrofelem # nrofelem THEN
      RETURN FALSE ;
    ELSE
      i := bigsetsize ;
      LOOP
        IF equs^.elem [ i ] # elem [ i ] THEN
          RETURN FALSE ;
        ELSIF i > 0 THEN
          DEC ( i ) ;
        ELSE
          RETURN TRUE ;
        END ; (* if *)
      END ; (* loop *)
    END ; (* if *)
  END ; (* with *)
END equalset ;

END BigSet .