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