--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PriorityQueue.st Sat Sep 05 06:38:27 2015 +0200
@@ -0,0 +1,244 @@
+"{ Package: 'stx:libbasic2' }"
+
+"{ NameSpace: Smalltalk }"
+
+Collection subclass:#PriorityQueue
+ instanceVariableNames:'size maxSize heap comparator'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Collections-Ordered'
+!
+
+!PriorityQueue class methodsFor:'documentation'!
+
+documentation
+"
+ a priority queue is a collection with a given maximum size
+ which only keeps the maxSize largest values.
+ Only up to maxSize elements are stored at any time.
+ The internal organization is a heap; eg. elements are not kept
+ sorted internally.
+
+ When elements are added, a check is made, if the new element should
+ be kept or not.
+
+ Finally, when all elements have been added,
+ get the elements in sorted order by repeated calls to removeFirst,
+ which will remove and return the smallest element.
+"
+!
+
+examples
+"
+ find the 10 largest files in the stx source tree
+ [exBegin]
+ |pq dir|
+
+ pq := PriorityQueue new:10 comparator:[:a :b | a fileSize > b fileSize].
+ dir := '../../' asFilename.
+ dir directoryContentsAsFilenamesDo:[:eachLib |
+ (eachLib baseName startsWith:'lib') ifTrue:[
+ eachLib filesWithSuffix:'st' do:[:fn |
+ pq add:fn
+ ].
+ ].
+ ].
+ [ pq notEmpty ] whileTrue:[
+ |next|
+
+ next := pq removeFirst.
+ Transcript show:next fileSize; space; showCR:next pathName
+ ].
+ [exEnd]
+
+ generate 1 million random numbers and show the 10 largest
+ [exBegin]
+ |pq|
+
+ pq := PriorityQueue new:10.
+ 1000000 timesRepeat:[
+ pq add:(Random nextInteger).
+ ].
+ [ pq notEmpty ] whileTrue:[
+ Transcript showCR:pq removeFirst.
+ ].
+ [exEnd]
+
+ a little test
+ [exBegin]
+ |pq|
+
+ #(10 20 30 40 50 60 70 80) permutationsDo:[:p |
+ pq := PriorityQueue new:5.
+ pq addAll:p.
+ self assert:(pq contents copy sort = #(40 50 60 70 80)).
+ ].
+ [exEnd]
+"
+! !
+
+!PriorityQueue class methodsFor:'instance creation'!
+
+new:maxSize
+ "retun a new PriorityQueue, which holds at most maxNode elements,
+ the largest one's added"
+
+ ^ self new initializeFor:maxSize
+!
+
+new:maxSize comparator:aBlock
+ "retun a new PriorityQueue, which holds at most maxNode elements,
+ the largest one's added"
+
+ ^ self new initializeFor:maxSize comparator:aBlock
+! !
+
+!PriorityQueue methodsFor:'adding'!
+
+add:anElement
+ "if the argument is larger than the currently smallest element,
+ then add it and remove the smallest.
+ Otherwise do nothing"
+
+ size < maxSize ifTrue:[
+ size := size + 1.
+ heap at:size put:anElement.
+ self upHeap.
+ ] ifFalse:[
+ (comparator value:anElement value:(heap at:1)) ifTrue:[
+ heap at:1 put:anElement.
+ self downHeap.
+ ].
+ ]
+
+ "
+ |pq|
+
+ pq := PriorityQueue new:5.
+ pq add:1.
+ pq add:10.
+ pq add:5.
+ pq add:9.
+ pq add:17.
+ pq add:-1.
+ pq add:29.
+ pq
+ "
+!
+
+isEmpty
+ ^ size == 0
+!
+
+size
+ ^ size
+! !
+
+!PriorityQueue methodsFor:'enumerating'!
+
+do:aBlock
+ heap from:1 to:size do:aBlock
+! !
+
+!PriorityQueue methodsFor:'initialization'!
+
+comparator:aBlock
+ comparator := aBlock
+!
+
+initializeFor:maxSizeArg
+ self assert:(maxSizeArg > 0).
+
+ heap := Array new:maxSizeArg.
+ maxSize := maxSizeArg.
+ size := 0.
+ comparator := [:a :b | a > b].
+!
+
+initializeFor:maxSizeArg comparator:aBlock
+ self initializeFor:maxSizeArg.
+ comparator := aBlock
+! !
+
+!PriorityQueue methodsFor:'private'!
+
+contents
+ "return the current contents.
+ It is not sorted by size, but a heap structure"
+
+ ^ heap
+!
+
+downHeap
+ "an element was added at the bottom of the heap;
+ shift it to its place"
+
+ |i j k node|
+
+ i := 1.
+ node := heap at:i.
+ j := i * 2.
+ k := j + 1.
+ ((k <= size) and:[ comparator value:(heap at:j) value:(heap at:k)]) ifTrue:[
+ j := k
+ ].
+
+ [ (j <= size) and:[ comparator value:node value:(heap at:j) ]] whileTrue:[
+ heap at:i put:(heap at:j).
+ i := j.
+ j := j * 2.
+ k := j + 1.
+ ((k <= size) and:[ comparator value:(heap at:j) value:(heap at:k)]) ifTrue:[
+ j := k
+ ].
+ ].
+ heap at:i put:node
+!
+
+upHeap
+ "an element was added to the top of the heap;
+ shift it to its place"
+
+ |i j node|
+
+ i := size.
+ node := heap at:i.
+ j := i // 2.
+ [ (j > 0) and:[ comparator value:(heap at:j) value:node ]] whileTrue:[
+ heap at:i put:(heap at:j).
+ i := j.
+ j := j // 2
+ ].
+ heap at:i put:node
+! !
+
+!PriorityQueue methodsFor:'removing'!
+
+removeAll
+ size := 0
+!
+
+removeFirst
+ "removes and returns the smallest element from the priority queue"
+
+ |rslt|
+
+ size == 0 ifTrue:[ self emptyCollectionError ].
+
+ rslt := heap at:1.
+ heap at:1 put:(heap at:size).
+ size := size - 1.
+ self downHeap.
+ ^ rslt
+! !
+
+!PriorityQueue class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+!
+
+version_CVS
+ ^ '$Header$'
+! !
+
--- a/abbrev.stc Sun Aug 30 06:37:07 2015 +0200
+++ b/abbrev.stc Sat Sep 05 06:38:27 2015 +0200
@@ -48,6 +48,7 @@
Polygon Polygon stx:libbasic2 'Graphics-Geometry-Objects' 0
PrinterStream PrinterStream stx:libbasic2 'Interface-Printing' 8
PrintfScanf PrintfScanf stx:libbasic2 'System-Support' 0
+PriorityQueue PriorityQueue stx:libbasic2 'Collections-Ordered' 0
Promise Promise stx:libbasic2 'Kernel-Processes' 0
Queue Queue stx:libbasic2 'Collections-Ordered' 0
Random Random stx:libbasic2 'Magnitude-Numbers' 0
--- a/bc.mak Sun Aug 30 06:37:07 2015 +0200
+++ b/bc.mak Sat Sep 05 06:38:27 2015 +0200
@@ -80,7 +80,7 @@
test: $(TOP)\goodies\builder\reports\NUL
pushd $(TOP)\goodies\builder\reports & $(MAKE_BAT)
$(TOP)\goodies\builder\reports\report-runner.bat -D . -r Builder::TestReport -p $(PACKAGE)
-
+
clean::
del *.$(CSUFFIX)
--- a/bmake.bat Sun Aug 30 06:37:07 2015 +0200
+++ b/bmake.bat Sat Sep 05 06:38:27 2015 +0200
@@ -4,9 +4,7 @@
@REM do not edit - automatically generated from ProjectDefinition
@REM -------
@SET DEFINES=
-@REM Kludge got Mercurial, cannot be implemented in Borland make
-@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
-@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+
make.exe -N -f bc.mak %DEFINES% %*
--- a/libbasic2.rc Sun Aug 30 06:37:07 2015 +0200
+++ b/libbasic2.rc Sat Sep 05 06:38:27 2015 +0200
@@ -3,7 +3,7 @@
// automagically generated from the projectDefinition: stx_libbasic2.
//
VS_VERSION_INFO VERSIONINFO
- FILEVERSION 6,2,1,120
+ FILEVERSION 6,2,1,123
PRODUCTVERSION 6,2,5,0
#if (__BORLANDC__)
FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE
@@ -20,12 +20,12 @@
BEGIN
VALUE "CompanyName", "eXept Software AG\0"
VALUE "FileDescription", "Smalltalk/X Additional Basic Classes (LIB)\0"
- VALUE "FileVersion", "6.2.1.120\0"
+ VALUE "FileVersion", "6.2.1.123\0"
VALUE "InternalName", "stx:libbasic2\0"
- VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2012\nCopyright eXept Software AG 1998-2012\0"
+ VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2012\nCopyright eXept Software AG 2012\0"
VALUE "ProductName", "Smalltalk/X\0"
VALUE "ProductVersion", "6.2.5.0\0"
- VALUE "ProductDate", "Thu, 11 Jun 2015 19:17:27 GMT\0"
+ VALUE "ProductDate", "Fri, 04 Sep 2015 13:15:41 GMT\0"
END
END
--- a/mingwmake.bat Sun Aug 30 06:37:07 2015 +0200
+++ b/mingwmake.bat Sat Sep 05 06:38:27 2015 +0200
@@ -4,9 +4,6 @@
@REM do not edit - automatically generated from ProjectDefinition
@REM -------
@SET DEFINES=
-@REM Kludge got Mercurial, cannot be implemented in Borland make
-@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
-@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
@pushd ..\rules
@call find_mingw.bat
--- a/stx_libbasic2.st Sun Aug 30 06:37:07 2015 +0200
+++ b/stx_libbasic2.st Sat Sep 05 06:38:27 2015 +0200
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 2006 by eXept Software AG
All Rights Reserved
@@ -251,6 +249,7 @@
Polygon
PrinterStream
PrintfScanf
+ (PriorityQueue autoload)
Promise
Queue
Random
--- a/vcmake.bat Sun Aug 30 06:37:07 2015 +0200
+++ b/vcmake.bat Sat Sep 05 06:38:27 2015 +0200
@@ -10,11 +10,8 @@
popd
)
@SET DEFINES=
-@REM Kludge got Mercurial, cannot be implemented in Borland make
-@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
-@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+
make.exe -N -f bc.mak -DUSEVC=1 %DEFINES% %*
-