SortedCollection.st
author claus
Fri, 05 Aug 1994 03:03:10 +0200
changeset 95 d22739a0c6e9
parent 88 81dacba7a63a
child 159 514c749165c3
permissions -rw-r--r--
*** empty log message ***
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
a27a279701f8 Initial revision
claus
parents:
diff changeset
     3
              All Rights Reserved
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
a27a279701f8 Initial revision
claus
parents:
diff changeset
    14
         instanceVariableNames:'sortBlock'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    15
         classVariableNames:'DefaultSortBlock'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    16
         poolDictionaries:''
a27a279701f8 Initial revision
claus
parents:
diff changeset
    17
         category:'Collections-Ordered'
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
a27a279701f8 Initial revision
claus
parents:
diff changeset
    22
              All Rights Reserved
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
    23
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
    24
$Header: /cvs/stx/stx/libbasic/SortedCollection.st,v 1.10 1994-08-05 01:02:42 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
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    32
              All Rights Reserved
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
"
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
    45
$Header: /cvs/stx/stx/libbasic/SortedCollection.st,v 1.10 1994-08-05 01:02:42 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
a27a279701f8 Initial revision
claus
parents:
diff changeset
    90
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
    91
a27a279701f8 Initial revision
claus
parents:
diff changeset
    92
!SortedCollection methodsFor:'adding & removing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    93
a27a279701f8 Initial revision
claus
parents:
diff changeset
    94
addFirst:anObject
2
claus
parents: 1
diff changeset
    95
    "catch this - its not allowed for sortedCollections"
claus
parents: 1
diff changeset
    96
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    97
    self shouldNotImplement
a27a279701f8 Initial revision
claus
parents:
diff changeset
    98
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    99
a27a279701f8 Initial revision
claus
parents:
diff changeset
   100
addLast:anObject
2
claus
parents: 1
diff changeset
   101
    "catch this - its not allowed for sortedCollections"
claus
parents: 1
diff changeset
   102
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   103
    self shouldNotImplement
a27a279701f8 Initial revision
claus
parents:
diff changeset
   104
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   105
a27a279701f8 Initial revision
claus
parents:
diff changeset
   106
at:index put:anObject
2
claus
parents: 1
diff changeset
   107
    "catch this - its not allowed for sortedCollections"
claus
parents: 1
diff changeset
   108
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   109
    self shouldNotImplement
a27a279701f8 Initial revision
claus
parents:
diff changeset
   110
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   111
a27a279701f8 Initial revision
claus
parents:
diff changeset
   112
add:newObject after:oldObject
2
claus
parents: 1
diff changeset
   113
    "catch this - its not allowed for sortedCollections"
claus
parents: 1
diff changeset
   114
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   115
    self shouldNotImplement
a27a279701f8 Initial revision
claus
parents:
diff changeset
   116
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   117
a27a279701f8 Initial revision
claus
parents:
diff changeset
   118
add:newObject before:oldObject
2
claus
parents: 1
diff changeset
   119
    "catch this - its not allowed for sortedCollections"
claus
parents: 1
diff changeset
   120
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   121
    self shouldNotImplement
a27a279701f8 Initial revision
claus
parents:
diff changeset
   122
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   123
a27a279701f8 Initial revision
claus
parents:
diff changeset
   124
addAll:aCollection
a27a279701f8 Initial revision
claus
parents:
diff changeset
   125
    "add all elements of the argument, aCollection to the
a27a279701f8 Initial revision
claus
parents:
diff changeset
   126
     receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   127
a27a279701f8 Initial revision
claus
parents:
diff changeset
   128
    |mySize    "{ Class: SmallInteger }"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   129
     otherSize "{ Class: SmallInteger }"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   130
     dstIndex  "{ Class: SmallInteger }"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   131
     newSize newContents|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   132
a27a279701f8 Initial revision
claus
parents:
diff changeset
   133
    "if aCollection is bigger than a threshhold, its faster
a27a279701f8 Initial revision
claus
parents:
diff changeset
   134
     to add all and resort - question: what is a good treshhold ?"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   135
