SortedCollection.st
author Claus Gittinger <cg@exept.de>
Fri, 27 Oct 1995 16:56:51 +0100
changeset 451 5aab4706f2fd
parent 384 cc3d110ea879
child 530 07d0bce293c9
permissions -rw-r--r--
.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     1
"
a27a279701f8 Initial revision
claus
parents:
diff changeset
     2
 COPYRIGHT (c) 1993 by Claus Gittinger
159
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
     3
	      All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     4
a27a279701f8 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
a27a279701f8 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
a27a279701f8 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
a27a279701f8 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
a27a279701f8 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    11
"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    12
a27a279701f8 Initial revision
claus
parents:
diff changeset
    13
OrderedCollection subclass:#SortedCollection
159
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
    14
	 instanceVariableNames:'sortBlock'
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
    15
	 classVariableNames:'DefaultSortBlock'
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
    16
	 poolDictionaries:''
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
    17
	 category:'Collections-Sequenceable'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    18
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    19
a27a279701f8 Initial revision
claus
parents:
diff changeset
    20
SortedCollection comment:'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    21
COPYRIGHT (c) 1993 by Claus Gittinger
159
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
    22
	      All Rights Reserved
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
    23
384
claus
parents: 379
diff changeset
    24
$Header: /cvs/stx/stx/libbasic/SortedCollection.st,v 1.20 1995-08-11 03:04:02 claus Exp $
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
    25
'!
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
    26
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
    27
!SortedCollection class methodsFor:'documentation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    28
88
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    29
copyright
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    30
"
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    31
 COPYRIGHT (c) 1993 by Claus Gittinger
159
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
    32
	      All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    33
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    34
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    35
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    36
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    37
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    38
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    39
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    40
"
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    41
!
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    42
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    43
version
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    44
"
384
claus
parents: 379
diff changeset
    45
$Header: /cvs/stx/stx/libbasic/SortedCollection.st,v 1.20 1995-08-11 03:04:02 claus Exp $
88
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    46
"
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    47
!
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    48
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
    49
documentation
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
    50
"
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
    51
    I keep my elements sorted. The sort order is defined by a sortblock,
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
    52
    a two-argument block which, when given two elements of the collection, 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
    53
    should return true if the element given as first arg has to come before the 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
    54
    element given as second arg.
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
    55
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
    56
    Thus a sortBlock of [:a :b | a < b] defines ascending sort-order,
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
    57
    while [:a :b | a > b] defines descening order.
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
    58
    The default sortBlock for SortedCollections is the first one.
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
    59
"
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
    60
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    61
a27a279701f8 Initial revision
claus
parents:
diff changeset
    62
!SortedCollection class methodsFor:'initialization'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    63
a27a279701f8 Initial revision
claus
parents:
diff changeset
    64
