Bag.st
author Claus Gittinger <cg@exept.de>
Mon, 23 Oct 1995 17:55:03 +0100
changeset 443 fae13c0f1512
parent 399 c15cfaf3ed4d
child 528 a083413dfbe8
permissions -rw-r--r--
.

"
 COPYRIGHT (c) 1991 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

Collection subclass:#Bag
       instanceVariableNames:'contents'
       classVariableNames:''
       poolDictionaries:''
       category:'Collections-Unordered'
!

Bag comment:'
COPYRIGHT (c) 1991 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libbasic/Bag.st,v 1.13 1995-08-16 18:25:45 claus Exp $
'!

!Bag class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1991 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

version
"
$Header: /cvs/stx/stx/libbasic/Bag.st,v 1.13 1995-08-16 18:25:45 claus Exp $
"
!

documentation
"
    Bag implements collections whose elements are unordered and have no
    external key. Elements may occur more than once in a bag. There is no defined
    order within a bag. 
    The default implementation uses a dictionary to store each objects occurence 
    count, using the object itself as key (i.e. using = and hash for inclusion 
    tests).

    There is also an instance creation variant (#identityNew:) creating a
    bag which compares using #== and hashes using #identityHash.
    (I'd say that an IdentityBag was a better thing to implement ... 
     ... but for compatibility ... we do it here as well)

    Instance variables:

	contents        <Dictionary>    for each element, the number of occurrences
"
! !

!Bag class methodsFor:'instance creation'!

new
    "return a new empty Bag which compares for equality (i.e. not identity)"

    ^ super new initContents
!

new:size
    "return a new empty Bag with initial space for size elements.
     Elements will be compared using equality compare (i.e. #= not #== identity)."

    ^ self equalityNew:size
!

equalityNew:size
    "return a new empty Bag with initial space for size elements.
     Elements will be compared using equality compare (i.e. #= not #== identity)."

    ^ super new initContents:size
!

identityNew:size
    "return a new empty Bag with initial space for size elements.
     Elements will be compared using identity compare (i.e. #== not #= equality)."

    ^ super new initContentsForIdentity:size
! !

!Bag methodsFor:'private'!

initContents
    "set the contents to be an empty Dictionary"

    contents := Dictionary new
!

initContents:size
    "set the contents to be an empty Dictionary with initial size"

    contents := Dictionary new:size
!

initContentsForIdentity:size
    "set the contents to be an empty IdentityDictionary with initial size"

    contents := IdentityDictionary new:size
! !

!Bag methodsFor:'accessing'!

at:index
    "report an error: at: is not allowed for Bags"

    ^ self errorNotKeyed
!

at:index put:anObject
    "report an error: at:put: is not allowed for Bags"

    ^ self errorNotKeyed
!

contents
    "return the dictionary which associates occurrence-counts
     to the bags elements."

    ^ contents
! !

!Bag methodsFor:'testing'!

size
    "return the number of bag elements"

    |count|

    count := 0.
    contents do:[:element | count := count + element].
    ^ count
!

occurrencesOf:anObject
    "return how many times anObject is in the receiver"

    ^ contents at:anObject ifAbsent:[0]
!

includes:anObject
    "return true, if anObject is in the receiver"

    ^ contents includesKey:anObject
! !

!Bag methodsFor:'copying'!

postCopy
    "must copy the contents as well"

    contents := contents copy
! !

!Bag methodsFor:'converting'!

asBag
    "return the receiver as a bag"

    "could be an instance of a subclass..."
    self class == Bag ifTrue:[
	^ self
    ].
    ^ super asBag
! !

!Bag methodsFor:'adding & removing'!

add:newObject
    "add the argument, anObject to the receiver.
     Returns the object."

    |n|

    n := contents at:newObject ifAbsent:[0].
    contents at:newObject put:(n + 1).
    ^ newObject
!

add:newObject withOccurences:anInteger
    "add the argument, anObject anInteger times to the receiver.
     Returns the object."

    |n|

    n := contents at:newObject ifAbsent:[0].
    contents at:newObject put:(n + anInteger).
    ^ newObject
!

remove:oldObject ifAbsent:anExceptionBlock
    "Remove oldObject from the collection.
     If it was not present, return the value of the exceptionBlock;
     otherwise return the removed object."

    |count|

    count := contents at:oldObject ifAbsent:[0].
    (count == 0) ifTrue:[^ anExceptionBlock value].
    (count == 1) ifTrue:[
	contents removeKey:oldObject
    ] ifFalse:[ 
	contents at:oldObject put:(count - 1)
    ].
    ^ oldObject
!

removeAllOccurrencesOf:oldObject ifAbsent:anExceptionBlock
    "Remove all occurrences of oldObject from the collection.
     If it was not present, return the value of the exceptionBlock;
     otherwise return the number of removes."

    |count|

    count := contents at:oldObject ifAbsent:[0].
    (count == 0) ifTrue:[^ anExceptionBlock value].
    contents removeKey:oldObject.
    ^ oldObject
! !

!Bag methodsFor:'enumerating'!

do:aBlock
    "evaluate the block for all elements in the collection."

    contents keysAndValuesDo:[:key :value|
	value timesRepeat:[
	    aBlock value:key
	]
    ]
!

valuesAndCountsDo:aTwoArgBlock
    "evaluate the block for all distinct elements in the collection,
     passing both the element and the occurence count as arguments."

    ^ contents keysAndValuesDo:aTwoArgBlock
! !