[Bio] / FigKernelPackages / set_utilities.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/set_utilities.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (view) (download) (as text)

1 : overbeek 1.3
2 :     # This is a SAS component.
3 :    
4 : olson 1.2 #
5 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
6 :     # for Interpretations of Genomes. All Rights Reserved.
7 :     #
8 :     # This file is part of the SEED Toolkit.
9 :     #
10 :     # The SEED Toolkit is free software. You can redistribute
11 :     # it and/or modify it under the terms of the SEED Toolkit
12 :     # Public License.
13 :     #
14 :     # You should have received a copy of the SEED Toolkit Public License
15 :     # along with this program; if not write to the University of Chicago
16 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
17 :     # Genomes at veronika@thefig.info or download a copy from
18 :     # http://www.theseed.org/LICENSE.TXT.
19 :     #
20 :    
21 : efrank 1.1 package set_utilities;
22 :    
23 :     require Exporter;
24 :     @ISA = (Exporter);
25 :     @EXPORT = qw(
26 :     member
27 :     union
28 :     intersection
29 :     set_diff
30 :     unique
31 :     );
32 :    
33 :     sub member {
34 :     my($x,$set) = @_;
35 :     my($i);
36 :    
37 :     for ($i=0; $i <= $#{$set}; $i++)
38 :     {
39 :     if ($set->[$i] eq $x) { return 1; }
40 :     }
41 :     return 0;
42 :     }
43 :    
44 :     sub set_diff {
45 :     my($s1,$s2) = @_;
46 :     my(@set1,@set2,$p1,$p2,$diff);
47 :    
48 :     @set1 = sort @$s1;
49 :     @set2 = sort @$s2;
50 :     # print STDERR "set1 has $#set1+1 and set2 has $#set2+1\n";
51 :    
52 :     $p1 = 0;
53 :     $p2 = 0;
54 :     $diff = [];
55 :    
56 :     while (($p1 <= $#set1) && ($p2 <= $#set2))
57 :     {
58 :     if ($set1[$p1] lt $set2[$p2])
59 :     {
60 :     push(@$diff,$set1[$p1]); $p1++;
61 :     }
62 :     elsif ($set2[$p2] lt $set1[$p1])
63 :     {
64 :     $p2++;
65 :     }
66 :     else
67 :     {
68 :     $p1++; $p2++;
69 :     }
70 :     }
71 :     while ($p1 <= $#set1)
72 :     {
73 :     push(@$diff,$set1[$p1]); $p1++;
74 :     }
75 :     return $diff;
76 :     }
77 :    
78 :     sub union {
79 :     my($s1,$s2) = @_;
80 :     my(@set1,@set2,$p1,$p2,$union);
81 :    
82 :     @set1 = sort @$s1;
83 :     @set2 = sort @$s2;
84 :    
85 :     $p1 = 0;
86 :     $p2 = 0;
87 :     $union = [];
88 :    
89 :     while (($p1 <= $#set1) || ($p2 <= $#set2))
90 :     {
91 :     if ($p2 > $#set2)
92 :     {
93 :     push(@$union,$set1[$p1++]);
94 :     }
95 :     elsif ($p1 > $#set1)
96 :     {
97 :     push(@$union,$set2[$p2++]);
98 :     }
99 :     elsif ($set1[$p1] lt $set2[$p2])
100 :     {
101 :     push(@$union,$set1[$p1++]);
102 :     }
103 :     elsif ($set2[$p2] lt $set1[$p1])
104 :     {
105 :     push(@$union,$set2[$p2++]);
106 :     }
107 :     else
108 :     {
109 :     push(@$union,$set1[$p1++]);
110 :     $p2++;
111 :     }
112 :     }
113 :     return $union;
114 :     }
115 :    
116 :     sub intersection {
117 :     my($s1,$s2) = @_;
118 :     my(@set1,@set2,$p1,$p2,$intersection);
119 :    
120 :     @set1 = sort @$s1;
121 :     @set2 = sort @$s2;
122 :    
123 :     $p1 = 0;
124 :     $p2 = 0;
125 :     $intersection = [];
126 :    
127 :     while (($p1 <= $#set1) && ($p2 <= $#set2))
128 :     {
129 :     if ($set1[$p1] lt $set2[$p2])
130 :     {
131 :     $p1++;
132 :     }
133 :     elsif ($set2[$p2] lt $set1[$p1])
134 :     {
135 :     $p2++;
136 :     }
137 :     else
138 :     {
139 :     push(@$intersection,$set1[$p1++]);
140 :     $p2++;
141 :     }
142 :     }
143 :     return $intersection;
144 :     }
145 :    
146 :     sub unique {
147 :     # &unique(\@L) -> \@Lunique
148 :     my($f) = @_;
149 :     my(@xL) = sort(@$f);
150 :     my(@ans) = ();
151 :     my($i);
152 :    
153 :     for ($i=0; $i <= $#xL; $i++)
154 :     {
155 :     if (($i == $#xL) || ($xL[$i] ne $xL[$i+1]))
156 :     {
157 :     push(@ans,$xL[$i]);
158 :     }
159 :     }
160 :     return \@ans;
161 :     }
162 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3