initialize
a27a279701f8 Initial revision
claus
parents:
diff changeset
    65
    DefaultSortBlock := [:a :b | a < b ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
    66
a27a279701f8 Initial revision
claus
parents:
diff changeset
    67
    "SortedCollection initialize"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    68
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
    69
a27a279701f8 Initial revision
claus
parents:
diff changeset
    70
!SortedCollection class methodsFor:'instance creation'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    71
a27a279701f8 Initial revision
claus
parents:
diff changeset
    72
new
2
claus
parents: 1
diff changeset
    73
    "return a new sortedCollection, the sorting is done using
claus
parents: 1
diff changeset
    74
     a compare for a > b, in ascending order"
claus
parents: 1
diff changeset
    75
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    76
    ^ super new setSortBlock:DefaultSortBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
    77
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    78
a27a279701f8 Initial revision
claus
parents:
diff changeset
    79
new:size
2
claus
parents: 1
diff changeset
    80
    "return a new sortedCollection with preallocated size.
claus
parents: 1
diff changeset
    81
     The sorting is done using a compare for a > b, in ascending order"
claus
parents: 1
diff changeset
    82
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    83
    ^ (super new:size) setSortBlock:DefaultSortBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
    84
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    85
a27a279701f8 Initial revision
claus
parents:
diff changeset
    86
sortBlock:aBlock
2
claus
parents: 1
diff changeset
    87
    "set the sort-block"
claus
parents: 1
diff changeset
    88
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    89
    ^ super new setSortBlock:aBlock
329
claus
parents: 216
diff changeset
    90
!
claus
parents: 216
diff changeset
    91
claus
parents: 216
diff changeset
    92
withAll:aCollection sortBlock:aBlock
claus
parents: 216
diff changeset
    93
    "initialize from aCollection and set the sort-block"
claus
parents: 216
diff changeset
    94
claus
parents: 216
diff changeset
    95
    ^ (self sortBlock:aBlock) addAll:aCollection
claus
parents: 216
diff changeset
    96
claus
parents: 216
diff changeset
    97
    "
claus
parents: 216
diff changeset
    98
     SortedCollection withAll:#(1 2 3 4 5 6 7 8 9 0)
claus
parents: 216
diff changeset
    99
		      sortBlock:[:a :b | a > b] 
claus
parents: 216
diff changeset
   100
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   101
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   102
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 184
diff changeset
   103
!SortedCollection methodsFor:'copying'!
40ca7cc6fb9c *** empty log message ***
claus
parents: 184
diff changeset
   104
40ca7cc6fb9c *** empty log message ***
claus
parents: 184
diff changeset
   105
copyEmpty:size
40ca7cc6fb9c *** empty log message ***
claus
parents: 184
diff changeset
   106
    "return a copy of the receiver with no elements, but
40ca7cc6fb9c *** empty log message ***
claus
parents: 184
diff changeset
   107
     the same size. This method has been be redefined to
40ca7cc6fb9c *** empty log message ***
claus
parents: 184
diff changeset
   108
     preserve the sortBlock."
40ca7cc6fb9c *** empty log message ***
claus
parents: 184
diff changeset
   109
40ca7cc6fb9c *** empty log message ***
claus
parents: 184
diff changeset
   110
    ^ (self species new:size) sortBlock:sortBlock
40ca7cc6fb9c *** empty log message ***
claus
parents: 184
diff changeset
   111
! !
40ca7cc6fb9c *** empty log message ***
claus
parents: 184
diff changeset
   112
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   113
!SortedCollection methodsFor:'adding & removing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   114
a27a279701f8 Initial revision
claus
parents:
diff changeset
   115
addFirst:anObject
2
claus
parents: 1
diff changeset
   116
    "catch this - its not allowed for sortedCollections"
claus
parents: 1
diff changeset
   117
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   118
    self shouldNotImplement
a27a279701f8 Initial revision
claus
parents:
diff changeset
   119
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   120
a27a279701f8 Initial revision
claus
parents:
diff changeset
   121
addLast:anObject
2
claus
parents: 1
diff changeset
   122
    "catch this - its not allowed for sortedCollections"
claus
parents: 1
diff changeset
   123
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   124
    self shouldNotImplement
a27a279701f8 Initial revision
claus
parents:
diff changeset
   125
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   126
a27a279701f8 Initial revision
claus
parents:
diff changeset
   127
at:index put:anObject
2
claus
parents: 1
diff changeset
   128
    "catch this - its not allowed for sortedCollections"
claus
parents: 1
diff changeset
   129
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   130
    self shouldNotImplement
a27a279701f8 Initial revision
claus
parents:
diff changeset
   131
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   132
a27a279701f8 Initial revision
claus
parents:
diff changeset
   133
add:newObject after:oldObject
2
claus
parents: 1
diff changeset
   134
    "catch this - its not allowed for sortedCollections"
claus
parents: 1
diff changeset
   135
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   136
    self shouldNotImplement
a27a279701f8 Initial revision
claus
parents:
diff changeset
   137
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   138
a27a279701f8 Initial revision
claus
parents:
diff changeset
   139
add:newObject before:oldObject
2
claus
parents: 1
diff changeset
   140
    "catch this - its not allowed for sortedCollections"
claus
parents: 1
diff changeset
   141
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   142
    self shouldNotImplement
a27a279701f8 Initial revision
claus
parents:
diff changeset
   143
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   144
a27a279701f8 Initial revision
claus
parents:
diff changeset
   145
addAll:aCollection
a27a279701f8 Initial revision
claus
parents:
diff changeset
   146
    "add all elements of the argument, aCollection to the
a27a279701f8 Initial revision
claus
parents:
diff changeset
   147
     receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   148
a27a279701f8 Initial revision
claus
parents:
diff changeset
   149
    |mySize    "{ Class: SmallInteger }"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   150
     otherSize "{ Class: SmallInteger }"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   151
     dstIndex  "{ Class: SmallInteger }"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   152
     newSize newContents|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   153
a27a279701f8 Initial revision
claus
parents:
diff changeset
   154
    "if aCollection is bigger than a threshhold, its faster
359
claus
parents: 348
diff changeset
   155
     to add all en-bloque and resort the whole collection.
claus
parents: 348
diff changeset
   156
     Question: what is a good treshhold ?"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   157
a27a279701f8 Initial revision
claus
parents:
diff changeset
   158
    mySize := self size.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   159
    otherSize := aCollection size.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   160
    ((mySize == 0) or:[otherSize > 5]) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   161
	newSize := mySize + otherSize.
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   162
	newContents := Array new:newSize.
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   163
	newContents replaceFrom:1 to:mySize with:contentsArray startingAt:1.
359
claus
parents: 348
diff changeset
   164
	aCollection isSequenceable ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   165
	    "maybe we can do it in one big move"
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   166
	    newContents replaceFrom:(mySize + 1) to:newSize with:aCollection startingAt:1.
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   167
	] ifFalse:[
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   168
	    dstIndex := mySize + 1.
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   169
	    aCollection do:[:element |
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   170
		newContents at:dstIndex put:element.
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   171
		dstIndex := dstIndex + 1
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   172
	    ]
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   173
	].
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   174
	firstIndex := 1.
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   175
	lastIndex := newSize.
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   176
	contentsArray := newContents.
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   177
	contentsArray sort:sortBlock.
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   178
	^ self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   179
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   180
    super addAll:aCollection