a27a279701f8 Initial revision
claus
parents:
diff changeset
   136
    mySize := self size.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   137
    otherSize := aCollection size.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   138
    ((mySize == 0) or:[otherSize > 5]) ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   139
        newSize := mySize + otherSize.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   140
        newContents := Array new:newSize.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   141
        newContents replaceFrom:1 to:mySize with:contentsArray startingAt:1.
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   142
        aCollection isSequenceableCollection ifTrue:[
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   143
            "maybe we can do it in one big move"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   144
            newContents replaceFrom:(mySize + 1) to:newSize with:aCollection startingAt:1.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   145
        ] ifFalse:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   146
            dstIndex := mySize + 1.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   147
            aCollection do:[:element |
a27a279701f8 Initial revision
claus
parents:
diff changeset
   148
                newContents at:dstIndex put:element.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   149
                dstIndex := dstIndex + 1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   150
            ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   151
        ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   152
        firstIndex := 1.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   153
        lastIndex := newSize.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   154
        contentsArray := newContents.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   155
        contentsArray sort:sortBlock.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   156
        ^ self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   157
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   158
    super addAll:aCollection
a27a279701f8 Initial revision
claus
parents:
diff changeset
   159
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   160
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   161
     #(7 3 9 10 99) asSortedCollection addAll:#(77 0 1 16 5) 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   162
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   163
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   164
a27a279701f8 Initial revision
claus
parents:
diff changeset
   165
add:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   166
    "add the argument, anObject at the proper place in the
2
claus
parents: 1
diff changeset
   167
     receiver. Returns the argument, anObject."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   168
32
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   169
    |index|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   170
32
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   171
    lastIndex < firstIndex "i.e. self size == 0" ifTrue:[
13
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   172
        super add:anObject
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   173
    ] ifFalse:[
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   174
        index := self indexForInserting:anObject. 
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   175
        self makeRoomAtIndex:index.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   176
        contentsArray at:index put:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   177
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   178
    ^ anObject
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   179
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   180
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   181
     |c| #(7 3 9 10 99) asSortedCollection add:5; yourself    
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   182
     #(7 3 9 10 99) asSortedCollection add:1; yourself        
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   183
     #(7 3 9 10 99) asSortedCollection add:1000; yourself     
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
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   187
!SortedCollection methodsFor:'copying'!
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   188
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   189
finalizeCopyFrom:aSortedCollection
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   190
    "sent after a deepCopy or when a new collection species has been created.
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   191
     The new collection should have the same sortBlock as the original."
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   192
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   193
    sortBlock := aSortedCollection sortBlock
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   194
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   195
    "
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   196
     #(4 7 1 99 -1 17) asSortedCollection inspect
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   197
     #(4 7 1 99 -1 17) asSortedCollection deepCopy inspect
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   198
     (#(4 7 1 99 -1 17) asSortedCollection sortBlock:[:a :b | a > b]) inspect
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   199
     (#(4 7 1 99 -1 17) asSortedCollection sortBlock:[:a :b | a > b]) deepCopy inspect
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   200
    "
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   201
! !
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   202
13
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   203
!SortedCollection methodsFor:'converting'!
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   204
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   205
asSortedCollection
32
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   206
    "return the receiver as a sorted collection"
13
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   207
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   208
    "could be an instance of a subclass..."
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   209
    self class == SortedCollection ifTrue:[
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   210
        ^ self
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   211
    ].
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   212
    ^ super asSortedCollection
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   213
! !
62303f84ff5f *** empty log message ***
claus
parents: 3
diff changeset
   214
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   215
!SortedCollection methodsFor:'testing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   216
a27a279701f8 Initial revision
claus
parents:
diff changeset
   217
includes:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   218
    "return true, if the argument, anObject is in the collection.
62
e1b4369c61fb *** empty log message ***
claus
parents: 44
diff changeset
   219
     Redefined, since due to being sorted, the inclusion check can
2
claus
parents: 1
diff changeset
   220
     be done with log-n compares i.e. much faster."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   221
32
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   222
    |index "{ Class: SmallInteger }"|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   223
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   224
    index := self indexForInserting:anObject.
32
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   225
    ((index < firstIndex) or:[index > lastIndex]) ifTrue:[^ false].
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   226
    ^ (contentsArray at:index) = anObject
2
claus
parents: 1
diff changeset
   227
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   228
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   229
     #(7 3 9 10 99) asSortedCollection includes:50
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   230
     #(7 3 9 10 99) asSortedCollection includes:10
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   231
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   232
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   233
a27a279701f8 Initial revision
claus
parents:
diff changeset
   234
occurrencesOf:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   235
    "return how many times the argument, anObject is in the collection.
62
e1b4369c61fb *** empty log message ***
claus
parents: 44
diff changeset
   236
     Redefined, since due to being sorted, the range of checked objects
2
claus
parents: 1
diff changeset
   237
     can be limited i.e. it can be done much faster."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   238
a27a279701f8 Initial revision
claus
parents:
diff changeset
   239
    |index      "{ Class: SmallInteger }"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   240
     tally      "{ Class: SmallInteger }" |
a27a279701f8 Initial revision
claus
parents:
diff changeset
   241
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   242
    index := self indexForInserting:anObject.
32
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   243
    ((index < firstIndex) or:[index > lastIndex]) ifTrue:[^ 0].
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   244
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   245
    tally := 0.
32
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   246
    [(index <= lastIndex) and:[(contentsArray at:index) = anObject]] whileTrue:[
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   247
        tally := tally + 1.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   248
        index := index + 1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   249
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   250
    ^ tally
2
claus
parents: 1
diff changeset
   251
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   252
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   253
     #(7 3 9 10 99) asSortedCollection occurrencesOf:50
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   254
     #(7 3 9 10 99) asSortedCollection occurrencesOf:10
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   255
     #(7 10 3 10 9 10 10 99) asSortedCollection occurrencesOf:10
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   256
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   257
! !
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   258
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   259
!SortedCollection methodsFor:'searching'!
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   260
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   261
before:anObject
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   262
    "return the element before the argument, anObject; or nil if there is none.
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   263
     If the receiver does not contain anObject, report an error"
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   264
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   265
    ^ self before:anObject ifAbsent:[self error:'no such element']
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   266
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   267
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   268
     #(7 3 9 10 99) asSortedCollection before:50
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   269
     #(7 3 9 10 99) asSortedCollection before:1 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   270
     #(7 3 9 10 99) asSortedCollection before:1000 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   271
     #(7 3 9 10 99) asSortedCollection before:10
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   272
     #(7 3 9 10 99) asSortedCollection before:7 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   273
     #(7 3 9 10 99) asSortedCollection before:99 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   274
     #(7 10 3 10 9 10 10 99) asSortedCollection before:9
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   275
     #(7 10 3 10 9 10 10 99) asSortedCollection before:10
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   276
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   277
!
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   278
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   279
before:anObject ifAbsent:exceptionBlock
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   280
    "return the element before the argument, anObject; or nil if there is none.
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   281
     If the receiver does not contain anObject, return the result from evaluating
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   282
     exceptionBlock."
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   283
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   284
    |index      "{ Class: SmallInteger }"|
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   285
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   286
    index := self indexForInserting:anObject.
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   287
    ((index <= firstIndex) 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   288
     or:[(contentsArray at:index) ~= anObject]) ifTrue:[^ exceptionBlock value].
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   289
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   290
    ^ contentsArray at:index - 1
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   291
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   292
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   293
     #(7 3 9 10 99) asSortedCollection before:50
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   294
     #(7 3 9 10 99) asSortedCollection before:1 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   295
     #(7 3 9 10 99) asSortedCollection before:10  
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   296
     #(7 3 9 10 99) asSortedCollection before:7   
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   297
     #(7 3 9 10 99) asSortedCollection before:99   
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   298
     #(7 10 3 10 9 10 10 99) asSortedCollection before:9  
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   299
     #(7 10 3 10 9 10 10 99) asSortedCollection before:10   
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
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   303
after:anObject
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   304
    "return the element after the argument, anObject; or nil if there is none.
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   305
     If the receiver does not contain anObject, report an error"
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   306
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   307
    ^ self after:anObject ifAbsent:[self error:'no such element']
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   308
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   309
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   310
     #(7 3 9 10 99) asSortedCollection after:50
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   311
     #(7 3 9 10 99) asSortedCollection after:1 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   312
     #(7 3 9 10 99) asSortedCollection after:10
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   313
     #(7 3 9 10 99) asSortedCollection after:7 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   314
     #(7 3 9 10 99) asSortedCollection after:99 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   315
     #(7 10 3 10 9 10 10 99) asSortedCollection after:9
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   316
     #(7 10 3 10 9 10 10 99) asSortedCollection after:10
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   317
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   318
!
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   319
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   320
after:anObject ifAbsent:exceptionBlock
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   321
    "return the element after the argument, anObject; or nil if there is none.
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   322
     If the receiver does not contain anObject, return the result from evaluating
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   323
     exceptionBlock."
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   324
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   325
    |index      "{ Class: SmallInteger }"|
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   326
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   327
    index := self indexForInserting:anObject.
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   328
    ((index < firstIndex) 
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   329
     or:[(contentsArray at:index) ~= anObject]) ifTrue:[^ exceptionBlock value].
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   330
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   331
    "skip multiple occurences of the same ..."
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   332
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   333
    [(index <= lastIndex) and:[(contentsArray at:index) = anObject]] whileTrue:[
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   334
        index := index + 1
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   335
    ].
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   336
    (index > lastIndex) ifTrue:[^ nil].
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   337
    ^ contentsArray at:index
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   338
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   339
a27a279701f8 Initial revision
claus
parents:
diff changeset
   340
!SortedCollection methodsFor:'instance protocol'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   341
a27a279701f8 Initial revision
claus
parents:
diff changeset
   342
sortBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
   343
    "return the block used for sorting"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   344
a27a279701f8 Initial revision
claus
parents:
diff changeset
   345
    ^ sortBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
   346
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   347
a27a279701f8 Initial revision
claus
parents:
diff changeset
   348
sortBlock:aSortBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
   349
    "change the sort criteria for a sorted collection, resort the elements of 
a27a279701f8 Initial revision
claus
parents:
diff changeset
   350
    the collection, and return the receiver. The argument, aSortBlock must
a27a279701f8 Initial revision
claus
parents:
diff changeset
   351
    be a two-argument block which returns true if its arg1 has to come before
a27a279701f8 Initial revision
claus
parents:
diff changeset
   352
    its arg2 in the collection."
a27a279701f8 Initial revision
claus
parents:
diff changeset
   353
a27a279701f8 Initial revision
claus
parents:
diff changeset
   354
    sortBlock := aSortBlock.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   355
    lastIndex > firstIndex ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   356
        contentsArray quickSortFrom:firstIndex to:lastIndex sortBlock:aSortBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
   357
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   358
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   359
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   360
     #(9 8 7 6 5 4 3) asSortedCollection
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   361
     #(9 8 7 6 5 4 3) asSortedCollection sortBlock:[:a : b | a < b]
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   362
     #(9 8 7 6 5 4 3) asSortedCollection sortBlock:[:a : b | a > b]
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   363
     #($f $G $z $Y $o $H) asSortedCollection
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   364
     #($f $G $z $Y $o $H) asSortedCollection sortBlock:[:a : b | a asUppercase < b asUppercase]
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   365
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   366
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   367
a27a279701f8 Initial revision
claus
parents:
diff changeset
   368
!SortedCollection methodsFor:'private'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   369
a27a279701f8 Initial revision
claus
parents:
diff changeset
   370
setSortBlock: aSortBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
   371
    "set the sortblock without resorting - private only"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   372
a27a279701f8 Initial revision
claus
parents:
diff changeset
   373
    sortBlock := aSortBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
   374
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   375
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   376
indexForInserting:anObject
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   377
    "search the index at which to insert anObject. Can also be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
   378
     to search for an existing element by checking if the element at
32
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   379
     the returned index is the one we look for.
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   380
     The returned index is a physical one, for accessing contentsArray."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   381
a27a279701f8 Initial revision
claus
parents:
diff changeset
   382
    |low    "{ Class: SmallInteger}"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   383
     high   "{ Class: SmallInteger}"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   384
     middle "{ Class: SmallInteger}"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   385
     element|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   386
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   387
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   388
     we can of course use a binary search - since the elements are
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   389
     sorted
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   390
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   391
    low := firstIndex.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   392
    high := lastIndex.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   393
    [low <= high] whileTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   394
        middle := (low + high) // 2.
32
ee1a621c696c *** empty log message ***
claus
parents: 13
diff changeset
   395
        element := contentsArray at:middle.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   396
        (sortBlock value:element value:anObject) ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   397
            "middleelement is smaller than object"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   398
            low := middle + 1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   399
        ] ifFalse:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   400
            high := middle - 1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   401
        ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   402
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   403
    ^ low
a27a279701f8 Initial revision
claus
parents:
diff changeset
   404
77
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   405
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   406
     #(1 2 3 4 7 99 1313 981989 898989898) asSortedCollection indexForInserting:50      
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   407
     #(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
   408
    "
6c38ca59927f *** empty log message ***
claus
parents: 62
diff changeset
   409
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   410
! !