       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