MayaChemTools

   1 package PseudoHeap;
   2 #
   3 # $RCSfile: PseudoHeap.pm,v $
   4 # $Date: 2015/02/28 20:47:18 $
   5 # $Revision: 1.10 $
   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 TextUtil ();
  33 
  34 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  35 
  36 @ISA = qw(Exporter);
  37 @EXPORT = qw();
  38 @EXPORT_OK = qw();
  39 
  40 %EXPORT_TAGS = (
  41                 all  => [@EXPORT, @EXPORT_OK]
  42                );
  43 
  44 # Setup class variables...
  45 my($ClassName);
  46 _InitializeClass();
  47 
  48 use overload '""' => 'StringifyPseudoHeap';
  49 
  50 # PseudoHeap is designed to support tracking of a specific number of largest or smallest key/value
  51 # pairs with numeric or alphanumeric keys along with corresponding scalar or reference values.
  52 #
  53 # Although PseudoHeap is similar to a heap, it lacks number of key properties of a traditional heap data
  54 # structure: no concept of root, parent and child nodes; no ordering of keys in any particular order; no
  55 # specific localtion greatest or smallest key.
  56 #
  57 # The keys are simply stored in a hash with each key poining to an array containing specified values.
  58 # The min/max keys are updated during addition and deletion of key/value pairs; these can be retrieved
  59 # by accessing corresponding hash.
  60 #
  61 # Addition and deletion of key/value is also straightforward using hashes. However, min/max keys
  62 # need to be identified which is done using Perl sort on the keys.
  63 #
  64 #
  65 # Class constructor...
  66 #
  67 sub new {
  68   my($Class, %NamesAndValues) = @_;
  69 
  70   # Initialize object...
  71   my $This = {};
  72   bless $This, ref($Class) || $Class;
  73   $This->_InitializePseudoHeap();
  74 
  75   $This->_InitializePseudoHeapProperties(%NamesAndValues);
  76 
  77   return $This;
  78 }
  79 
  80 # Initialize object data...
  81 #
  82 sub _InitializePseudoHeap {
  83   my($This) = @_;
  84 
  85   # Type of pseudo heap:
  86   #
  87   # KeepTopN - Keep track of a specified number largest of key/value pairs
  88   # KeepBottomN - Keep track of a specified number smallest of key/value pairs
  89   #
  90   $This->{Type} = undef;
  91 
  92   # Type of keys: Numeric or Alphanumeric
  93   #
  94   # The value of KeyType determines comparison function used to sort and
  95   # and compare keys for a specific heap type as shown below:
  96   #
  97   # Type             KeyType       Comp  Sorting
  98   #
  99   # KeepTopN      Numeric       <     Descending
 100   # KeepTopN      AlphaNumeric  lt    Descending
 101   # KeepBottomN  Numeric        >     Ascending
 102   # KeepBottomN  AlphaNumeric   gt    Ascending
 103   #
 104   $This->{KeyType} = undef;
 105 
 106   # Maximum number of largest or smallest key/value pairs to keep...
 107   #
 108   $This->{MaxSize} = 10;
 109 
 110   # Keys and values associated with each key as an array...
 111   %{$This->{Keys}} = ();
 112 
 113   # Min and max keys...
 114   $This->{MinKey} = undef;
 115   $This->{MaxKey} = undef;
 116 
 117   # Number of key/valur pairs currently present...
 118   $This->{CurrentSize} = 0;
 119 
 120   # Number of keys currently present where each key correspond to multiple values...
 121   $This->{KeysCount} = 0;
 122 }
 123 
 124 # Initialize class ...
 125 sub _InitializeClass {
 126   #Class name...
 127   $ClassName = __PACKAGE__;
 128 
 129 }
 130 
 131 # Initialize object properties....
 132 #
 133 sub _InitializePseudoHeapProperties {
 134   my($This, %NamesAndValues) = @_;
 135   my($Name, $Value, $MethodName);
 136 
 137   while (($Name, $Value) = each  %NamesAndValues) {
 138     $MethodName = "Set${Name}";
 139     $This->$MethodName($Value);
 140   }
 141 
 142   if (!exists $NamesAndValues{Type}) {
 143     croak "Error: ${ClassName}->New: Object can't be instantiated without specifying Type...";
 144   }
 145 
 146   if (!exists $NamesAndValues{KeyType}) {
 147     croak "Error: ${ClassName}->New: Object can't be instantiated without specifying KeyType...";
 148   }
 149 }
 150 
 151 # Set heap type...
 152 #
 153 sub SetType {
 154   my($This, $Type) = @_;
 155 
 156   if (defined $This->{Type}) {
 157     croak "Error: ${ClassName}->SetType: Can't change Type...";
 158   }
 159 
 160   if ($Type !~ /^(KeepTopN|KeepBottomN)$/i) {
 161     croak "Error: ${ClassName}->SetType: Unknown PseudoHeap type: $Type; Supported types: KeepTopN or KeepBottomN...";
 162   }
 163   $This->{Type} = $Type;
 164 
 165   return $This;
 166 }
 167 
 168 # Get heap type..
 169 #
 170 sub GetType {
 171   my($This) = @_;
 172 
 173   return defined $This->{Type} ? $This->{Type} : 'None';
 174 }
 175 
 176 # Set key type...
 177 #
 178 sub SetKeyType {
 179   my($This, $KeyType) = @_;
 180 
 181   if (defined $This->{KeyType}) {
 182     croak "Error: ${ClassName}->SetType: Can't change KeyType...";
 183   }
 184 
 185   if ($KeyType !~ /^(Numeric|Alphanumeric)$/i) {
 186     croak "Error: ${ClassName}->SetType: Unknown PseudoHeap key type: $KeyType; Supported key types: Numeric or Alphanumeric...";
 187   }
 188   $This->{KeyType} = $KeyType;
 189 
 190   return $This;
 191 }
 192 
 193 # Get key type..
 194 #
 195 sub GetKeyType {
 196   my($This) = @_;
 197 
 198   return defined $This->{KeyType} ? $This->{KeyType} : 'None';
 199 }
 200 
 201 # Add a key/value pair...
 202 #
 203 sub AddKeyValuePair {
 204   my($This, $Key, $Value) = @_;
 205 
 206   if (!(defined($Key) && defined($Value))) {
 207     carp "Warning: ${ClassName}->AddKeyValuePair: No key added: Both key and value must be defined...";
 208     return undef;
 209   }
 210 
 211   $This->_AddKeyValuePair($Key, $Value);
 212 
 213   return $This;
 214 }
 215 
 216 # Add multiple key/value pairs...
 217 #
 218 sub AddKeyValuePairs {
 219   my($This, @KeyValuePairs) = @_;
 220 
 221   if (!@KeyValuePairs) {
 222     carp "Warning: ${ClassName}->AddKeyValuePairs: No keys added: Key/Value pairs list is empty...";
 223     return undef;
 224   }
 225   if (@KeyValuePairs % 2) {
 226     carp "Warning: ${ClassName}->AddKeyValuePairs: No keys pairs added: Invalid key/value pairs data: Input list must contain even number of values...";
 227     return undef;
 228   }
 229 
 230   my($Key, $Value, $Index);
 231   for ($Index = 0; $Index < $#KeyValuePairs; $Index += 2) {
 232     $Key = $KeyValuePairs[$Index]; $Value = $KeyValuePairs[$Index + 1];
 233     $This->AddKeyValuePair($Key, $Value);
 234   }
 235 
 236   return $This;
 237 }
 238 
 239 # Delete specified keys along with all associated values for each key...
 240 #
 241 sub DeleteKeys {
 242   my($This, @Keys) = @_;
 243 
 244   if (!@Keys) {
 245     carp "Warning: ${ClassName}->DeleteKeys: No keys deleted: Keys list is empty...";
 246     return undef;
 247   }
 248   my($Key);
 249   for $Key (@Keys) {
 250     $This->DeleteKey($Key);
 251   }
 252 
 253   return $This;
 254 }
 255 
 256 # Delete a sepcified key along with all of its associated values...
 257 #
 258 sub DeleteKey {
 259   my($This, $Key) = @_;
 260 
 261   if (!defined $Key ) {
 262     carp "Warning: ${ClassName}->DeleteKey: No key deleted: Key must be specified...";
 263     return undef;
 264   }
 265 
 266   return $This->_DeleteKey($Key);
 267 }
 268 
 269 # Delete min key along with all of its associated values...
 270 #
 271 sub DeleteMinKey {
 272   my($This) = @_;
 273 
 274   return $This->DeleteKey($This->{MinKey});
 275 }
 276 
 277 # Delete max key along with all of its associated values...
 278 #
 279 sub DeleteMaxKey {
 280   my($This) = @_;
 281 
 282   return $This->DeleteKey($This->{MaxKey});
 283 }
 284 
 285 # Set max size...
 286 #
 287 sub SetMaxSize {
 288   my($This, $Size) = @_;
 289 
 290   if (!TextUtil::IsPositiveInteger($Size)) {
 291     croak "Error: ${ClassName}->SetMaxSize: Max size value, $Size, is not valid: It must be a positive  integer...";
 292   }
 293 
 294   if (defined($This->{MinKey}) || defined($This->{MaxKey})) {
 295     croak "Error: ${ClassName}->SetMaxSize: Can't change max size: Keys are already present...";
 296   }
 297 
 298   $This->{MaxSize} = $Size;
 299 
 300   return $This;
 301 }
 302 
 303 # Get max size...
 304 #
 305 sub GetMaxSize {
 306   my($This) = @_;
 307 
 308   return $This->{MaxMaxSize};
 309 }
 310 
 311 # Get current size...
 312 #
 313 sub GetCurrentSize {
 314   my($This) = @_;
 315 
 316   return $This->{CurrentSize};
 317 }
 318 
 319 # Get min key...
 320 #
 321 sub GetMinKey {
 322   my($This) = @_;
 323 
 324   return defined $This->{MinKey} ? $This->{MinKey} : 'None';
 325 }
 326 
 327 # Get max key...
 328 #
 329 sub GetMaxKey {
 330   my($This) = @_;
 331 
 332   return defined $This->{MaxKey} ? $This->{MaxKey} : 'None';
 333 }
 334 
 335 # Get keys...
 336 #
 337 sub GetKeys {
 338   my($This) = @_;
 339 
 340   return wantarray ? keys %{$This->{Keys}} : scalar keys %{$This->{Keys}};
 341 }
 342 
 343 # Get sorted keys...
 344 #
 345 sub GetSortedKeys {
 346   my($This) = @_;
 347   my(@SortedKeys);
 348 
 349   @SortedKeys = ();
 350   if ($This->{Type} =~ /^KeepTopN$/i) {
 351     @SortedKeys = ($This->{KeyType} =~ /^Numeric$/i) ? (sort { $b <=> $a } keys %{$This->{Keys}}) : (sort { $b cmp $a } keys %{$This->{Keys}});
 352   }
 353   elsif ($This->{Type} =~ /^KeepBottomN$/i) {
 354     @SortedKeys = ($This->{KeyType} =~ /^Numeric$/i) ? (sort { $a <=> $b } keys %{$This->{Keys}}) : (sort { $a cmp $b } keys %{$This->{Keys}});
 355   }
 356 
 357   return wantarray ? @SortedKeys : scalar @SortedKeys;
 358 }
 359 
 360 # Get values associated with a specified key...
 361 sub GetKeyValues {
 362   my($This, $Key) = @_;
 363   my(@KeyValues);
 364 
 365   @KeyValues = ();
 366   if (defined($Key) && exists($This->{Keys}{$Key})) {
 367     @KeyValues = @{$This->{Keys}{$Key}};
 368   }
 369   return wantarray ? @KeyValues : scalar @KeyValues;
 370 }
 371 
 372 #  Add key/value pair...
 373 #
 374 sub _AddKeyValuePair{
 375   my($This, $Key, $Value) = @_;
 376 
 377   if ($This->{CurrentSize} < $This->{MaxSize}) {
 378     return $This->_AppendKeyValuePair($Key, $Value);
 379   }
 380   else {
 381     return $This->_InsertKeyValuePair($Key, $Value);
 382   }
 383 }
 384 
 385 # Append key/value pair...
 386 #
 387 sub _AppendKeyValuePair {
 388   my($This, $Key, $Value) = @_;
 389 
 390   if (!exists $This->{Keys}{$Key}) {
 391     @{$This->{Keys}{$Key}} = ();
 392     $This->{KeysCount} += 1;
 393 
 394     $This->_CompareAndSetMinKey($Key);
 395     $This->_CompareAndSetMaxKey($Key);
 396   }
 397 
 398   push @{$This->{Keys}{$Key}}, $Value;
 399   $This->{CurrentSize} += 1;
 400 
 401   return $This;
 402 }
 403 
 404 # Insert key/value pair...
 405 #
 406 sub _InsertKeyValuePair {
 407   my($This, $Key, $Value) = @_;
 408 
 409   # Is this key need to be inserted?
 410   if (!$This->_IsKeyNeedToBeInserted($Key)) {
 411     return $This;
 412   }
 413 
 414   # Insert key/value pair...
 415   if (!exists $This->{Keys}{$Key}) {
 416     @{$This->{Keys}{$Key}} = ();
 417     $This->{KeysCount} += 1;
 418   }
 419   push @{$This->{Keys}{$Key}}, $Value;
 420   $This->{CurrentSize} += 1;
 421 
 422   # Remove min or max key/value pair along with its update...
 423   my($KeyToDetele);
 424 
 425   $KeyToDetele = ($This->{Type} =~ /^KeepTopN$/i) ? $This->{MinKey} : $This->{MaxKey};
 426   $This->_DeleteKeyValuePair($KeyToDetele);
 427 
 428   return $This;
 429 }
 430 
 431 # Check whether it makes sense to insert specified key...
 432 #
 433 sub _IsKeyNeedToBeInserted {
 434   my($This, $Key) = @_;
 435 
 436   if ($This->{Type} =~ /^KeepTopN$/i) {
 437     if ($This->{KeyType} =~ /^Numeric$/i) {
 438       return ($Key < $This->{MinKey}) ? 0 : ((($This->{KeysCount} == 1) && ($This->{MinKey} == $Key)) ? 0 : 1);
 439     }
 440     else {
 441       return ($Key lt $This->{MinKey}) ? 0 : ((($This->{KeysCount} == 1) && ($This->{MinKey} eq $Key)) ? 0 : 1);
 442     }
 443   }
 444   elsif ($This->{Type} =~ /^KeepBottomN$/i) {
 445     if ($This->{KeyType} =~ /^Numeric$/i) {
 446       return ($Key > $This->{MaxKey}) ? 0 : ((($This->{KeysCount} == 1) && ($This->{MaxKey} == $Key)) ? 0 : 1);
 447     }
 448     else {
 449       return ($Key gt $This->{MaxKey}) ? 0 : ((($This->{KeysCount} == 1) && ($This->{MaxKey} eq $Key)) ? 0 : 1);
 450     }
 451   }
 452 
 453   return 1;
 454 }
 455 
 456 # Set min key...
 457 #
 458 sub _CompareAndSetMinKey {
 459   my($This, $Key) = @_;
 460 
 461   if (!defined $This->{MinKey}) {
 462     $This->{MinKey} = $Key;
 463     return $This;
 464   }
 465 
 466   if ($This->{KeyType} =~ /^Numeric$/i) {
 467     if ($Key < $This->{MinKey}) {
 468       $This->{MinKey} = $Key;
 469     }
 470   }
 471   else {
 472     if ($Key lt $This->{MinKey}) {
 473       $This->{MinKey} = $Key;
 474     }
 475   }
 476 
 477   return $This;
 478 }
 479 
 480 # Set max key...
 481 #
 482 sub _CompareAndSetMaxKey {
 483   my($This, $Key) = @_;
 484 
 485   if (!defined $This->{MaxKey}) {
 486     $This->{MaxKey} = $Key;
 487     return $This;
 488   }
 489 
 490   if ($This->{KeyType} =~ /^Numeric$/i) {
 491     if ($Key > $This->{MaxKey}) {
 492       $This->{MaxKey} = $Key;
 493     }
 494   }
 495   else {
 496     if ($Key gt $This->{MaxKey}) {
 497       $This->{MaxKey} = $Key;
 498     }
 499   }
 500 
 501   return $This;
 502 }
 503 
 504 # Delete a sepcified key along with all of its values added to the list...
 505 #
 506 sub _DeleteKey {
 507   my($This, $Key) = @_;
 508   my($NumOfValues);
 509 
 510   if (!exists $This->{Keys}{$Key}) {
 511     return undef;
 512   }
 513 
 514   # Delete all key values...
 515   $NumOfValues = scalar @{$This->{Keys}{$Key}};
 516   @{$This->{Keys}{$Key}} = ();
 517   $This->{CurrentSize} -= $NumOfValues;
 518 
 519   # Delete key...
 520   delete $This->{Keys}{$Key};
 521   $This->{KeysCount} -= 1;
 522 
 523   # Set min and max keys...
 524   $This->_FindAndSetMinAndMaxKeys();
 525 
 526   return $This;
 527 }
 528 
 529 # Delete a sepcified key along with its most recent value added to the list...
 530 #
 531 sub _DeleteKeyValuePair {
 532   my($This, $Key) = @_;
 533 
 534   if (!exists $This->{Keys}{$Key}) {
 535     return undef;
 536   }
 537 
 538   # Delete value...
 539   pop @{$This->{Keys}{$Key}};
 540   $This->{CurrentSize} -= 1;
 541 
 542   # Delete key...
 543   if (!@{$This->{Keys}{$Key}}) {
 544     delete $This->{Keys}{$Key};
 545     $This->{KeysCount} -= 1;
 546   }
 547 
 548   # Set min and max keys...
 549   $This->_FindAndSetMinAndMaxKeys();
 550 
 551   return $This;
 552 }
 553 
 554 # Set min and max key...
 555 #
 556 sub _FindAndSetMinAndMaxKeys {
 557   my($This) = @_;
 558   my(@SortedKeys);
 559 
 560   @SortedKeys = ($This->{KeyType} =~ /^Numeric$/i) ? (sort { $a <=> $b } keys %{$This->{Keys}}) : (sort { $a cmp $b } keys %{$This->{Keys}});
 561 
 562   if (@SortedKeys) {
 563     $This->{MinKey} = $SortedKeys[0];
 564     $This->{MaxKey} = $SortedKeys[$#SortedKeys];
 565   }
 566   else {
 567     $This->{MinKey} = undef;
 568     $This->{MaxKey} = undef;
 569   }
 570 
 571   return $This;
 572 }
 573 
 574 # Return a string containing vector values...
 575 sub StringifyPseudoHeap {
 576   my($This) = @_;
 577   my($PseudoHeapString, $Key, $Value, $KeyValuesString, @KeysAndValues);
 578 
 579   $PseudoHeapString = "PseudoHeap: Type: " . $This->GetType() . "; KeyType: " . $This->GetKeyType() . "; MaxSize: $This->{MaxSize}; CurrentSize: $This->{CurrentSize}; MinKey: " . $This->GetMinKey() .  "; MaxKey: " . $This->GetMaxKey() . "; NumOfUniqueKeys: $This->{KeysCount}";
 580 
 581   @KeysAndValues = ();
 582   for $Key ($This->GetSortedKeys()) {
 583     for $Value ($This->GetKeyValues($Key)) {
 584       push @KeysAndValues, "$Key - $Value";
 585     }
 586   }
 587   if (@KeysAndValues) {
 588     $KeyValuesString = TextUtil::JoinWords(\@KeysAndValues, "; ", 0);
 589   }
 590   else {
 591     $KeyValuesString = "None";
 592   }
 593 
 594   $PseudoHeapString .= "; Sorted Key - Value pairs: [$KeyValuesString]";
 595 
 596   return $PseudoHeapString;
 597 }
 598