a27a279701f8 Initial revision
claus
parents:
diff changeset
   181
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   182
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   183
     #(7 3 9 10 99) asSortedCollection addAll:#(77 0 1 16 5) 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   184
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   185
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   186
a27a279701f8 Initial revision
claus
parents:
diff changeset
   187
add:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   188
    "add the argument, anObject at the proper place in the
2
claus
parents: 1
diff changeset
   189
     receiver. Returns the argument, anObject."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   190
32
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   191
    |index|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   192
32
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   193
    lastIndex < firstIndex "i.e. self size == 0" ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   194
	super add:anObject
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   195
    ] ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   196
	index := self indexForInserting:anObject. 
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   197
	self makeRoomAtIndex:index.
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   198
	contentsArray at:index put:anObject
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   199
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   200
    ^ anObject
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   201
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   202
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   203
     |c| #(7 3 9 10 99) asSortedCollection add:5; yourself    
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   204
     #(7 3 9 10 99) asSortedCollection add:1; yourself        
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   205
     #(7 3 9 10 99) asSortedCollection add:1000; yourself     
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   206
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   207
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   208
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   209
!SortedCollection methodsFor:'copying'!
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   210
159
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   211
postCopyFrom:anOriginal
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   212
    "sent after a copy or when a new collection species has been created.
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   213
     The new collection should have the same sortBlock as the original."
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   214
159
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   215
    sortBlock := anOriginal sortBlock
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   216
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   217
    "
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   218
     #(4 7 1 99 -1 17) asSortedCollection inspect
