cpset.pas

生物信息学中的遗传数据分析的delphi源码。

	procedure CLUSTEROBJ.Complement (var Result:CLUSTEROBJ; n : integer);
	begin
   	Result.Fullset (n);
      Result.S := Result.S - S;
	end;


   procedure CLUSTEROBJ.SetDifference (var T, Result:CLUSTEROBJ);
   { Result = S - T }
   begin
      Result.S := S - T.S;
   end;

   procedure CLUSTEROBJ.InCommon (var T:CLUSTEROBJ);
   { S is the intersection of itself with T }
   begin
      S := S * T.S;
   end;

   procedure CLUSTEROBJ.Unique (var T:CLUSTEROBJ);
   begin
      S := S - T.S;
   end;

{---SET QUERIES---}

   function CLUSTEROBJ.Empty:Boolean;
   begin
      Empty := (s = []);
   end;

   function CLUSTEROBJ.IsFullSet:Boolean;
   var
      i : integer;
   begin
      i := Cardinality;
      IsFullSet := (s = [1..i]);
   end;

   function CLUSTEROBJ.IsElement (i:integer):Boolean;
   begin
      IsElement := (i in S);
   end;

   function CLUSTEROBJ.First_Element:integer;
   var
      i: integer;
   begin
      if (S = []) then begin
         First_Element := 0;
         Cur_Element := 0;
         end
      else begin
         i := 0;
         repeat
            Inc (i);
         until (i in S);
         First_Element := i;
         Cur_Element := i;
         end;
   end;

   function CLUSTEROBJ.LastElement:integer;
   { last element in set }
   var
      TempSet: CLUSTER;
      i, j : integer;

   begin
      TempSet := S;
      j := 0;
      i := 1;
      while (TempSet <> []) do begin
         if (i in TempSet) then begin
            j := i;
            TempSet := TempSet - [i];
            end;
         Inc (i);
         end;
      LastElement := j;
   end;


{-----------------------------WriteSet-------------------------------------}
{ Write set elements }
procedure CLUSTEROBJ.WriteSet (var f:text);
var
   TempSet : CLUSTER;
   i       : integer;
begin
   TempSet := S;
   i       := 1;
   while (TempSet <> []) do begin
      if (i in TempSet) then begin
         write (f, ' ', i);
         TempSet := TempSet - [i];
         end;
      Inc (i);
      end;
end;



   function CLUSTEROBJ.MoreMembers:Boolean;
   var
      TempSet: CLUSTER;
   begin
      TempSet := S - [1..Cur_Element];
      MoreMembers := (TempSet <> []);
   end;

   function CLUSTEROBJ.Next_Element:integer;
   { no test for more members, so must use with
     MoreMembers above. }
   var
      i: integer;
   begin
      i := Cur_Element;
      repeat
         Inc (i);
      until (i in S);
      Cur_Element := i;
      Next_Element := i;
   end;

   function CLUSTEROBJ.Cardinality;
   var
      TempSet: CLUSTER;
      i, Count : integer;

   begin
      TempSet := S;
      Count := 0;
      i := 1;
      while (TempSet <> []) do begin
         if (i in TempSet) then begin
            Inc (Count);
            TempSet := TempSet - [i];
            end;
         Inc (i);
         end;
      Cardinality := Count;
   end;


   { Return the number of items in Self that are not
     also in Mask. }
   function CLUSTEROBJ.MaskedCardinality (var Mask:CLUSTEROBJ):integer;
   var
      TempSet: CLUSTER;
      i, Count : integer;

   begin
      TempSet := S;
      Count := 0;
      i := 1;
      while (TempSet <> []) do begin
         if (i in TempSet) then begin
            if not (i in Mask.S) then
               Inc (Count);
            TempSet := TempSet - [i];
            end;
         Inc (i);
         end;
      MaskedCardinality := Count;
   end;




