1 package PseudoHeap;
   2 #
   3 # File: PseudoHeap.pm
   4 # Author: Manish Sud <msud@san.rr.com>
   5 #
   6 # Copyright (C) 2024 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