159
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   219
     #(4 7 1 99 -1 17) asSortedCollection copy inspect
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   220
     (#(4 7 1 99 -1 17) asSortedCollection sortBlock:[:a :b | a > b]) inspect
159
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   221
     (#(4 7 1 99 -1 17) asSortedCollection sortBlock:[:a :b | a > b]) copy inspect
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   222
     (#(4 7 1 99 -1 17) asSortedCollection select:[:e| e even]) inspect
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   223
    "
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   224
! !
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   225
13
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   226
!SortedCollection methodsFor:'converting'!
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   227
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   228
asSortedCollection
32
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   229
    "return the receiver as a sorted collection"
13
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   230
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   231
    "could be an instance of a subclass..."
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   232
    self class == SortedCollection ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   233
	^ self
13
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   234
    ].
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   235
    ^ super asSortedCollection
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   236
! !
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   237
216
a8abff749575 *** empty log message ***
claus
parents: 202
diff changeset
   238
!SortedCollection methodsFor:'enumerating'!
184
d795f0b1934a collect: fixed
claus
parents: 159
diff changeset
   239
d795f0b1934a collect: fixed
claus
parents: 159
diff changeset
   240
collect:aBlock
d795f0b1934a collect: fixed
claus
parents: 159
diff changeset
   241
    "evaluate the argument, aBlock for every element in the collection
d795f0b1934a collect: fixed
claus
parents: 159
diff changeset
   242
     and return a collection of the results. Redefined to return an OrderedCollection;
d795f0b1934a collect: fixed
claus
parents: 159
diff changeset
   243
     see X3J20 spec. (SortedCollection>>collect: should return an OrderedCollection)"
d795f0b1934a collect: fixed
claus
parents: 159
diff changeset
   244
d795f0b1934a collect: fixed
claus
parents: 159
diff changeset
   245
    |newCollection
d795f0b1934a collect: fixed
claus
parents: 159
diff changeset
   246
     start  "{ Class:SmallInteger }"
d795f0b1934a collect: fixed
claus
parents: 159
diff changeset
   247
     stop   "{ Class:SmallInteger }" |
d795f0b1934a collect: fixed
claus
parents: 159
diff changeset
   248
d795f0b1934a collect: fixed
claus
parents: 159
diff changeset
   249
    newCollection := OrderedCollection new:(self size).
d795f0b1934a collect: fixed
claus
parents: 159
diff changeset
   250
    stop := lastIndex.
d795f0b1934a collect: fixed
claus
parents: 159
diff changeset
   251
    start := firstIndex.
d795f0b1934a collect: fixed
claus
parents: 159
diff changeset
   252
    start to:stop do:[:index |
d795f0b1934a collect: fixed
claus
parents: 159
diff changeset
   253
	newCollection add:(aBlock value:(contentsArray at:index)).
d795f0b1934a collect: fixed
claus
parents: 159
diff changeset
   254
    ].
d795f0b1934a collect: fixed
claus
parents: 159
diff changeset
   255
    ^ newCollection
d795f0b1934a collect: fixed
claus
parents: 159
diff changeset
   256
! !
d795f0b1934a collect: fixed
claus
parents: 159
diff changeset
   257
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   258
!SortedCollection methodsFor:'testing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   259
a27a279701f8 Initial revision
claus
parents:
diff changeset
   260
includes:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   261
    "return true, if the argument, anObject is in the collection.
62
e1b4369c61fb *** empty log message ***
claus
parents: 44
diff changeset
   262
     Redefined, since due to being sorted, the inclusion check can
2
claus
parents: 1
diff changeset
   263
     be done with log-n compares i.e. much faster."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   264
32
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   265
    |index "{ Class: SmallInteger }"|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   266
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   267
    index := self indexForInserting:anObject.
32
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   268
    ((index < firstIndex) or:[index > lastIndex]) ifTrue:[^ false].
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   269
    ^ (contentsArray at:index) = anObject
2
claus
parents: 1
diff changeset
   270
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   271
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   272
     #(7 3 9 10 99) asSortedCollection includes:50
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   273
     #(7 3 9 10 99) asSortedCollection includes:10
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   274
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   275
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   276
a27a279701f8 Initial revision
claus
parents:
diff changeset
   277
occurrencesOf:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   278
    "return how many times the argument, anObject is in the collection.
62
e1b4369c61fb *** empty log message ***
claus
parents: 44
diff changeset
   279
     Redefined, since due to being sorted, the range of checked objects
2
claus
parents: 1
diff changeset
   280
     can be limited i.e. it can be done much faster."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   281
a27a279701f8 Initial revision
claus
parents:
diff changeset
   282
    |index      "{ Class: SmallInteger }"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   283
     tally      "{ Class: SmallInteger }" |
a27a279701f8 Initial revision
claus
parents:
diff changeset
   284
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   285
    index := self indexForInserting:anObject.
32
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   286
    ((index < firstIndex) or:[index > lastIndex]) ifTrue:[^ 0].
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   287
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   288
    tally := 0.
32
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   289
    [(index <= lastIndex) and:[(contentsArray at:index) = anObject]] whileTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   290
	tally := tally + 1.
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   291
	index := index + 1
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   292
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   293
    ^ tally
2
claus
parents: 1
diff changeset
   294
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   295
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   296
     #(7 3 9 10 99) asSortedCollection occurrencesOf:50
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   297
     #(7 3 9 10 99) asSortedCollection occurrencesOf:10
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   298
     #(7 10 3 10 9 10 10 99) asSortedCollection occurrencesOf:10
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   299
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   300
! !
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   301
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   302
!SortedCollection methodsFor:'searching'!
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   303
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   304
before:anObject
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   305
    "return the element before the argument, anObject; or nil if there is none.
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   306
     If the receiver does not contain anObject, report an error"
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   307
348
claus
parents: 345
diff changeset
   308
    ^ self before:anObject ifAbsent:[self errorValueNotFound:anObject]
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   309
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   310
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   311
     #(7 3 9 10 99) asSortedCollection before:50
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   312
     #(7 3 9 10 99) asSortedCollection before:1 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   313
     #(7 3 9 10 99) asSortedCollection before:1000 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   314
     #(7 3 9 10 99) asSortedCollection before:10
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   315
     #(7 3 9 10 99) asSortedCollection before:7 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   316
     #(7 3 9 10 99) asSortedCollection before:99 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   317
     #(7 10 3 10 9 10 10 99) asSortedCollection before:9
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   318
     #(7 10 3 10 9 10 10 99) asSortedCollection before:10
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   319
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   320
!
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   321
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   322
before:anObject ifAbsent:exceptionBlock
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   323
    "return the element before the argument, anObject; or nil if there is none.
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   324
     If the receiver does not contain anObject, return the result from evaluating
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   325
     exceptionBlock."
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   326
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   327
    |index      "{ Class: SmallInteger }"|
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   328
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   329
    index := self indexForInserting:anObject.
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   330
    ((index <= firstIndex) 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   331
     or:[(contentsArray at:index) ~= anObject]) ifTrue:[^ exceptionBlock value].
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   332
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   333
    ^ contentsArray at:index - 1
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   334
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   335
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   336
     #(7 3 9 10 99) asSortedCollection before:50
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   337
     #(7 3 9 10 99) asSortedCollection before:1 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   338
     #(7 3 9 10 99) asSortedCollection before:10  
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   339
     #(7 3 9 10 99) asSortedCollection before:7   
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   340
     #(7 3 9 10 99) asSortedCollection before:99   
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   341
     #(7 10 3 10 9 10 10 99) asSortedCollection before:9  
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   342
     #(7 10 3 10 9 10 10 99) asSortedCollection before:10   
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   343
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   344
!
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   345
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   346
after:anObject
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   347
    "return the element after the argument, anObject; or nil if there is none.
359
claus
parents: 348
diff changeset
   348
     If anObject is contained multiple times in the collection, return the
claus
parents: 348
diff changeset
   349
     the first element which is non-equal to anObject.
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   350
     If the receiver does not contain anObject, report an error"
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   351
348
claus
parents: 345
diff changeset
   352
    ^ self after:anObject ifAbsent:[self errorValueNotFound:anObject]
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   353
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   354
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   355
     #(7 3 9 10 99) asSortedCollection after:50
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   356
     #(7 3 9 10 99) asSortedCollection after:1 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   357
     #(7 3 9 10 99) asSortedCollection after:10
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   358
     #(7 3 9 10 99) asSortedCollection after:7 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   359
     #(7 3 9 10 99) asSortedCollection after:99 
359
claus
parents: 348
diff changeset
   360
     #(7 10 3 10 9 10 10 99) asSortedCollection after:9  
claus
parents: 348
diff changeset
   361
     #(7 10 3 10 9 10 10 99) asSortedCollection after:10 
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   362
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   363
!
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   364
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   365
after:anObject ifAbsent:exceptionBlock
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   366
    "return the element after the argument, anObject; or nil if there is none.
359
claus
parents: 348
diff changeset
   367
     If anObject is contained multiple times in the collection, return the
claus
parents: 348
diff changeset
   368
     the first element which is non-equal to anObject.
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   369
     If the receiver does not contain anObject, return the result from evaluating
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   370
     exceptionBlock."
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   371
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   372
    |index      "{ Class: SmallInteger }"|
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   373
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   374
    index := self indexForInserting:anObject.
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   375
    ((index < firstIndex) 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   376
     or:[(contentsArray at:index) ~= anObject]) ifTrue:[^ exceptionBlock value].
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   377
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   378
    "skip multiple occurences of the same ..."
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   379
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   380
    [(index <= lastIndex) and:[(contentsArray at:index) = anObject]] whileTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   381
	index := index + 1
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   382
    ].
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   383
    (index > lastIndex) ifTrue:[^ nil].
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   384
    ^ contentsArray at:index
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   385
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   386
a27a279701f8 Initial revision
claus
parents:
diff changeset
   387
!SortedCollection methodsFor:'instance protocol'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   388
a27a279701f8 Initial revision
claus
parents:
diff changeset
   389
sortBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
   390
    "return the block used for sorting"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   391
a27a279701f8 Initial revision
claus
parents:
diff changeset
   392
    ^ sortBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
   393
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   394
a27a279701f8 Initial revision
claus
parents:
diff changeset
   395
sortBlock:aSortBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
   396
    "change the sort criteria for a sorted collection, resort the elements of 
a27a279701f8 Initial revision
claus
parents:
diff changeset
   397
    the collection, and return the receiver. The argument, aSortBlock must
a27a279701f8 Initial revision
claus
parents:
diff changeset
   398
    be a two-argument block which returns true if its arg1 has to come before
a27a279701f8 Initial revision
claus
parents:
diff changeset
   399
    its arg2 in the collection."
a27a279701f8 Initial revision
claus
parents:
diff changeset
   400
a27a279701f8 Initial revision
claus
parents:
diff changeset
   401
    sortBlock := aSortBlock.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   402
    lastIndex > firstIndex ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   403
	contentsArray quickSortFrom:firstIndex to:lastIndex sortBlock:aSortBlock
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   404
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   405
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   406
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   407
     #(9 8 7 6 5 4 3) asSortedCollection
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   408
     #(9 8 7 6 5 4 3) asSortedCollection sortBlock:[:a : b | a < b]
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   409
     #(9 8 7 6 5 4 3) asSortedCollection sortBlock:[:a : b | a > b]
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   410
     #($f $G $z $Y $o $H) asSortedCollection
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   411
     #($f $G $z $Y $o $H) asSortedCollection sortBlock:[:a : b | a asUppercase < b asUppercase]
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   412
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   413
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   414
a27a279701f8 Initial revision
claus
parents:
diff changeset
   415
!SortedCollection methodsFor:'private'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   416
a27a279701f8 Initial revision
claus
parents:
diff changeset
   417
setSortBlock: aSortBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
   418
    "set the sortblock without resorting - private only"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   419
a27a279701f8 Initial revision
claus
parents:
diff changeset
   420
    sortBlock := aSortBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
   421
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   422
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   423
indexForInserting:anObject
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   424
    "search the index at which to insert anObject. Can also be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
   425
     to search for an existing element by checking if the element at
32
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   426
     the returned index is the one we look for.
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   427
     The returned index is a physical one, for accessing contentsArray."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   428
a27a279701f8 Initial revision
claus
parents:
diff changeset
   429
    |low    "{ Class: SmallInteger}"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   430
     high   "{ Class: SmallInteger}"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   431
     middle "{ Class: SmallInteger}"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   432
     element|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   433
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   434
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   435
     we can of course use a binary search - since the elements are
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   436
     sorted
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   437
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   438
    low := firstIndex.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   439
    high := lastIndex.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   440
    [low <= high] whileTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   441
	middle := (low + high) // 2.
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   442
	element := contentsArray at:middle.
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   443
	(sortBlock value:element value:anObject) ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   444
	    "middleelement is smaller than object"
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   445
	    low := middle + 1
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   446
	] ifFalse:[
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   447
	    high := middle - 1
514c749165c3 *** empty log message ***
claus
parents: 95
diff changeset
   448
	]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   449
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   450
    ^ low
a27a279701f8 Initial revision
claus
parents:
diff changeset
   451
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   452
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   453
     #(1 2 3 4 7 99 1313 981989 898989898) asSortedCollection indexForInserting:50      
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   454
     #(1.0 2.0 3 4 7 49.0 51.0 99 1313 981989 898989898) asSortedCollection indexForInserting:50 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   455
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   456
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   457
! !