Hi, On 27 October 2011 15:32, Ben Coman <[email protected]> wrote:
> ** > 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. > > I think of polymorphism in terms that I can't treat aSet in the same way I treat any other collection, at least when sending collect: > 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. > Yes, I know. Perhaps thinking of this as we do in maths this behavior makes sense, giving that there isn't the posibility of having repeated elements in sets... But because that concept doesn't exist :) And a mathematical function shouldn't give me repeated elements, because of its very definition... Here we don't have this concepts, and a message send to each element of a collection without repeated elements could return repeated objects, and in most cases I want this to be like that... So for particular cases in which I don't care, I could use asSet... And as you say, maybe this doesn't seem as different as sending asBag before sending collect:, but to me there is a huge difference: when I send collect:, I don't have to worry about the class of the collection. I care about the behavior of the result :) And in the particular case of Set, I think (maybe I'm wrong) that generally you wouldn't want to get aSet as a result of a collect: 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) > Yes, maybe that was not the coolest example... I know I can do that in several different ways, but if I want to use this one, I have to take all this into account... > > ----------8<------------ > [1] The Blue Book, 1983, section "Protocol for All Collection Classes", > p137, > http://stephane.ducasse.free.fr/FreeBooks/BlueBook/Bluebook.pdf > -- "*Most good programmers do programming not because they expect to get paid or get adulation by the public, but because it is fun to program.*" Linus Torvalds
