Clara Allende wrote:
Ok, but this means I have to worry of the receiver's class before I send collect:, so as I don't fuck it all up.... and I don't want to think about that!!! See, if I want the collection of grades of the students, I would like to do this:

grades
^self students collect: [.aStudent | aStudent grades]

 regardless of whatever is the class of students... This does the trick for all the collections, except for Set. And I don´t know if students is an instance of Set, and I really don't want to think if it is or not. If I don't want repeated students and I create my collection as an instance of Set, an i.e.; I want to calculate the average, then I'm screwed because the collection I get from the collect: wasn't the want that I wanted. 
So, I have to know previously that my collection is an instance of Set, or if it isn't, so as to know if I have to convert it first....

And if I use collect: as:, as you suggest, this means the collections are no longer polymorphic for me :(  
Sorry, maybe I'm really stupid, but I don't know how that message solves best the problem than redefining collect: for Set. For the particular case I don't want the repeated objects (which AFAIK is not so common) I could send asSet. 

On 27 October 2011 11:05, Henrik Sperre Johansen <[email protected]> wrote:
On 27.10.2011 15:40, Clara Allende wrote:
I know, but our students don't :) So they ran into problems because the message send didn't answer what they were specting....  because it makes sense that if I want to transform the objects in my collection, I might get repeated objects... Maybe I'm not thinking in terms of consistency, I'm just putting myself on student's shoes :P
The consistency rule to remember for #collect:/#select:/#reject: is that they will return a collection of the receiver's species.
#collect:as: was added as a general answer to the situation your students ran into :)

set := Set withAll: #(1 2 3 4 5 6 7 8).
result := set collect: #even as: Bag.

Cheers,
Henry
Applying the Principle Of Least Surprise (you may notice, a favourite of mine) to newcomers would support what you're saying.  However the flip side of POLS is the behavior expected by old hands, existing code and code from other Smalltalk systems.  I imagine there are subtle dependencies through the system for the convention from the Blue Book [1] which says:
 "collect: aBlock ... Answer a new collection like that of the receiver... This phrase means that the new collection is an instance of the same class as that of the receiver... The only exception is class Interval, which returns a new OrderedCollection...[since] elements of an Interval are created when the Interval is first created; it is not possible to store elements into an existing Interval."
I got interested in how this was achieved in Pharo and as an overview pulled the following lines from all implementors of #collect:

Collection              - newCollection := self species new.
DependentsArray         - selection := self species new: size.
Dictionary              - newCollection := self species new.
OrderedCollection       - newCollection := self species new: self size.
SequenceableCollection  - newCollection := self species new: self size.
Set                     - newSet := Set new: self size.
SmallDictionary         - newCollection := self species new.
WeakSet                 - newSet := self species new: self size.
Matrix                  - ^self class rows: nrows columns: ncols contents: (contents collect: aBlock)
Interval                - result := self species new: self size.

Heap                    - ^self collect: aBlock as: Array
SortedCollection        - newCollection := OrderedCollection new: self size.

PragmaCollector         - ^self collected collect: aBlock -&- collected := OrderedCollection new
MetacelloMemberListSpec - newCollection := OrderedCollection new.
RBProgramNode           - ^aBlock value: self        "Hacked to fit collection protocols"

...from which it can be seen that:
a. Collection to Matrix holds to the Blue Book
b. Interval diverges from the Blue Book, to follow the general collection protocol
c. Heap and SortedCollection diverge from the collection protocol
d. PragmaCollector to RBProgramNode don't descend from Collection, so need to turn an individual object into a collection.

Someone advise me better, but I'm not sure that polymorphism implies "exact behaviour" between objects.  Otherwise #collect:as: might be considered more polymorphic as the result _will_ be more similar regardless of the receiving object. 

You mention sending #asSet "as needed" when you don't want repeated items.  Knowing when that was "needed" seems not much different from knowing when #collect:as: was "needed", so I think this is one of those quirks that all languages have.  Its only a surprise until you are used to it and work around it without noticing.  There may be other ways to do something.  For the specific example you suggested of averaging the grades, perhaps the following would be suitable.
^(students inject: 0 into: [ :subTotal :eachStudent | subTotal + (eachStudent grade) ] ) ) / (size students)

----------8<------------
[1] The Blue Book, 1983, section "Protocol for All Collection Classes",  p137,
http://stephane.ducasse.free.fr/FreeBooks/BlueBook/Bluebook.pdf

Reply via email to