{---SET DISPLAY---}

   { Doesn't clear or show buffer }

   procedure CLUSTEROBJ.DisplaySet (Range: integer);
   { Display a set in the range [1,..,Range] in the form:

     ****.....* ***...*...
   }
   const
      IN_SYMBOL  = '*';
      OUT_SYMBOL = '.';
      GAP_SYMBOL = ' ';
      COLUMN     = 10;
   var
      i: integer;
   begin
      {$IFDEF DEVICE}
      for i := 1 to Range do begin
         if (i in S) then
            write (NEWLOG, IN_SYMBOL)
         else write (NEWLOG, OUT_SYMBOL);
         if (i mod COLUMN = 0) then
            write (NEWLOG, GAP_SYMBOL);
         end;
      {$ELSE}
      for i := 1 to Range do begin
         if (i in S) then
            Buffer.AppendChar (IN_SYMBOL)
         else Buffer.AppendChar(OUT_SYMBOL);
         if (i mod COLUMN = 0) then
            Buffer.AppendChar (GAP_SYMBOL);
         end;
      {$ENDIF}
   end;

   procedure CLUSTEROBJ.ShowSet (title:string);
   { Show a set in the form [1 2..4 6] }
   var
      First, Last,i: integer;
   begin
      {$IFDEF DEVICE}
      if (Title <> '') then
         write (NEWLOG, Title);
      write (NEWLOG, '[');
      First := 0;
      for i := 1 to MAXLEAVES do
         if (i in S) then begin
            if (First = 0) then
               First := i;
            Last := i;
            end
         else begin
            if (First <> 0) then begin
               write (NEWLOG, ' ');
               write (NEWLOG, First);
               case (Last - First) of
                  0: begin end;
                  1: write (NEWLOG, ' ', Last);
                  else write (NEWLOG, '..', Last);
                  end;
               First := 0;
               end;
            end;
      writeln (NEWLOG, ' ]');

      {$ELSE}
{      Buffer.Clear;}
      if (Title <> '') then
         Buffer.AppendString (title);
      Buffer.AppendChar ('[');
      First := 0;
      for i := 1 to MAXLEAVES do
         if (i in S) then begin
            if (First = 0) then
               First := i;
            Last := i;
            end
         else begin
            if (First <> 0) then begin
               Buffer.AppendChar (' ');
               Buffer.AppendInteger (First);
               case (Last - First) of
                  0: begin end;
                  1: begin
                  	Buffer.AppendChar (' ');
                        Buffer.AppendInteger (Last);
                     end;
                  else begin
                     Buffer.AppendString ('..');
                     Buffer.AppendInteger (Last);
                     end;
                  end;
               First := 0;
               end;
            end;
      Buffer.AppendChar (' ');
      Buffer.AppendChar (']');
      DisplayBuffer.InsertLineBuffer (Buffer);
      {$ENDIF}
   end;


   procedure CLUSTEROBJ.DumpSet (var f:text; title:string);
   { Show a set in the form [1 2..4 6] }
   var
      First, Last,i: integer;
   begin
      if (Title <> '') then
         write (f, title);
      write (f,'[');
      First := 0;
      for i := 1 to MAXLEAVES do
         if (i in S) then begin
            if (First = 0) then
               First := i;
            Last := i;
            end
         else begin
            if (First <> 0) then begin
               write (f, ' ');
               write (f, First);
               case (Last - First) of
                  0: begin end;
                  1: begin
                        write (f, ' ');
                        write (f, Last);
                     end;
                  else begin
                     write (f,'..');
                     write (f, Last);
                     end;
                  end;
               First := 0;
               end;
            end;
      write (f, ' ');
      writeln (f, ']');
   end;



{---SET RELATIONSHIPS---}

   function CLUSTEROBJ.Relationship (var T:CLUSTEROBJ):SET_RELATIONS;
   { Describe the relationship of S to T:

     S = T        IDENTITY
     S