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