Mercurial > repos > deepakjadmin > mayatool3_test2
comparison lib/Graph/PathGraph.pm @ 0:4816e4a8ae95 draft default tip
Uploaded
author | deepakjadmin |
---|---|
date | Wed, 20 Jan 2016 09:23:18 -0500 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:4816e4a8ae95 |
---|---|
1 package Graph::PathGraph; | |
2 # | |
3 # $RCSfile: PathGraph.pm,v $ | |
4 # $Date: 2015/02/28 20:49:06 $ | |
5 # $Revision: 1.24 $ | |
6 # | |
7 # Author: Manish Sud <msud@san.rr.com> | |
8 # | |
9 # Copyright (C) 2015 Manish Sud. All rights reserved. | |
10 # | |
11 # This file is part of MayaChemTools. | |
12 # | |
13 # MayaChemTools is free software; you can redistribute it and/or modify it under | |
14 # the terms of the GNU Lesser General Public License as published by the Free | |
15 # Software Foundation; either version 3 of the License, or (at your option) any | |
16 # later version. | |
17 # | |
18 # MayaChemTools is distributed in the hope that it will be useful, but without | |
19 # any warranty; without even the implied warranty of merchantability of fitness | |
20 # for a particular purpose. See the GNU Lesser General Public License for more | |
21 # details. | |
22 # | |
23 # You should have received a copy of the GNU Lesser General Public License | |
24 # along with MayaChemTools; if not, see <http://www.gnu.org/licenses/> or | |
25 # write to the Free Software Foundation Inc., 59 Temple Place, Suite 330, | |
26 # Boston, MA, 02111-1307, USA. | |
27 # | |
28 | |
29 use strict; | |
30 use Carp; | |
31 use Exporter; | |
32 use Storable (); | |
33 use Scalar::Util (); | |
34 use Graph; | |
35 use Graph::Path; | |
36 | |
37 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); | |
38 | |
39 @ISA = qw(Graph Exporter); | |
40 @EXPORT = qw(IsPathGraph); | |
41 @EXPORT_OK = qw(); | |
42 | |
43 %EXPORT_TAGS = (all => [@EXPORT, @EXPORT_OK]); | |
44 | |
45 # Setup class variables... | |
46 my($ClassName, $PathsPropertyName, $CyclicPathsPropertyName); | |
47 _InitializeClass(); | |
48 | |
49 # Overload Perl functions... | |
50 use overload '""' => 'StringifyPathGraph'; | |
51 | |
52 # Class constructor... | |
53 sub new { | |
54 my($Class, $Graph) = @_; | |
55 | |
56 # Initialize object... | |
57 my $This = $Class->SUPER::new(); | |
58 bless $This, ref($Class) || $Class; | |
59 $This->_InitializePathGraph($Graph); | |
60 | |
61 $This->_ConvertGraphIntoPathGraph($Graph); | |
62 | |
63 return $This; | |
64 } | |
65 | |
66 # Initialize object data... | |
67 sub _InitializePathGraph { | |
68 my($This, $Graph) = @_; | |
69 | |
70 if (!(defined($Graph) && Graph::IsGraph($Graph))) { | |
71 croak "Error: ${ClassName}->new: PathGraph object can't be instantiated without a Graph object..."; | |
72 } | |
73 | |
74 $This->{Graph} = $Graph; | |
75 | |
76 # Maximum time allowed for cycles detection during collapse vertex cycles detection | |
77 # methodology in seconds... | |
78 $This->{MaxAllowedTime} = 30; | |
79 | |
80 # Starting time for cycles detection during collapse vertex cycles detection | |
81 # methodology... | |
82 $This->{StartTime} = time; | |
83 | |
84 return $This; | |
85 } | |
86 | |
87 # Initialize class ... | |
88 sub _InitializeClass { | |
89 #Class name... | |
90 $ClassName = __PACKAGE__; | |
91 | |
92 # Path edge property name... | |
93 $PathsPropertyName = 'Paths'; | |
94 | |
95 # Cyclic path vertex property name... | |
96 $CyclicPathsPropertyName = 'CyclicPaths'; | |
97 } | |
98 | |
99 # Convert graph into a path graph... | |
100 # | |
101 sub _ConvertGraphIntoPathGraph { | |
102 my($This, $Graph) = @_; | |
103 | |
104 # Copy graph vertices and edges without any associated properties data | |
105 # from Graph to This: Graph properties data is available using Graph object reference | |
106 # store in This object... | |
107 # | |
108 $Graph->CopyVerticesAndEdges($This); | |
109 | |
110 # . Attach Path property to each edge... | |
111 # | |
112 my($Index, $VertexID1, $VertexID2, $Path, @EdgesVertexIDs); | |
113 | |
114 @EdgesVertexIDs = (); | |
115 @EdgesVertexIDs = $This->GetEdges(); | |
116 for ($Index = 0; $Index < $#EdgesVertexIDs; $Index += 2) { | |
117 $VertexID1 = $EdgesVertexIDs[$Index]; $VertexID2 = $EdgesVertexIDs[$Index + 1]; | |
118 $Path = new Graph::Path($VertexID1, $VertexID2); | |
119 my(@Paths) = (); | |
120 push @Paths, $Path; | |
121 $This->SetEdgeProperty($PathsPropertyName, \@Paths, $VertexID1, $VertexID2); | |
122 } | |
123 return $This; | |
124 } | |
125 | |
126 # Collapse paths around a specified vertex by updating paths around the vertex | |
127 # and adding any resulting cyclic paths to vertices attached to specified vertex. | |
128 # | |
129 # Notes: | |
130 # . Path object references are stored as a list attached to Paths property on edges. | |
131 # Usage of list allows multiple paths attached to the egde between a pair of vertices; | |
132 # Graph doesn't support multiple egdes between a pair of vertices. | |
133 # | |
134 # . Cyclic path object references are stored as list on vertices as CyclicPaths graph property. | |
135 # List allows multiple Loop properties attached to a vertex. | |
136 # | |
137 # . For topologically complex graphs containing large number of cycles, cycles detection algorithm | |
138 # [ Ref 31 ] as implemented implemented in CollapseVertexAndCollectCyclicPathsDetectCycles | |
139 # might not be able to find all the cycles in a reasonable amount of time and is designed to | |
140 # abandon cycles detection after MaxAllowedTime. Consequently, no cycles are detected | |
141 # or assigned. | |
142 # | |
143 sub CollapseVertexAndCollectCyclicPaths { | |
144 my($This, $VertexID) = @_; | |
145 | |
146 if (!$This->HasVertex($VertexID)) { | |
147 carp "Warning: ${ClassName}->CollapseVertexAndCollectCyclicPaths: Didn't collapse vertex $VertexID: Vertex $VertexID doesn't exist..."; | |
148 return undef; | |
149 } | |
150 # Collect all paths around specified VertexID by going over paths associated with its edges... | |
151 my($Index, $EdgePathsRef, $EdgeVertexID1, $EdgeVertexID2, @Paths, @EdgesVertexIDs); | |
152 | |
153 @EdgesVertexIDs = (); | |
154 @EdgesVertexIDs = $This->GetEdges($VertexID); | |
155 | |
156 @Paths = (); | |
157 for ($Index = 0; $Index < $#EdgesVertexIDs; $Index += 2) { | |
158 ($EdgeVertexID1, $EdgeVertexID2) = ($EdgesVertexIDs[$Index], $EdgesVertexIDs[$Index + 1]); | |
159 $EdgePathsRef = $This->GetEdgeProperty($PathsPropertyName, $EdgeVertexID1, $EdgeVertexID2); | |
160 push @Paths, @{$EdgePathsRef}; | |
161 } | |
162 | |
163 # Go over each pair of paths around the specified vertex, join paths and associate | |
164 # joined path to appropriate edge... | |
165 my($Index1, $Index2, $Path1, $Path2, $JoinedPath, $JoinedPathStartVertexID, $JoinedPathEndVertexID, @CommonVertices); | |
166 | |
167 for ($Index1 = 0; $Index1 < $#Paths; $Index1 +=1 ) { | |
168 $Path1 = $Paths[$Index1]; | |
169 | |
170 PATH2: for ($Index2 = $Index1 + 1; $Index2 <= $#Paths; $Index2 +=1 ) { | |
171 $Path2 = $Paths[$Index2]; | |
172 | |
173 # For JoinedPath to be valid cycle, Path1 and Path2 must have exactly two vertices in common. | |
174 # Otherwise, joined path contains duplicate vertices besides the terminal vertices and | |
175 # indicates a path from a different direction. | |
176 # | |
177 # For paths leading to cycles, it only makes sense to join paths with only one common vertex; | |
178 # otherwise, it wouldn't lead to a cycle and can be ignored. | |
179 # | |
180 @CommonVertices = $Path1->GetCommonVertices($Path2); | |
181 if (!(@CommonVertices <= 2 && ($CommonVertices[0] == $VertexID || $CommonVertices[1] == $VertexID))) { | |
182 next PATH2; | |
183 } | |
184 | |
185 $JoinedPath = $Path1->JoinAtVertex($Path2, $VertexID); | |
186 ($JoinedPathStartVertexID, $JoinedPathEndVertexID) = $JoinedPath->GetTerminalVertices(); | |
187 | |
188 if (!$JoinedPath->IsIndependentPath()) { | |
189 next PATH2; | |
190 } | |
191 | |
192 # Decide whether to give up or keep going... | |
193 if ($This->_IsTimeToGiveUpCyclesDetection()) { | |
194 warn "Warning: ${ClassName}->CollapseVertexAndCollectCyclicPaths: Cycles detection algorithm [ Ref 31 ] as implemented in the current release of MayaChemTools didn't finish with in the maximum allowed time of $This->{MaxAllowedTime} seconds; Cycles detection has been abandoned..."; | |
195 return undef; | |
196 } | |
197 | |
198 if ($JoinedPathStartVertexID == $JoinedPathEndVertexID) { | |
199 # It's a cycle. Attach it to the graph as CylicPaths property... | |
200 if ($This->HasGraphProperty($CyclicPathsPropertyName)) { | |
201 my($ExistingCyclicPathsRef); | |
202 $ExistingCyclicPathsRef = $This->GetGraphProperty($CyclicPathsPropertyName); | |
203 push @{$ExistingCyclicPathsRef}, $JoinedPath; | |
204 } | |
205 else { | |
206 my(@NewCyclicPaths) = (); | |
207 push @NewCyclicPaths, $JoinedPath; | |
208 $This->SetGraphProperty($CyclicPathsPropertyName, \@NewCyclicPaths, $JoinedPathStartVertexID); | |
209 } | |
210 } | |
211 else { | |
212 if ($This->HasEdge($JoinedPathStartVertexID, $JoinedPathEndVertexID)) { | |
213 # Append to the list of exisiting paths property of the edge... | |
214 my($ExistingPathsRef); | |
215 $ExistingPathsRef = $This->GetEdgeProperty($PathsPropertyName, $JoinedPathStartVertexID, $JoinedPathEndVertexID); | |
216 push @{$ExistingPathsRef}, $JoinedPath; | |
217 } | |
218 else { | |
219 # Create a new edge and associate path property... | |
220 my(@NewPaths) = (); | |
221 push @NewPaths, $JoinedPath; | |
222 $This->AddEdge($JoinedPathStartVertexID, $JoinedPathEndVertexID); | |
223 $This->SetEdgeProperty($PathsPropertyName, \@NewPaths, $JoinedPathStartVertexID, $JoinedPathEndVertexID); | |
224 } | |
225 } | |
226 } | |
227 } | |
228 $This->DeleteVertex($VertexID); | |
229 | |
230 return $This; | |
231 } | |
232 | |
233 # Decide whether to give up cycles detection using collapse vertex methodology... | |
234 # | |
235 sub _IsTimeToGiveUpCyclesDetection { | |
236 my($This) = @_; | |
237 | |
238 return ((time - $This->{StartTime}) > $This->{MaxAllowedTime}) ? 1 : 0; | |
239 } | |
240 | |
241 # Delete vertices with degree less than a specifed degree... | |
242 # | |
243 sub DeleteVerticesWithDegreeLessThan { | |
244 my($This, $Degree) = @_; | |
245 my($VertexID, @VertexIDs); | |
246 | |
247 while (@VertexIDs = $This->GetVerticesWithDegreeLessThan($Degree)) { | |
248 for $VertexID (@VertexIDs) { | |
249 $This->DeleteVertex($VertexID); | |
250 } | |
251 } | |
252 return $This; | |
253 } | |
254 | |
255 # Get paths associated with edges... | |
256 # | |
257 sub GetPaths { | |
258 my($This) = @_; | |
259 my($PathsRef, @Paths, @PathsList); | |
260 | |
261 @Paths = (); @PathsList = (); | |
262 @PathsList = $This->GetEdgesProperty($PathsPropertyName); | |
263 for $PathsRef (@PathsList) { | |
264 push @Paths, @{$PathsRef}; | |
265 } | |
266 return wantarray ? @Paths : scalar @Paths; | |
267 } | |
268 | |
269 # Get paths associated with edges which make a cylce... | |
270 # | |
271 sub GetCyclicPaths { | |
272 my($This) = @_; | |
273 my($PathsRef, @Paths, @PathsList); | |
274 | |
275 @Paths = (); @PathsList = (); | |
276 @PathsList = $This->GetGraphProperty($CyclicPathsPropertyName); | |
277 PATHS: for $PathsRef (@PathsList) { | |
278 if (!(defined($PathsRef) && @{$PathsRef})) { | |
279 next PATHS; | |
280 } | |
281 push @Paths, @{$PathsRef}; | |
282 } | |
283 return wantarray ? @Paths : scalar @Paths; | |
284 } | |
285 | |
286 # Is it a path graph object? | |
287 sub IsPathGraph ($) { | |
288 my($Object) = @_; | |
289 | |
290 return _IsPathGraph($Object); | |
291 } | |
292 | |
293 # Return a string containg data for PathGraph object... | |
294 sub StringifyPathGraph { | |
295 my($This) = @_; | |
296 my($PathGraphString); | |
297 | |
298 $PathGraphString = 'PathGraph:' . $This->StringifyVerticesAndEdges() . '; ' . $This->StringifyProperties(); | |
299 | |
300 return $PathGraphString; | |
301 } | |
302 | |
303 # Is it a PathGraph object? | |
304 sub _IsPathGraph { | |
305 my($Object) = @_; | |
306 | |
307 return (Scalar::Util::blessed($Object) && $Object->isa($ClassName)) ? 1 : 0; | |
308 } | |
309 | |
310 1; | |
311 | |
312 __END__ | |
313 | |
314 =head1 NAME | |
315 | |
316 PathGraph | |
317 | |
318 =head1 SYNOPSIS | |
319 | |
320 use Graph::PathGraph; | |
321 | |
322 use Graph::PathGraph qw(:all); | |
323 | |
324 =head1 DESCRIPTION | |
325 | |
326 B<PathGraph> class provides the following methods: | |
327 | |
328 new, CollapseVertexAndCollectCyclicPaths, DeleteVerticesWithDegreeLessThan, | |
329 GetCyclicPaths, GetPaths, IsPathGraph, StringifyPathGraph | |
330 | |
331 B<PathGraph> class is derived from I<Graph> class. | |
332 | |
333 =head2 METHODS | |
334 | |
335 =over 4 | |
336 | |
337 =item B<new> | |
338 | |
339 $NewPathGraph = new Graph::PathGraph($Graph); | |
340 | |
341 Using specified I<Graph>, B<new> method creates a new B<PathGraph> object and returns | |
342 newly created B<PathGraph> object. | |
343 | |
344 I<Graph> is converted into a B<PathGraph> by copying all its vertices and edges without any | |
345 associated properties data and associating a I<Path> object to each edge containing edge | |
346 vertex IDs as intial path. | |
347 | |
348 =item B<CollapseVertexAndCollectCyclicPaths> | |
349 | |
350 $PathGraph->CollapseVertexAndCollectCyclicPaths($VertexID); | |
351 | |
352 Collapses paths around a I<VertexID> by updating paths around the vertex [Ref 31] and associating any | |
353 resulting cyclic paths to graph as B<CyclicPaths> property name. And returns I<PathGraph>. | |
354 | |
355 =item B<DeleteVerticesWithDegreeLessThan> | |
356 | |
357 $Return = $PathGraph->DeleteVerticesWithDegreeLessThan($Degree); | |
358 | |
359 Deletes vertices with degree less than I<Degree> from I<PathGraph> and returns I<PathGraph>. | |
360 | |
361 =item B<GetCyclicPaths> | |
362 | |
363 @CyclicPaths = $PathGraph->GetCyclicPaths(); | |
364 $NumOfPaths = $PathGraph->GetCyclicPaths(); | |
365 | |
366 Returns an array of cyclic I<Paths> associated with edges in I<PathGraph>. In scalar context, number | |
367 of cyclic paths is returned. | |
368 | |
369 =item B<GetPaths> | |
370 | |
371 @Paths = $PathGraph->GetPaths(); | |
372 $NumOfPaths = $PathGraph->GetPaths(); | |
373 | |
374 Returns an array of I<Paths> associated with edges in I<PathGraph>. In scalar context, number | |
375 of paths is returned. | |
376 | |
377 =item B<IsPathGraph> | |
378 | |
379 $Status = Graph::PathGraph::IsPathGraph($Object); | |
380 | |
381 Returns 1 or 0 based on whether I<Object> is a B<PathGraph> object. | |
382 | |
383 =item B<StringifyPathGraph> | |
384 | |
385 $String = $PathGraph->StringifyPathGraph(); | |
386 | |
387 Returns a string containing information about traversed paths in I<PathGraph> object. | |
388 | |
389 =back | |
390 | |
391 =head1 AUTHOR | |
392 | |
393 Manish Sud <msud@san.rr.com> | |
394 | |
395 =head1 SEE ALSO | |
396 | |
397 Graph.pm, Path.pm | |
398 | |
399 =head1 COPYRIGHT | |
400 | |
401 Copyright (C) 2015 Manish Sud. All rights reserved. | |
402 | |
403 This file is part of MayaChemTools. | |
404 | |
405 MayaChemTools is free software; you can redistribute it and/or modify it under | |
406 the terms of the GNU Lesser General Public License as published by the Free | |
407 Software Foundation; either version 3 of the License, or (at your option) | |
408 any later version. | |
409 | |
410 =cut |